Алгоритмы на Pascal

Сулейманов Виталий аватар

Скидывайте алгоритмы, кто какие знает (из лекций, книг, прочих мест, которые уже разобраны Вами). Только с комментариями. Соберем в одном месте, чтобы можно было быстро найти их и применять в своих программах.

Сулейманов Виталий аватар

Сортировка вставками

  1. program ts;
  2. type
  3.   mas = array [1..50] of Word;
  4. var
  5.   i, j, n, key : Word;
  6.   ms : mas;
  7. begin
  8.   readln(n);
  9.   for i := 1 to n do begin
  10.     read(ms[i]);
  11.   end;
  12.   for j := 2 to n do begin
  13.     key := ms[j];
  14.     i := j - 1;
  15.     while (i > 0) and (ms[i] > key) do begin
  16.       ms[i+1] := ms[i];
  17.       dec(i);
  18.     end;
  19.     ms[i+1] := key;
  20.   end;
  21.   for i := 1 to n do begin
  22.     write(ms[i], ' ');
  23.   end;
  24. end.
  25. {
  26. Примечание. Рассмотрим выполнение цикла для j=2. Допустим массив заполнили, как [7, 5, 6, 12, 10]
  27. - строка 13 - присваиваем второй элемент
  28. - строка 14 - i становится равным 1
  29. - строка 15 - проверяется, чтобы i было больше 0 и первый элемент (7) больше второго элемента (5)
  30. - строка 16 - во второй элемент присваиваем 7, при этом массив выглядит следующим образом [7, 7, 6, 12, 10]
  31. - строка 19 - после выхода из цикла в первый элемент присваиваем второй элемент, который первоначально был сохранен в key. Получается массив [6, 7, 6, 12, 10]
  32. Затем снова запускается цикла для j=3, и так далее, пока j не станет равно n
  33. В итоге получается отсортированный массив
  34. }

Сулейманов Виталий аватар

Вычисление n-кратного факториала

  1. // Запускать следующим образом: сначала вводится число, затем обязательно один пробел и любое количество восклицательных знаков.
  2. // Например, 9 !! = 945
  3. program ts;
  4. var
  5.   n, m, p : Byte;
  6.   s : String;
  7.  
  8. function Factorial(n, p : Integer) : Longint;
  9. begin
  10.   if n > 0 then
  11.     Factorial := Factorial(n - p, p) * n
  12.   else
  13.     Factorial := 1;
  14. end;
  15.  
  16. begin
  17.   read(n, s);
  18.   p := length(s);
  19.   dec(p); m := p;
  20.   if n mod p <> 0 then
  21.     m := n mod p;
  22.   write(Factorial(n, p));
  23. end.
  24.  
  25. {
  26. Примечание:
  27. Определение:
  28.     n!!…! = n(n−k)(n−2k)…(n mod k), если n не делится на k;
  29.     n!!…! = n(n−k)(n−2k)…k, если n делится на k (знаков ! в обоих случаях k штук)
  30.     Под "делится" подразумевается X mod Y — остаток от деления X на Y
  31. Например,
  32. 3! = 3·2·1;
  33. 10!!! = 10·7·4·1
  34. - строка 16 - вычисляем количество восклицательных знаков
  35. - строка 17 - уменьшаем длину на 1, т.к. в строку попадает символ пробела
  36. - строка 18-19 - определяет на что нужно домножать в конце факториал: на (n mod k) или на k
  37. - строки 8-14 - обычным образом рекурсивно вычисляется факториал

Замечание к сортировке вставками.

Ваша просьба комментировать разумна, Виталий. Но Вы сами делаете это не совсем правильно.
1. При разборе нового для читателя алгоритма, главный и начальный комментарий - это идея, скелет, принцип работы алгоритма. Затем, возможно, простенький пример, иллюстрирующий эту идею. И только уж затем - код (комментированный в ключевых позициях).
2. Если алгоритм является разновидностью уже предположительно известного читателю алгоритма (тем более, имеющий даже сходное, или такое же название!), то оговорка этого факта и указание главного отличия (отличий) просто обязательно. Иначе, есть опасность совсем всех запутать. Вот буквально сегодня на лабораторке была ещё одна сортировка вставками, но устроенная совершенно иначе! Так чем чем же отличается от неё приведённое Вами решение? А вот чем:
1) Это итеративный, а не рекурсивный алгоритм;
2) В нём явно, как подпрограмма, не выделен модуль собственно, вставки нового элемента, в уже упорядоченную часть массива - отсюда двойной (кратный) цикл в коде;
3) Процесс упорядочения идёт снизу-вверх (слева-направо, от упорядочения самого короткого начального отрезка массива до упорядочения самого длинного начального отрезка массива, т.е. всего массива), а не сверху-вниз (от всего массива к базе) как в рекурсивном алгоритме сортировки вставками.
Обо всём этом конечно же нужно было сказать.

Саламбек

Рекомендованные учебники упомянуты здесь, в конце.

Сулейманов Виталий аватар

Да, с подробным

Да, с подробным комментированием кода я еще совсем не привык, и пытаюсь донести какую-то малую часть. Код "сортировки вставками" я давно разбирал из книги по алгоритмам. Он был описал с помощью псевдокода без рекурсии. Поэтому я не стал его править, а оставил итеративным. Позже, может быть, добавлю код "сортировки слиянием" методом "разделяй и властвуй". И попытаюсь подробно описать идею и принцип работы. Там используются 2 рекурсивные функции (и код соответственно сложнее).

Сулейманов Виталий аватар

Перечисление всех подмножеств множества

  1. program ts;
  2. var
  3.   num, numPower : Word;
  4.  
  5. // Вычисление количества всех подмножеств
  6. function power(num : Word) : Word;
  7. begin
  8.   if num = 0 then
  9.     power := 1
  10.   else
  11.     power := power(num - 1) * 2;
  12. end;
  13.  
  14. // Вывод подмножества используя 2-ич. запись числа
  15. procedure subSet(var textBin : String; num : Word);
  16. var
  17.   i : Word;
  18. begin
  19.   for i := 1 to num do begin
  20.     if textBin[i] = '1' then
  21.       write(i, ' ');
  22.   end;
  23.   writeln;
  24. end;
  25.  
  26. // Перевод в 2-ич. с.с. и дополнение нулями слева при необходимости
  27. procedure tenToBin(ex, num, numPower : Word);
  28. var
  29.   textBin : String;
  30.   exCopy : Word;
  31. begin
  32.   exCopy := ex;
  33.   textBin := '';
  34.  
  35.   // Переводит в 2-ич. с.с.
  36.   while exCopy <> 0 do begin
  37.     textBin := (exCopy mod 2) + textBin;
  38.     exCopy := exCopy div 2;
  39.   end;  
  40.   // Добавляет нули слева
  41.   while length(textBin) < num do begin
  42.     textBin := '0' + textBin;
  43.   end;
  44.  
  45.   subSet(textBin, num);  
  46.   // Проверяем, все ли подмножества выведены. Если нет -  снова вызываем процедуру (саму себя)
  47.   if ex < numPower then  
  48.     tenToBin(ex + 1, num, numPower);
  49. end;
  50.  
  51.  
  52. begin
  53.   readln(num);
  54.   writeln('#####');
  55.   writeln('[] - пустое мн.');
  56.  
  57.   numPower := power(num);
  58.   dec(numPower);  // Вычитаем один случай - пустое множество, т.к. оно уже выведено
  59.   tenToBin(1, num, numPower);
  60. end.

Перечисление подмножеств осуществляется при помощи двоичной записи числа. Если в двоичной записи имеется цифра 1, тогда необходимо вывести номер этой цифры (например, 001 => цифра 1 стоит под номером 3).
Всего имеется 2^n подмножеств (где n - количество всех элементов множества). Для этого служит функция power. Она вычисляет чему равняется 2^n.
После этого нужно перевести число в 2-ич. с.с. и добавить недостающие нули слева (на случай, если 2-ич. число состоит не из n-чисел; иначе правильный результат не получится). Для этого используется процедура tenToBin
Например, n = 3, значит правильная форма должна выглядеть, как 001; 010; 011; 100 и т.д., а не 1; 10; 11 и т.д.
Как только число переведено в 2-ич. с.с. оно передается в функцию subSet, которая проверяет наличие единиц в строке. И если имеется символ '1', то вывести его порядковый номер (в данном случае порядковым номером служит переменная " i ")

Например, рассмотрим при n = 2
Всех подмножеств будет 4, т.к. 2^2 = 4 (с этим справляется функция power) => [], [1], [2], [1, 2]. Но т.к. один вариант уже выведен, то остается 3.
Далее процедура tenToBin переводит цифру 1 в двоичное представление (инструкции 36 - 38) и получается строка '1', в инстукциях 41 - 43 слева добавляем нули и получаем строку '01' (она состоит из n-элементов, т.е. 2-х).
Затем эта строка передается в процедуру subSet, где происходит вывод подмножества. В данном случае выводится число 2, т.к. символ '1' стоит на второй позиции.
Как закончился вывод, снова возвращаемся в процедуру tenToBin и проверяется условие: все ли подмножества были выведены? Если нет - то tenToBin вызывается снова, иначе - выход из процедуры и конец программы.

Продолжение работы программы:
tenToBin => '10' subSet => [1]
tenToBin => '11' subSet => [1, 2]