Необходимо отсортировать N элементов по К параметрам по убыванию.

[Poma][a]

Забабахайте матрицу [1..N, 1..K]. В a[i, j] будет находится i-ый критерий j-ой шутки. Инициализируете матрицу. Для последующего вывод введем барьерный элемент - a[0, i]. В нем будет просто I. Затем сортируем её(матрицу), меняя местами столбцы.
После этого бежим по a[o, i] и выводим I.
Остается только хороший момент с сравнением.. Есть идея сделать булевскую функцию.. Можно рекурсивную, а можно и нет..

[ViktorR]

Кстати,отрицательные данные тоже могут быть.

Захотелось сделать замечание.
1. В условии задачи много неопределённости. Так, например, количество анекдотов может быть задано по сотню тысяч и более. А что мешает?
2. Количество параметров для оценки определено не более 13. Из этого я и исходил, когда предложил вариант со строками.
3. Значение параметра неопределено. Сказано, что это оценка.
Существует 5-ти бальная, 10-и бальная, 100 бальная оценки. Вполне могут быть и с отрицательными показателями. Приведите примеры. Т.е. считаю, и это очевидно из примера, что использована 5-и бальная система. Таким образом, с чего это там будут отрицательные оценки или оценки с двух и более значениями?

Т.о. обсуждение с отрицательными оценками или оценками с двухзначными и более значениями считаю неприемлимыми для такого уровня постановки задачи.


Как-то так ...
PS: Отрицательные значения мжно компенсировать сдвигом вверх, но и в этом случае необходимо знать нижнюю границу. Иначе проходов по данным придется делать несколько раз. Как минимум, один раз для поиска минимального значения.

[Mad_Cat]

делать было нечего - дело было вечером)
осталось допилить норм ввод и оптимизировать)

const nmax = 100;
var i, j, n, k,m: byte;
  a: array[1..nmax, 0..nmax] of real;
  f: boolean;
  buf:real;
begin
  n := 2;
  k := 3;
  a[1, 1] := 1; a[2, 1] := 1;
  a[1, 2] := 2; a[2, 2] := 2;
  a[1, 3] := 3; a[2, 3] := 4;
  for i := 1 to n do
    a[i, 0] := i;
  f := true;
  while f do
  begin
    f := false;
    for i := 1 to n - 1 do
    begin
      j := 1;
      while (a[i, j] = a[i+1, j]) do inc(j);
      if a[i, j] < a[i + 1, j] then
      begin
        f := true;
        for m := 0 to k do
        begin
          buf:=a[i, m];
          a[i,m]:=a[i + 1, m];
          a[i + 1, m] :=buf;
        end;
      end;
    end;
  end;
    for i := 1 to n do
      write(a[i, 0]: 6: 0);
      readln;
  end.

меняя местами столбцы.

строки все-таки)

[Poma][a]

Щас глянем

строки все-таки)

Я их путаю

(плюс поставить не дают..)
Чтение

var
        i, j, n, k : Integer;
        a : array [0..100, 0..100] of Integer;

begin
        ReadLn (n, k);
		
		for i := 1 to n do
                a[i, 0] := i;
                
        for i := 0 to k do begin
                for j := 0 to n do
                        Write (a[j, i], ' ');
                WriteLn
        end;

        for i := 1 to n do
                for j := 1 to k do
                        Read (a[i, j]);

        
        for i := 0 to k do begin
                for j := 0 to n do
                        Write (a[j, i], ' ');
                WriteLn
        end
end.

Вернемся к "оптимизации"..
Я так подумал.. Ведь матрица - это массив массивов, так? А теперь почему бы нам не обменивать не сами ячейки, а просто напросто эти массивы?
Вот код, который подтверждает мою гипотезу :

var 	
	a : array [1..10, 1..10] of Integer;
	i, j : Integer;
	
begin
	for i := 1 to 10 do
		for j := 1 to 10 do
			a[i, j] := i;
			
	for i := 1 to 10 do begin
		WriteLn;
		for j := 1 to 10 do
			Write (a[i, j], ' ')
	end;
			
	a[1] := a[2];
	WriteLn;
	
	
	for i := 1 to 10 do begin
		WriteLn;
		for j := 1 to 10 do
			Write (a[i, j], ' ')
	end
			
end.

И теперь избавимся от одного цикла.. Да, мы будем использовать лишнюю память, но это настолько мало для современных компьютером.. Так что париться не стоит (ИМХО)

Пляшем дальше..
Меня ужасно смущает эта строка :

f := true;

..
Я не уверен, что когда мы сравним a[i] и a[i+1] и поймем, что перетаскивать их нам не надо, мы не прекратим выполнение алгоритма.. Проверить возможности (сейчас) не имею..