Вики проекта PascalABC.NET - Вклад [ru]

Алгоритмы для студентов

2010-12-04T20:46:08Z

Miclus:

__NOTOC__
== Стандартные задачи на циклы ==
=== [[Стандартные задачи на циклы|Программы]] ===
==== [[Стандартные задачи на циклы#Простейшие алгоритмы|Простейшие алгоритмы]] ====
# [[Стандартные задачи на циклы#№1. Сумма вводимых целых чисел|Сумма вводимых целых чисел]]
# [[Стандартные задачи на циклы#№2. Произведение целых чисел|Произведение целых чисел]]
# [[Стандартные задачи на циклы#№3. Двойной факториал n!!=n*(n-2)*(n-4)*...*2 (или 1)|Двойной факториал n!!=n*(n-2)*(n-4)*...*2 (или 1)]]
# [[Стандартные задачи на циклы#№4. Сколько нечетных среди n введенных|Сколько нечетных среди n введенных]]
# [[Стандартные задачи на циклы#№5. Защита от неверного ввода|Защита от неверного ввода]]
# [[Стандартные задачи на циклы#№6. Табулирование функции f(x) на отрезке в точках, разбивающих отрезок на N частей|Табулирование функции f(x) на отрезке в точках, разбивающих отрезок на N частей]]
# [[Стандартные задачи на циклы#№6a. Решение, использующее while. Погрешность округления и вычислительная погрешность|Решение, использующее while. Погрешность округления и вычислительная погрешность]]

==== [[Стандартные задачи на циклы#Рекуррентные соотношения|Рекуррентные соотношения]] ====
# [[Стандартные задачи на циклы#№7. Вывод 10 первых степеней двойки|Вывод 10 первых степеней двойки]]
# [[Стандартные задачи на циклы#№8. Вывод всех двухзначных чисел, кратных 5|Вывод всех двухзначных чисел, кратных 5]]
# [[Стандартные задачи на циклы#№9. Вывод n первых чисел Фибоначчи|Вывод n первых чисел Фибоначчи]]
# [[Стандартные задачи на циклы#№10. Найти НОД(A,B), используя алгоритм Евклида:|Найти НОД(A,B), используя алгоритм Евклида]]
# [[Стандартные задачи на циклы#№11. Найти сумму цифр целого положительного числа m|Найти сумму цифр целого положительного числа m]]

==== [[Стандартные задачи на циклы#Максимумы и минимумы|Максимумы и минимумы]] ====
# [[Стандартные задачи на циклы#№12. Найти max из введенных чисел|Найти max из введенных чисел]]
# [[Стандартные задачи на циклы#№12a. Найти min, удовлетворяющее условию p(x)|Найти min, удовлетворяющее условию p(x)]]

==== [[Стандартные задачи на циклы#Суммирование рядов (конечных и бесконечных)|Суммирование рядов (конечных и бесконечных)]] ====
# [[Стандартные задачи на циклы#№13. Вычислить Σ(i=1..n) a^i/i!|Вычислить Σ(i=1..n) a^i/i!]]
# [[Стандартные задачи на циклы#№13a. Вычислить Σ(i=1..∞) (-1)^i * a^i/i!|Вычислить Σ(i=1..∞) (-1)^i * a^i/i!]]

==== [[Стандартные задачи на циклы#Поиск значения|Поиск значения]] ====
# [[Стандартные задачи на циклы#№14. Есть ли среди введенных число k?|Есть ли среди введенных число k?]]
# [[Стандартные задачи на циклы#№14b. Есть ли среди введенных число k? (то же с использованием while)|Есть ли среди введенных число k? (то же с использованием while)]]
# [[Стандартные задачи на циклы#№15. Является ли число N>0 простым?|Является ли число N>0 простым?]]

==== [[Стандартные задачи на циклы#Другие алгоритмы|Другие алгоритмы]] ====
# [[Стандартные задачи на циклы#№16. Разложение числа на простые множители|Разложение числа на простые множители]]
# [[Стандартные задачи на циклы#№17. Вычисление значения многочлена в точке x по схеме Горнера|Вычисление значения многочлена в точке x по схеме Горнера]]
# [[Стандартные задачи на циклы#№18. Дана непрерывная на отрезке функция f(x), имеющая на отрезке ровно один корень. Найти его методом половинного деления|Дана непрерывная на отрезке функция f(x), имеющая на отрезке ровно один корень. Найти его методом половинного деления]]

== Стандартные задачи на одномерные массивы ==
=== [[Стандартные задачи на одномерные массивы|Программы]] ===
==== [[Стандартные задачи на одномерные массивы#Простейшие алгоритмы|Простейшие алгоритмы]] ====
# [[Стандартные задачи на одномерные массивы#№1. Вывод массива|Вывод массива]]
# [[Стандартные задачи на одномерные массивы#№2. Заполнение массива случайными числами|Заполнение массива случайными числами]]
# [[Стандартные задачи на одномерные массивы#№3. Инвертирование массива|Инвертирование массива]]
# [[Стандартные задачи на одномерные массивы#№4. Поиск элемента по заданному значению|Поиск элемента по заданному значению]]
# [[Стандартные задачи на одномерные массивы#№4a. Поиск с барьером|Поиск с барьером]]
# [[Стандартные задачи на одномерные массивы#№5. Минимальный элемент и его индекс|Минимальный элемент и его индекс]]

==== [[Стандартные задачи на одномерные массивы#Сдвиги, вставка, удаление|Сдвиги, вставка, удаление]] ====
# [[Стандартные задачи на одномерные массивы#№6. Сдвиг влево|Сдвиг влево]]
# [[Стандартные задачи на одномерные массивы#№7. Сдвиг вправо|Сдвиг вправо]]
# [[Стандартные задачи на одномерные массивы#№8. Циклический сдвиг вправо|Циклический сдвиг вправо]]
# [[Стандартные задачи на одномерные массивы#№9. Удаление k-того|Удаление k-того]]
# [[Стандартные задачи на одномерные массивы#№10. Вставка на k-тое место|Вставка на k-тое место]]

==== [[Стандартные задачи на одномерные массивы#Слияние упорядоченных и бинарный поиск в упорядоченном массиве|Слияние упорядоченных и бинарный поиск в упорядоченном массиве]] ====
# [[Стандартные задачи на одномерные массивы#№11. Слияние двух упорядоченных в один упорядоченный|Слияние двух упорядоченных в один упорядоченный]]
# [[Стандартные задачи на одномерные массивы#№12. Поиск в упорядоченном массиве|Поиск в упорядоченном массиве]]

==== [[Стандартные задачи на одномерные массивы#Сортировка массивов|Сортировка массивов]] ====
# [[Стандартные задачи на одномерные массивы#№13. Сортировка выбором|Сортировка выбором]]
# [[Стандартные задачи на одномерные массивы#№14. Пузырьковая сортировка|Пузырьковая сортировка]]
## [[Стандартные задачи на одномерные массивы#Способ №1|Способ №1]]
## [[Стандартные задачи на одномерные массивы#Способ №2(оптимизация)|Способ №2]]
# [[Стандартные задачи на одномерные массивы#№15. Сортировка вставками|Сортировка вставками]]

==== [[Стандартные задачи на одномерные массивы#Использование процедурных типов в задачах на массивы|Использование процедурных типов в задачах на массивы]] ====
# [[Стандартные задачи на одномерные массивы#№16. Поиск по условию|Поиск по условию]]
# [[Стандартные задачи на одномерные массивы#№17. Количество по условию|Количество по условию]]
# [[Стандартные задачи на одномерные массивы#№18. Условный минимум|Условный минимум]]
# [[Стандартные задачи на одномерные массивы#№19. Удаление по условию|Удаление по условию]]

----

© Буцев Виктор, Белоусько Тихон, Зуев Семен, Гончаров Владислав, Батраков Михаил, Гаджиев Казанфар, Пак Владислав

Алгоритмы для студентов

2010-12-02T14:34:24Z

Miclus:

__NOTOC__
== Стандартные задачи на циклы ==
=== [[Стандартные задачи на циклы|Программы]] ===
==== [[Стандартные задачи на циклы#Простейшие алгоритмы|Простейшие алгоритмы]] ====
# [[Стандартные задачи на циклы#№1. Сумма вводимых целых чисел|Сумма вводимых целых чисел]]
# [[Стандартные задачи на циклы#№2. Произведение целых чисел|Произведение целых чисел]]
# [[Стандартные задачи на циклы#№3. Двойной факториал n!!=n*(n-2)*(n-4)*...*2 (или 1)|Двойной факториал n!!=n*(n-2)*(n-4)*...*2 (или 1)]]
# [[Стандартные задачи на циклы#№4. Сколько нечетных среди n введенных|Сколько нечетных среди n введенных]]
# [[Стандартные задачи на циклы#№5. Защита от неверного ввода|Защита от неверного ввода]]
# [[Стандартные задачи на циклы#№6. Табулирование функции f(x) на отрезке в точках, разбивающих отрезок на N частей|Табулирование функции f(x) на отрезке в точках, разбивающих отрезок на N частей]]
# [[Стандартные задачи на циклы#№6a. Решение, использующее while. Погрешность округления и вычислительная погрешность|Решение, использующее while. Погрешность округления и вычислительная погрешность]]

==== [[Стандартные задачи на циклы#Рекуррентные соотношения|Рекуррентные соотношения]] ====
# [[Стандартные задачи на циклы#№7. Вывод 10 первых степеней двойки|Вывод 10 первых степеней двойки]]
# [[Стандартные задачи на циклы#№8. Вывод всех двухзначных чисел, кратных 5|Вывод всех двухзначных чисел, кратных 5]]
# [[Стандартные задачи на циклы#№9. Вывод n первых чисел Фибоначчи|Вывод n первых чисел Фибоначчи]]
# [[Стандартные задачи на циклы#№10. Найти НОД(A,B), используя алгоритм Евклида:|Найти НОД(A,B), используя алгоритм Евклида]]
# [[Стандартные задачи на циклы#№11. Найти сумму цифр целого положительного числа m|Найти сумму цифр целого положительного числа m]]

==== [[Стандартные задачи на циклы#Максимумы и минимумы|Максимумы и минимумы]] ====
# [[Стандартные задачи на циклы#№12. Найти max из введенных чисел|Найти max из введенных чисел]]
# [[Стандартные задачи на циклы#№12a. Найти min, удовлетворяющее условию p(x)|Найти min, удовлетворяющее условию p(x)]]

==== [[Стандартные задачи на циклы#Суммирование рядов (конечных и бесконечных)|Суммирование рядов (конечных и бесконечных)]] ====
# [[Стандартные задачи на циклы#№13. Вычислить Σ(i=1..n) a^i/i!|Вычислить Σ(i=1..n) a^i/i!]]
# [[Стандартные задачи на циклы#№13a. Вычислить Σ(i=1..∞) (-1)^i * a^i/i!|Вычислить Σ(i=1..∞) (-1)^i * a^i/i!]]

==== [[Стандартные задачи на циклы#Поиск значения|Поиск значения]] ====
# [[Стандартные задачи на циклы#№14. Есть ли среди введенных число k?|Есть ли среди введенных число k?]]
# [[Стандартные задачи на циклы#№14b. Есть ли среди введенных число k? (то же с использованием while)|Есть ли среди введенных число k? (то же с использованием while)]]
# [[Стандартные задачи на циклы#№15. Является ли число N>0 простым?|Является ли число N>0 простым?]]

==== [[Стандартные задачи на циклы#Другие алгоритмы|Другие алгоритмы]] ====
# [[Стандартные задачи на циклы#№16. Разложение числа на простые множители|Разложение числа на простые множители]]
# [[Стандартные задачи на циклы#№17. Вычисление значения многочлена в точке x по схеме Горнера|Вычисление значения многочлена в точке x по схеме Горнера]]
# [[Стандартные задачи на циклы#№18. Дана непрерывная на отрезке функция f(x), имеющая на отрезке ровно один корень. Найти его методом половинного деления|Дана непрерывная на отрезке функция f(x), имеющая на отрезке ровно один корень. Найти его методом половинного деления]]

== Стандартные задачи на одномерные массивы ==
=== [[Стандартные задачи на одномерные массивы|Программы]] ===
==== [[Стандартные задачи на одномерные массивы#Простейшие алгоритмы|Простейшие алгоритмы]] ====
# [[Стандартные задачи на одномерные массивы#№1. Вывод массива|Вывод массива]]
# [[Стандартные задачи на одномерные массивы#№2. Заполнение массива случайными числами|Заполнение массива случайными числами]]
# [[Стандартные задачи на одномерные массивы#№3. Инвертирование массива|Инвертирование массива]]
# [[Стандартные задачи на одномерные массивы#№4. Поиск элемента по заданному значению|Поиск элемента по заданному значению]]
# [[Стандартные задачи на одномерные массивы#№4a. Поиск с барьером|Поиск с барьером]]
# [[Стандартные задачи на одномерные массивы#№5. Минимальный элемент и его индекс|Минимальный элемент и его индекс]]

==== [[Стандартные задачи на одномерные массивы#Сдвиги, вставка, удаление|Сдвиги, вставка, удаление]] ====
# [[Стандартные задачи на одномерные массивы#№6. Сдвиг влево|Сдвиг влево]]
# [[Стандартные задачи на одномерные массивы#№7. Сдвиг вправо|Сдвиг вправо]]
# [[Стандартные задачи на одномерные массивы#№8. Циклический сдвиг вправо|Циклический сдвиг вправо]]
# [[Стандартные задачи на одномерные массивы#№9. Удаление k-того|Удаление k-того]]
# [[Стандартные задачи на одномерные массивы#№10. Вставка на k-тое место|Вставка на k-тое место]]

==== [[Стандартные задачи на одномерные массивы#Слияние упорядоченных и бинарный поиск в упорядоченном массиве|Слияние упорядоченных и бинарный поиск в упорядоченном массиве]] ====
# [[Стандартные задачи на одномерные массивы#№11. Слияние двух упорядоченных в один упорядоченный|Слияние двух упорядоченных в один упорядоченный]]
# [[Стандартные задачи на одномерные массивы#№12. Поиск в упорядоченном массиве|Поиск в упорядоченном массиве]]

==== [[Стандартные задачи на одномерные массивы#Сортировка массивов|Сортировка массивов]] ====
# [[Стандартные задачи на одномерные массивы#№13. Сортировка выбором|Сортировка выбором]]
# [[Стандартные задачи на одномерные массивы#№14. Пузырьковая сортировка|Пузырьковая сортировка]]
## [[Стандартные задачи на одномерные массивы#Способ №1|Способ №1]]
## [[Стандартные задачи на одномерные массивы#Способ №2|Способ №2]]
# [[Стандартные задачи на одномерные массивы#№15. Сортировка вставками|Сортировка вставками]]

==== [[Стандартные задачи на одномерные массивы#Использование процедурных типов в задачах на массивы|Использование процедурных типов в задачах на массивы]] ====
# [[Стандартные задачи на одномерные массивы#№16. Поиск по условию|Поиск по условию]]
# [[Стандартные задачи на одномерные массивы#№17. Количество по условию|Количество по условию]]
# [[Стандартные задачи на одномерные массивы#№18. Условный минимум|Условный минимум]]
# [[Стандартные задачи на одномерные массивы#№19. Удаление по условию|Удаление по условию]]
(Прошу, делайте господа)

Стандартные задачи на одномерные массивы

2010-12-02T14:33:30Z

Miclus:

= Стандартные задачи на одномерные массивы =

== Простейшие алгоритмы ==

=== №1. Вывод массива ===
<source lang="pascal">procedure Println<T>(a: array of T; delim: string := ' ');
begin
foreach x: T in a do
write(x, delim);
writeln;
end;
</source>

[http://pascalabc.net/WDE/?shared=DaZzz/Arrays/1.pas Ссылка на алгоритм в среде WDE]

=== №2. Заполнение массива случайными числами ===
<source lang="pascal">procedure CreateRandomArray(var a: array of integer; n: integer);
begin
SetLength(a,n);
for var i:=0 to n-1 do
a[i] := random(100);
end;</source>

[http://pascalabc.net/WDE/?shared=DaZzz/Arrays/2.pas Ссылка на алгоритм в среде WDE]

=== №3. Инвертирование массива ===
<source lang="pascal">procedure Invert<T>(a: array of T);
begin
var n := a.Length;
for var i:=0 to n div 2 - 1 do
Swap(a[i],a[n-i-1]);
end; </source>

[http://pascalabc.net/WDE/?shared=DaZzz/Arrays/3.pas Ссылка на алгоритм в среде WDE]

=== №4. Поиск элемента по заданному значению ===
<source lang="pascal">// С помощью for
function Find<T>(a: array of T; x: T): integer;
begin
Result := -1;
for var i := 0 to a.Length - 1 do
if a[i] = x then
begin
Result := i;
break;
end;
end;

// С помощью while
function FindWhile<T>(a: array of T; x: T): integer;
begin
var n := a.Length;
var i := 0;
while (i<n) and (a[i]<>x) do
i += 1;
if i=n then
Result := -1
else Result := i;
end;</source>

[http://pascalabc.net/WDE/?shared=DaZzz/Arrays/4.pas Ссылка на алгоритм в среде WDE]

=== №4a. Поиск с барьером ===
<source lang="pascal">function FindWithBarrier<T>(a: array of T; n: integer; x: T): integer;
begin
Assert((0 < n) and (n < a.Length));
a[n] := x; // барьерный элемент равен разыскиваему
var i := 0;
while a[i]<>x do
i += 1;
if i=n then
Result := -1
else Result := i;
end;</source>

[http://pascalabc.net/WDE/?shared=DaZzz/Arrays/4a.pas Ссылка на алгоритм в среде WDE]

=== №5. Минимальный элемент и его индекс ===
<source lang="pascal">procedure MinElem(a: array of integer; var min: integer; var minind: integer);
begin
min := a[0];
minind := 0;
for var i:=1 to a.Length-1 do
if a[i]<min then
begin
min := a[i];
minind := i;
end;
end;</source>

[http://pascalabc.net/WDE/?shared=DaZzz/Arrays/5.pas Ссылка на алгоритм в среде WDE]

==Сдвиги, вставка, удаление==
=== №6. Сдвиг влево ===
<source lang="pascal">procedure ShiftLeft<T>(a: array of T);
begin
for var i:=0 to a.Length-2 do
a[i] := a[i+1];
a[a.Length-1] := default(T);
end;</source>

[http://pascalabc.net/WDE/?shared=DaZzz/Arrays/6.pas Ссылка на алгоритм в среде WDE]

=== №7. Сдвиг вправо ===
<source lang="pascal">
procedure ShiftRight<T>(a: array of T);
begin
for var i := a.Length-1 downto 1 do
a[i] := a[i-1];
a[0] := default(T);
end;
</source>

[http://pascalabc.net/WDE/?shared=PacVlad/ShiftRight.pas Ссылка на алгоритм в среде WDE]

=== №8. Циклический сдвиг вправо ===
<source lang="pascal">
procedure CycleShiftRight<T>(a: array of T);
begin
var v := a[a.Length-1];
for var i := a.Length downto 1 do
a[i] := a[i-1];
a[0] := v;
end;
</source>

[http://pascalabc.net/WDE/?shared=PacVlad/CycleShiftRight.pas Ссылка на алгоритм в среде WDE]

=== №9. Удаление k-того ===
<source lang="pascal">
procedure Delete<T>(a: array of T; var n: integer; k: integer);
begin
Assert((0<=k) and (k<n))
Assert((0<=n) and (n<=a.Length));
for var i := k to n-2 do
a[i] := a[i+1];
a[n-1] := default(T);
n -= 1;
end;
</source>

[http://pascalabc.net/WDE/?shared=PacVlad/Delete.pas Ссылка на алгоритм в среде WDE]

=== №10. Вставка на k-тое место ===
<source lang="pascal">
procedure Insert<T>(a: array of T; var n: integer; k: integer; value: T);
begin
Assert((0<=k) and (k<=n) and (n<a.Length));
for var i := n-1 downto k do
a[i+1] := a[i];
a[k] := value;
n += 1;
end;
</source>

[http://pascalabc.net/WDE/?shared=PacVlad/Insert.pas Ссылка на алгоритм в среде WDE]

== Слияние упорядоченных и бинарный поиск в упорядоченном массиве==
=== №11. Слияние двух упорядоченных в один упорядоченный ===
<source lang="pascal">
// a,b упорядочены по возрастанию
function Merge(a,b: array of real; na,nb: integer): array of real;
begin
Assert((0 < na) and (na < a.Length));
Assert((0 < nb) and (nb < b.Length));
a[na] := real.MaxValue;
b[nb] := real.MaxValue;
var c := new integer[na + nb];
var ia := 0;
var ib := 0;
for var ic := 0 to na + nb - 1 do
if a[ia]<b[ib] then
begin
c[ic] := a[ia];
ia += 1;
end
else
begin
c[ic] := b[ib];
ib += 1;
end;
Result := c;
end;
</source>

=== №12. Поиск в упорядоченном массиве ===
<source lang="pascal">
function BinarySearch(a: array of integer; x: integer): integer;
begin
var k: integer;
var i := 0;
var j := a.Length-1;
repeat
k := (i+j) div 2;
if x>a[k] then
i := k + 1
else j := k - 1;
until (a[k]=x) or (i>j);
if a[k]=x then
Result := k
else Result := -1;
end;
</source>

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

=== №13. Сортировка выбором ===
<source lang="pascal">
procedure SortByChoice(a: array of integer);
begin
for var i := 0 to a.Length - 2 do
begin
var min := a[i];
var imin := i;
for var j := i + 1 to a.Length - 1 do
if a[j] < min then
begin
min := a[i];
imin := j;
end;
a[imin] := a[i];
a[i] := min;
end;
end;
</source>
[http://pascalabc.net/WDE/?shared=vikvez/alg_for_students/alg_13.pas Ссылка на алгоритм в среде WDE]

=== №14. Пузырьковая сортировка ===
====Способ №1====
<source lang="pascal">
procedure BubbleSort(a: array of integer);
begin
var n := a.Length;
for var i := 0 to n - 2 do
for var j := n - 1 downto i + 1 do
if a[j] < a[j - 1] then
Swap(a[j], a[j - 1]);
end;
</source>
[http://pascalabc.net/WDE/?shared=vikvez/alg_for_students/alg_14.pas Ссылка на алгоритм в среде WDE]

====Способ №2====
<source lang="pascal">
procedure BubbleSort2(a: array of integer);
begin
var i := a.Length - 1;
var q: boolean;
repeat
q := true;
for var j := 0 to i - 1 do
if a[j + 1] < a[j] then
begin
Swap(a[j + 1], a[j]);
q := false;
end;
i -= 1;
until q;
end;
</source>
[http://pascalabc.net/WDE/?shared=vikvez/alg_for_students/alg_14_2.pas Ссылка на алгоритм в среде WDE]

=== №15. Сортировка вставками ===
<source lang="pascal">
procedure SortByInsert(a: array of integer);
begin
for var i := 1 to a.Length - 1 do
begin
var x := a[i];
var j := i - 1;
while (j >= 0) and (x < a[j]) do
begin
a[j + 1] := a[j];
j -= 1;
end;
a[j + 1] := x;
end;
end;
</source>
[http://pascalabc.net/WDE/?shared=vikvez/alg_for_students/alg_15.pas Ссылка на алгоритм в среде WDE]

== Использование процедурных типов в задачах на массивы ==
Пусть сделаны следующие описания:
<source lang="pascal">
type IPredicate = function(x: integer): boolean;

// Примеры предикатов
function Even(x: integer): boolean;
begin
result := not odd(x);
end;

function IsPositive(x: integer): boolean;
begin
Result := x > 0;
end;
</source>

=== №16. Поиск по условию ===
<source lang="pascal">
function FindPred(a: array of integer; pred: IPredicate): integer;
begin
var n := a.Length;
var i := 0;
while (i < n) and not pred(a[i]) do
i += 1;
if i = n then
Result := -1
else Result := i;
end;
</source>
[http://pascalabc.net/WDE/?shared=vikvez/alg_for_students/alg_16.pas Ссылка на алгоритм в среде WDE]

=== №17. Количество по условию ===
<source lang="pascal">
function CountPred(a: array of integer; pred: IPredicate): integer;
begin
Result := 0;
for var i := 0 to a.Length - 1 do
if pred(a[i]) then
Result += 1;
end;
</source>
[http://pascalabc.net/WDE/?shared=Miklus/ArraysWithPredicate/17_CountWithCond.pas Ссылка на алгоритм в среде WDE]

=== №18. Условный минимум ===
<source lang="pascal">
procedure MinElemPred(a: array of integer; pred: IPredicate; var min, imin: integer);
begin
min := Integer.MaxValue;
imin := -1;
for var i := 1 to a.length - 1 do
if pred(a[i]) and (a[i] < min) then
begin
min := a[i];
imin := i;
end;
end;
</source>
[http://pascalabc.net/WDE/?shared=Miklus/ArraysWithPredicate/18_CondMin.pas Ссылка на алгоритм в среде WDE]

=== №19. Удаление по условию ===
<source lang="pascal">
procedure DeleteAll(a: array of integer; var n: integer; pred: IPredicate);
begin
Assert((0 < n) and (n <= a.Length));
var j := 0;
for var i := 0 to n - 1 do
if not pred(a[i]) then
begin
a[j] := a[i];
j += 1;
end;
n := j;
end;
</source>
[http://pascalabc.net/WDE/?shared=Miklus/ArraysWithPredicate/19_DeleteWithCond.pas Ссылка на алгоритм в среде WDE]

----

© Буцев Виктор, Белоусько Тихон, Зуев Семен, Гончаров Владислав, Батраков Михаил, Гаджиев Казанфар, Пак Владислав

Стандартные задачи на одномерные массивы

2010-12-02T13:02:18Z

Miclus:

= Стандартные задачи на одномерные массивы =

== Простейшие алгоритмы ==

=== №1. Вывод массива ===
<source lang="pascal">procedure Println<T>(a: array of T; delim: string := ' ');
begin
foreach x: T in a do
write(x, delim);
writeln;
end;
</source>

[http://pascalabc.net/WDE/?shared=DaZzz/Arrays/1.pas Ссылка на алгоритм в среде WDE]

=== №2. Заполнение массива случайными числами ===
<source lang="pascal">procedure CreateRandomArray(var a: array of integer; n: integer);
begin
SetLength(a,n);
for var i:=0 to n-1 do
a[i] := random(100);
end;</source>

[http://pascalabc.net/WDE/?shared=DaZzz/Arrays/2.pas Ссылка на алгоритм в среде WDE]

=== №3. Инвертирование массива ===
<source lang="pascal">procedure Invert<T>(a: array of T);
begin
var n := a.Length;
for var i:=0 to n div 2 - 1 do
Swap(a[i],a[n-i-1]);
end; </source>

[http://pascalabc.net/WDE/?shared=DaZzz/Arrays/3.pas Ссылка на алгоритм в среде WDE]

=== №4. Поиск элемента по заданному значению ===
<source lang="pascal">// С помощью for
function Find<T>(a: array of T; x: T): integer;
begin
Result := -1;
for var i := 0 to a.Length - 1 do
if a[i] = x then
begin
Result := i;
break;
end;
end;

// С помощью while
function FindWhile<T>(a: array of T; x: T): integer;
begin
var n := a.Length;
var i := 0;
while (i<n) and (a[i]<>x) do
i += 1;
if i=n then
Result := -1
else Result := i;
end;</source>

[http://pascalabc.net/WDE/?shared=DaZzz/Arrays/4.pas Ссылка на алгоритм в среде WDE]

=== №4a. Поиск с барьером ===
<source lang="pascal">function FindWithBarrier<T>(a: array of T; n: integer; x: T): integer;
begin
Assert((0 < n) and (n < a.Length));
a[n] := x; // барьерный элемент равен разыскиваему
var i := 0;
while a[i]<>x do
i += 1;
if i=n then
Result := -1
else Result := i;
end;</source>

[http://pascalabc.net/WDE/?shared=DaZzz/Arrays/4a.pas Ссылка на алгоритм в среде WDE]

=== №5. Минимальный элемент и его индекс ===
<source lang="pascal">procedure MinElem(a: array of integer; var min: integer; var minind: integer);
begin
min := a[0];
minind := 0;
for var i:=1 to a.Length-1 do
if a[i]<min then
begin
min := a[i];
minind := i;
end;
end;</source>

[http://pascalabc.net/WDE/?shared=DaZzz/Arrays/5.pas Ссылка на алгоритм в среде WDE]

==Сдвиги, вставка, удаление==
=== №6. Сдвиг влево ===
<source lang="pascal">procedure ShiftLeft<T>(a: array of T);
begin
for var i:=0 to a.Length-2 do
a[i] := a[i+1];
a[a.Length-1] := default(T);
end;</source>

[http://pascalabc.net/WDE/?shared=DaZzz/Arrays/6.pas Ссылка на алгоритм в среде WDE]

=== №7. Сдвиг вправо ===
<source lang="pascal">
procedure ShiftRight<T>(a: array of T);
begin
for var i := a.Length-1 downto 1 do
a[i] := a[i-1];
a[0] := default(T);
end;
</source>

[http://pascalabc.net/WDE/?shared=PacVlad/ShiftRight.pas Ссылка на алгоритм в среде WDE]

=== №8. Циклический сдвиг вправо ===
<source lang="pascal">
procedure CycleShiftRight<T>(a: array of T);
begin
var v := a[a.Length-1];
for var i := a.Length downto 1 do
a[i] := a[i-1];
a[0] := v;
end;
</source>

[http://pascalabc.net/WDE/?shared=PacVlad/CycleShiftRight.pas Ссылка на алгоритм в среде WDE]

=== №9. Удаление k-того ===
<source lang="pascal">
procedure Delete<T>(a: array of T; var n: integer; k: integer);
begin
Assert((0<=k) and (k<n))
Assert((0<=n) and (n<=a.Length));
for var i := k to n-2 do
a[i] := a[i+1];
a[n-1] := default(T);
n -= 1;
end;
</source>

[http://pascalabc.net/WDE/?shared=PacVlad/Delete.pas Ссылка на алгоритм в среде WDE]

=== №10. Вставка на k-тое место ===
<source lang="pascal">
procedure Insert<T>(a: array of T; var n: integer; k: integer; value: T);
begin
Assert((0<=k) and (k<=n) and (n<a.Length));
for var i := n-1 downto k do
a[i+1] := a[i];
a[k] := value;
n += 1;
end;
</source>

[http://pascalabc.net/WDE/?shared=PacVlad/Insert.pas Ссылка на алгоритм в среде WDE]

== Слияние упорядоченных и бинарный поиск в упорядоченном массиве==
=== №11. Слияние двух упорядоченных в один упорядоченный ===
<source lang="pascal">
// a,b упорядочены по возрастанию
function Merge(a,b: array of real; na,nb: integer): array of real;
begin
Assert((0 < na) and (na < a.Length));
Assert((0 < nb) and (nb < b.Length));
a[na] := real.MaxValue;
b[nb] := real.MaxValue;
var c := new integer[na + nb];
var ia := 0;
var ib := 0;
for var ic := 0 to na + nb - 1 do
if a[ia]<b[ib] then
begin
c[ic] := a[ia];
ia += 1;
end
else
begin
c[ic] := b[ib];
ib += 1;
end;
Result := c;
end;
</source>

=== №12. Поиск в упорядоченном массиве ===
<source lang="pascal">
function BinarySearch(a: array of integer; x: integer): integer;
begin
var k: integer;
var i := 0;
var j := a.Length-1;
repeat
k := (i+j) div 2;
if x>a[k] then
i := k + 1
else j := k - 1;
until (a[k]=x) or (i>j);
if a[k]=x then
Result := k
else Result := -1;
end;
</source>

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

=== №13. Сортировка выбором ===
<source lang="pascal">
procedure SortByChoice(a: array of integer);
begin
for var i := 0 to a.Length - 2 do
begin
var min := a[i];
var imin := i;
for var j := i + 1 to a.Length - 1 do
if a[j] < min then
begin
min := a[i];
imin := j;
end;
a[imin] := a[i];
a[i] := min;
end;
end;
</source>
[http://pascalabc.net/WDE/?shared=vikvez/alg_for_students/alg_13.pas Ссылка на алгоритм в среде WDE]

=== №14. Пузырьковая сортировка ===
====Способ №1====
<source lang="pascal">
procedure BubbleSort(a: array of integer);
begin
var n := a.Length;
for var i := 0 to n - 2 do
for var j := n - 1 downto i + 1 do
if a[j] < a[j - 1] then
Swap(a[j], a[j - 1]);
end;
</source>
[http://pascalabc.net/WDE/?shared=vikvez/alg_for_students/alg_14.pas Ссылка на алгоритм в среде WDE]

====Способ №2====
<source lang="pascal">
procedure BubbleSort2(a: array of integer);
begin
var i := a.Length - 1;
var q: boolean;
repeat
q := true;
for var j := 0 to i - 1 do
if a[j + 1] < a[j] then
begin
Swap(a[j + 1], a[j]);
q := false;
end;
i -= 1;
until q;
end;
</source>
[http://pascalabc.net/WDE/?shared=vikvez/alg_for_students/alg_14_2.pas Ссылка на алгоритм в среде WDE]

=== №15. Сортировка вставками ===
<source lang="pascal">
procedure SortByInsert(a: array of integer);
begin
for var i := 1 to a.Length - 1 do
begin
var x := a[i];
var j := i - 1;
while (j >= 0) and (x < a[j]) do
begin
a[j + 1] := a[j];
j -= 1;
end;
a[j + 1] := x;
end;
end;
</source>
[http://pascalabc.net/WDE/?shared=vikvez/alg_for_students/alg_15.pas Ссылка на алгоритм в среде WDE]

== Использование процедурных типов в задачах на массивы ==
Пусть сделаны следующие описания:
<source lang="pascal">
type IPredicate = function(x: integer): boolean;

// Примеры предикатов
function Even(x: integer): boolean;
begin
result := not odd(x);
end;

function IsPositive(x: integer): boolean;
begin
Result := x > 0;
end;
</source>

=== №16. Поиск по условию ===
<source lang="pascal">
function FindPred(a: array of integer; pred: IPredicate): integer;
begin
var n := a.Length;
var i := 0;
while (i < n) and not pred(a[i]) do
i += 1;
if i = n then
Result := -1
else Result := i;
end;
</source>
[http://pascalabc.net/WDE/?shared=vikvez/alg_for_students/alg_16.pas Ссылка на алгоритм в среде WDE]

=== №17. Количество по условию ===
<source lang="pascal">
function CountPred(a: array of integer; pred: IPredicate): integer;
begin
Result := 0;
for var i := 0 to a.Length - 1 do
if pred(a[i]) then
Result += 1;
end;
</source>

[http://pascalabc.net/WDE/?shared=Miklus/ArraysWithPredicate/17_CountWithCond.pas Ссылка на алгоритм в среде WDE]

=== №18. Условный минимум ===
<source lang="pascal">
procedure MinElemPred(a: array of integer; pred: IPredicate; var min, imin: integer);
begin
min := Integer.MaxValue;
imin := -1;
for var i := 1 to a.length - 1 do
if pred(a[i]) and (a[i] < min) then
begin
min := a[i];
imin := i;
end;
end;
</source>

[http://pascalabc.net/WDE/?shared=Miklus/ArraysWithPredicate/18_CondMin.pas Ссылка на алгоритм в среде WDE]

=== №19. Удаление по условию ===
<source lang="pascal">
procedure DeleteAll(a: array of integer; var n: integer; pred: IPredicate);
begin
Assert((0 < n) and (n <= a.Length));
var j := 0;
for var i := 0 to n - 1 do
if not pred(a[i]) then
begin
a[j] := a[i];
j += 1;
end;
n := j;
end;
</source>

[http://pascalabc.net/WDE/?shared=Miklus/ArraysWithPredicate/19_DeleteWithCond.pas Ссылка на алгоритм в среде WDE]

----

© Буцев Виктор, Белоусько Тихон, Зуев Семен, Гончаров Владислав, Батраков Михаил, Гаджиев Казанфар, Пак Владислав

Стандартные задачи на одномерные массивы

2010-12-02T12:48:57Z

Miclus:

= Стандартные задачи на одномерные массивы =

== Простейшие алгоритмы ==

=== №1. Вывод массива ===
<source lang="pascal">procedure Println<T>(a: array of T; delim: string := ' ');
begin
foreach x: T in a do
write(x, delim);
writeln;
end;
</source>

[http://pascalabc.net/WDE/?shared=DaZzz/Arrays/1.pas Ссылка на алгоритм в среде WDE]

=== №2. Заполнение массива случайными числами ===
<source lang="pascal">procedure CreateRandomArray(var a: array of integer; n: integer);
begin
SetLength(a,n);
for var i:=0 to n-1 do
a[i] := random(100);
end;</source>

[http://pascalabc.net/WDE/?shared=DaZzz/Arrays/2.pas Ссылка на алгоритм в среде WDE]

=== №3. Инвертирование массива ===
<source lang="pascal">procedure Invert<T>(a: array of T);
begin
var n := a.Length;
for var i:=0 to n div 2 - 1 do
Swap(a[i],a[n-i-1]);
end; </source>

[http://pascalabc.net/WDE/?shared=DaZzz/Arrays/3.pas Ссылка на алгоритм в среде WDE]

=== №4. Поиск элемента по заданному значению ===
<source lang="pascal">// С помощью for
function Find<T>(a: array of T; x: T): integer;
begin
Result := -1;
for var i := 0 to a.Length - 1 do
if a[i] = x then
begin
Result := i;
break;
end;
end;

// С помощью while
function FindWhile<T>(a: array of T; x: T): integer;
begin
var n := a.Length;
var i := 0;
while (i<n) and (a[i]<>x) do
i += 1;
if i=n then
Result := -1
else Result := i;
end;</source>

[http://pascalabc.net/WDE/?shared=DaZzz/Arrays/4.pas Ссылка на алгоритм в среде WDE]

=== №4a. Поиск с барьером ===
<source lang="pascal">function FindWithBarrier<T>(a: array of T; n: integer; x: T): integer;
begin
Assert((0 < n) and (n < a.Length));
a[n] := x; // барьерный элемент равен разыскиваему
var i := 0;
while a[i]<>x do
i += 1;
if i=n then
Result := -1
else Result := i;
end;</source>

[http://pascalabc.net/WDE/?shared=DaZzz/Arrays/4a.pas Ссылка на алгоритм в среде WDE]

=== №5. Минимальный элемент и его индекс ===
<source lang="pascal">procedure MinElem(a: array of integer; var min: integer; var minind: integer);
begin
min := a[0];
minind := 0;
for var i:=1 to a.Length-1 do
if a[i]<min then
begin
min := a[i];
minind := i;
end;
end;</source>

[http://pascalabc.net/WDE/?shared=DaZzz/Arrays/5.pas Ссылка на алгоритм в среде WDE]

==Сдвиги, вставка, удаление==
=== №6. Сдвиг влево ===
<source lang="pascal">procedure ShiftLeft<T>(a: array of T);
begin
for var i:=0 to a.Length-2 do
a[i] := a[i+1];
a[a.Length-1] := default(T);
end;</source>

[http://pascalabc.net/WDE/?shared=DaZzz/Arrays/6.pas Ссылка на алгоритм в среде WDE]

=== №7. Сдвиг вправо ===
<source lang="pascal">
procedure ShiftRight<T>(a: array of T);
begin
for var i := a.Length-1 downto 1 do
a[i] := a[i-1];
a[0] := default(T);
end;
</source>

[http://pascalabc.net/WDE/?shared=PacVlad/ShiftRight.pas Ссылка на алгоритм в среде WDE]

=== №8. Циклический сдвиг вправо ===
<source lang="pascal">
procedure CycleShiftRight<T>(a: array of T);
begin
var v := a[a.Length-1];
for var i := a.Length downto 1 do
a[i] := a[i-1];
a[0] := v;
end;
</source>

[http://pascalabc.net/WDE/?shared=PacVlad/CycleShiftRight.pas Ссылка на алгоритм в среде WDE]

=== №9. Удаление k-того ===
<source lang="pascal">
procedure Delete<T>(a: array of T; var n: integer; k: integer);
begin
Assert((0<=k) and (k<n))
Assert((0<=n) and (n<=a.Length));
for var i := k to n-2 do
a[i] := a[i+1];
a[n-1] := default(T);
n -= 1;
end;
</source>

[http://pascalabc.net/WDE/?shared=PacVlad/Delete.pas Ссылка на алгоритм в среде WDE]

=== №10. Вставка на k-тое место ===
<source lang="pascal">
procedure Insert<T>(a: array of T; var n: integer; k: integer; value: T);
begin
Assert((0<=k) and (k<=n) and (n<a.Length));
for var i := n-1 downto k do
a[i+1] := a[i];
a[k] := value;
n += 1;
end;
</source>

[http://pascalabc.net/WDE/?shared=PacVlad/Insert.pas Ссылка на алгоритм в среде WDE]

== Слияние упорядоченных и бинарный поиск в упорядоченном массиве==
=== №11. Слияние двух упорядоченных в один упорядоченный ===
<source lang="pascal">
// a,b упорядочены по возрастанию
function Merge(a,b: array of real; na,nb: integer): array of real;
begin
Assert((0 < na) and (na < a.Length));
Assert((0 < nb) and (nb < b.Length));
a[na] := real.MaxValue;
b[nb] := real.MaxValue;
var c := new integer[na + nb];
var ia := 0;
var ib := 0;
for var ic := 0 to na + nb - 1 do
if a[ia]<b[ib] then
begin
c[ic] := a[ia];
ia += 1;
end
else
begin
c[ic] := b[ib];
ib += 1;
end;
Result := c;
end;
</source>

=== №12. Поиск в упорядоченном массиве ===
<source lang="pascal">
function BinarySearch(a: array of integer; x: integer): integer;
begin
var k: integer;
var i := 0;
var j := a.Length-1;
repeat
k := (i+j) div 2;
if x>a[k] then
i := k + 1
else j := k - 1;
until (a[k]=x) or (i>j);
if a[k]=x then
Result := k
else Result := -1;
end;
</source>

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

=== №13. Сортировка выбором ===
<source lang="pascal">
procedure SortByChoice(a: array of integer);
begin
for var i := 0 to a.Length - 2 do
begin
var min := a[i];
var imin := i;
for var j := i + 1 to a.Length - 1 do
if a[j] < min then
begin
min := a[i];
imin := j;
end;
a[imin] := a[i];
a[i] := min;
end;
end;
</source>
[http://pascalabc.net/WDE/?shared=vikvez/alg_for_students/alg_13.pas Ссылка на алгоритм в среде WDE]

=== №14. Пузырьковая сортировка ===
====Способ №1====
<source lang="pascal">
procedure BubbleSort(a: array of integer);
begin
var n := a.Length;
for var i := 0 to n - 2 do
for var j := n - 1 downto i + 1 do
if a[j] < a[j - 1] then
Swap(a[j], a[j - 1]);
end;
</source>
[http://pascalabc.net/WDE/?shared=vikvez/alg_for_students/alg_14.pas Ссылка на алгоритм в среде WDE]

====Способ №2====
<source lang="pascal">
procedure BubbleSort2(a: array of integer);
begin
var i := a.Length - 1;
var q: boolean;
repeat
q := true;
for var j := 0 to i - 1 do
if a[j + 1] < a[j] then
begin
Swap(a[j + 1], a[j]);
q := false;
end;
i -= 1;
until q;
end;
</source>
[http://pascalabc.net/WDE/?shared=vikvez/alg_for_students/alg_14_2.pas Ссылка на алгоритм в среде WDE]

=== №15. Сортировка вставками ===
<source lang="pascal">
procedure SortByInsert(a: array of integer);
begin
for var i := 1 to a.Length - 1 do
begin
var x := a[i];
var j := i - 1;
while (j >= 0) and (x < a[j]) do
begin
a[j + 1] := a[j];
j -= 1;
end;
a[j + 1] := x;
end;
end;
</source>
[http://pascalabc.net/WDE/?shared=vikvez/alg_for_students/alg_15.pas Ссылка на алгоритм в среде WDE]

== Использование процедурных типов в задачах на массивы ==
Пусть сделаны следующие описания:
<source lang="pascal">
type IPredicate = function(x: integer): boolean;

// Примеры предикатов
function Even(x: integer): boolean;
begin
result := not odd(x);
end;

function IsPositive(x: integer): boolean;
begin
Result := x > 0;
end;
</source>

=== №16. Поиск по условию ===
<source lang="pascal">
function FindPred(a: array of integer; pred: IPredicate): integer;
begin
var n := a.Length;
var i := 0;
while (i < n) and not pred(a[i]) do
i += 1;
if i = n then
Result := -1
else Result := i;
end;
</source>
[http://pascalabc.net/WDE/?shared=vikvez/alg_for_students/alg_16.pas Ссылка на алгоритм в среде WDE]

=== №17. Количество по условию ===
<source lang="pascal">
function CountPred(a: array of integer; pred: IPredicate): integer;
begin
Result := 0;
for var i := 0 to a.Length - 1 do
if pred(a[i]) then
Result += 1;
end;
</source>

[http://pascalabc.net/WDE/?shared=Miklus/ArraysWithPredicate/17_CountWithCond.pas Ссылка на алгоритм в среде WDE]

=== №18. Условный минимум ===
<source lang="pascal">
procedure MinElemPred(a: array of integer; pred: IPredicate; var min, imin: integer);
begin
min := Integer.MaxValue;
imin := -1;
for var i := 1 to a.length - 1 do
if pred(a[i]) and (a[i] < min) then
begin
min := a[i];
imin := i;
end;
end;
</source>

[http://pascalabc.net/WDE/?shared=Miklus/ArraysWithPredicate/18_CondMin.pas Ссылка на алгоритм в среде WDE]

=== №19. Удаление по условию ===
<source lang="pascal">
procedure DeleteAll(a: array of integer; var n: integer; pred: IPredicate);
begin
Assert((0 < n) and (n <= a.Length));
var j := 0;
for var i := 0 to n - 1 do
if not pred(a[i]) then
begin
a[j] := a[i];
j += 1;
end;
n := j;
end;
</source>

----

© Буцев Виктор, Белоусько Тихон, Зуев Семен, Гончаров Владислав, Батраков Михаил, Гаджиев Казанфар, Пак Владислав

Стандартные задачи на одномерные массивы

2010-12-02T12:39:06Z

Miclus:

= Стандартные задачи на одномерные массивы =

== Простейшие алгоритмы ==

=== №1. Вывод массива ===
<source lang="pascal">procedure Println<T>(a: array of T; delim: string := ' ');
begin
foreach x: T in a do
write(x, delim);
writeln;
end;
</source>

[http://pascalabc.net/WDE/?shared=DaZzz/Arrays/1.pas Ссылка на алгоритм в среде WDE]

=== №2. Заполнение массива случайными числами ===
<source lang="pascal">procedure CreateRandomArray(var a: array of integer; n: integer);
begin
SetLength(a,n);
for var i:=0 to n-1 do
a[i] := random(100);
end;</source>

[http://pascalabc.net/WDE/?shared=DaZzz/Arrays/2.pas Ссылка на алгоритм в среде WDE]

=== №3. Инвертирование массива ===
<source lang="pascal">procedure Invert<T>(a: array of T);
begin
var n := a.Length;
for var i:=0 to n div 2 - 1 do
Swap(a[i],a[n-i-1]);
end; </source>

[http://pascalabc.net/WDE/?shared=DaZzz/Arrays/3.pas Ссылка на алгоритм в среде WDE]

=== №4. Поиск элемента по заданному значению ===
<source lang="pascal">// С помощью for
function Find<T>(a: array of T; x: T): integer;
begin
Result := -1;
for var i := 0 to a.Length - 1 do
if a[i] = x then
begin
Result := i;
break;
end;
end;

// С помощью while
function FindWhile<T>(a: array of T; x: T): integer;
begin
var n := a.Length;
var i := 0;
while (i<n) and (a[i]<>x) do
i += 1;
if i=n then
Result := -1
else Result := i;
end;</source>

[http://pascalabc.net/WDE/?shared=DaZzz/Arrays/4.pas Ссылка на алгоритм в среде WDE]

=== №4a. Поиск с барьером ===
<source lang="pascal">function FindWithBarrier<T>(a: array of T; n: integer; x: T): integer;
begin
Assert((0 < n) and (n < a.Length));
a[n] := x; // барьерный элемент равен разыскиваему
var i := 0;
while a[i]<>x do
i += 1;
if i=n then
Result := -1
else Result := i;
end;</source>

[http://pascalabc.net/WDE/?shared=DaZzz/Arrays/4a.pas Ссылка на алгоритм в среде WDE]

=== №5. Минимальный элемент и его индекс ===
<source lang="pascal">procedure MinElem(a: array of integer; var min: integer; var minind: integer);
begin
min := a[0];
minind := 0;
for var i:=1 to a.Length-1 do
if a[i]<min then
begin
min := a[i];
minind := i;
end;
end;</source>

[http://pascalabc.net/WDE/?shared=DaZzz/Arrays/5.pas Ссылка на алгоритм в среде WDE]

==Сдвиги, вставка, удаление==
=== №6. Сдвиг влево ===
<source lang="pascal">procedure ShiftLeft<T>(a: array of T);
begin
for var i:=0 to a.Length-2 do
a[i] := a[i+1];
a[a.Length-1] := default(T);
end;</source>

[http://pascalabc.net/WDE/?shared=DaZzz/Arrays/6.pas Ссылка на алгоритм в среде WDE]

=== №7. Сдвиг вправо ===
<source lang="pascal">
procedure ShiftRight<T>(a: array of T);
begin
for var i := a.Length-1 downto 1 do
a[i] := a[i-1];
a[0] := default(T);
end;
</source>

[http://pascalabc.net/WDE/?shared=PacVlad/ShiftRight.pas Ссылка на алгоритм в среде WDE]

=== №8. Циклический сдвиг вправо ===
<source lang="pascal">
procedure CycleShiftRight<T>(a: array of T);
begin
var v := a[a.Length-1];
for var i := a.Length downto 1 do
a[i] := a[i-1];
a[0] := v;
end;
</source>

[http://pascalabc.net/WDE/?shared=PacVlad/CycleShiftRight.pas Ссылка на алгоритм в среде WDE]

=== №9. Удаление k-того ===
<source lang="pascal">
procedure Delete<T>(a: array of T; var n: integer; k: integer);
begin
Assert((0<=k) and (k<n))
Assert((0<=n) and (n<=a.Length));
for var i := k to n-2 do
a[i] := a[i+1];
a[n-1] := default(T);
n -= 1;
end;
</source>

[http://pascalabc.net/WDE/?shared=PacVlad/Delete.pas Ссылка на алгоритм в среде WDE]

=== №10. Вставка на k-тое место ===
<source lang="pascal">
procedure Insert<T>(a: array of T; var n: integer; k: integer; value: T);
begin
Assert((0<=k) and (k<=n) and (n<a.Length));
for var i := n-1 downto k do
a[i+1] := a[i];
a[k] := value;
n += 1;
end;
</source>

[http://pascalabc.net/WDE/?shared=PacVlad/Insert.pas Ссылка на алгоритм в среде WDE]

== Слияние упорядоченных и бинарный поиск в упорядоченном массиве==
=== №11. Слияние двух упорядоченных в один упорядоченный ===
<source lang="pascal">
// a,b упорядочены по возрастанию
function Merge(a,b: array of real; na,nb: integer): array of real;
begin
Assert((0 < na) and (na < a.Length));
Assert((0 < nb) and (nb < b.Length));
a[na] := real.MaxValue;
b[nb] := real.MaxValue;
var c := new integer[na + nb];
var ia := 0;
var ib := 0;
for var ic := 0 to na + nb - 1 do
if a[ia]<b[ib] then
begin
c[ic] := a[ia];
ia += 1;
end
else
begin
c[ic] := b[ib];
ib += 1;
end;
Result := c;
end;
</source>

=== №12. Поиск в упорядоченном массиве ===
<source lang="pascal">
function BinarySearch(a: array of integer; x: integer): integer;
begin
var k: integer;
var i := 0;
var j := a.Length-1;
repeat
k := (i+j) div 2;
if x>a[k] then
i := k + 1
else j := k - 1;
until (a[k]=x) or (i>j);
if a[k]=x then
Result := k
else Result := -1;
end;
</source>

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

=== №13. Сортировка выбором ===
<source lang="pascal">
procedure SortByChoice(a: array of integer);
begin
for var i := 0 to a.Length - 2 do
begin
var min := a[i];
var imin := i;
for var j := i + 1 to a.Length - 1 do
if a[j] < min then
begin
min := a[i];
imin := j;
end;
a[imin] := a[i];
a[i] := min;
end;
end;
</source>
[http://pascalabc.net/WDE/?shared=vikvez/alg_for_students/alg_13.pas Ссылка на алгоритм в среде WDE]

=== №14. Пузырьковая сортировка ===
====Способ №1====
<source lang="pascal">
procedure BubbleSort(a: array of integer);
begin
var n := a.Length;
for var i := 0 to n - 2 do
for var j := n - 1 downto i + 1 do
if a[j] < a[j - 1] then
Swap(a[j], a[j - 1]);
end;
</source>
[http://pascalabc.net/WDE/?shared=vikvez/alg_for_students/alg_14.pas Ссылка на алгоритм в среде WDE]

====Способ №2====
<source lang="pascal">
procedure BubbleSort2(a: array of integer);
begin
var i := a.Length - 1;
var q: boolean;
repeat
q := true;
for var j := 0 to i - 1 do
if a[j + 1] < a[j] then
begin
Swap(a[j + 1], a[j]);
q := false;
end;
i -= 1;
until q;
end;
</source>
[http://pascalabc.net/WDE/?shared=vikvez/alg_for_students/alg_14_2.pas Ссылка на алгоритм в среде WDE]

=== №15. Сортировка вставками ===
<source lang="pascal">
procedure SortByInsert(a: array of integer);
begin
for var i := 1 to a.Length - 1 do
begin
var x := a[i];
var j := i - 1;
while (j >= 0) and (x < a[j]) do
begin
a[j + 1] := a[j];
j -= 1;
end;
a[j + 1] := x;
end;
end;
</source>
[http://pascalabc.net/WDE/?shared=vikvez/alg_for_students/alg_15.pas Ссылка на алгоритм в среде WDE]

== Использование процедурных типов в задачах на массивы ==
Пусть сделаны следующие описания:
<source lang="pascal">
type IPredicate = function(x: integer): boolean;

// Примеры предикатов
function Even(x: integer): boolean;
begin
result := not odd(x);
end;

function IsPositive(x: integer): boolean;
begin
Result := x > 0;
end;
</source>

=== №16. Поиск по условию ===
<source lang="pascal">
function FindPred(a: array of integer; pred: IPredicate): integer;
begin
var n := a.Length;
var i := 0;
while (i < n) and not pred(a[i]) do
i += 1;
if i = n then
Result := -1
else Result := i;
end;
</source>
[http://pascalabc.net/WDE/?shared=vikvez/alg_for_students/alg_16.pas Ссылка на алгоритм в среде WDE]

=== №17. Количество по условию ===
<source lang="pascal">
function CountPred(a: array of integer; pred: IPredicate): integer;
begin
Result := 0;
for var i := 0 to a.Length - 1 do
if pred(a[i]) then
Result += 1;
end;
</source>

[http://pascalabc.net/WDE/?shared=Miklus/Использование предикатов в задачах на массивы/17_CountWithCond.pas]

=== №18. Условный минимум ===
<source lang="pascal">
procedure MinElemPred(a: array of integer; pred: IPredicate; var min, imin: integer);
begin
min := Integer.MaxValue;
imin := -1;
for var i := 1 to a.length - 1 do
if pred(a[i]) and (a[i] < min) then
begin
min := a[i];
imin := i;
end;
end;
</source>

[http://pascalabc.net/WDE/?shared=Miklus/Использование предикатов в задачах на массивы/18_CondMin.pas]

=== №19. Удаление по условию ===
<source lang="pascal">
procedure DeleteAll(a: array of integer; var n: integer; pred: IPredicate);
begin
Assert((0 < n) and (n <= a.Length));
var j := 0;
for var i := 0 to n - 1 do
if not pred(a[i]) then
begin
a[j] := a[i];
j += 1;
end;
n := j;
end;
</source>

----

© Буцев Виктор, Белоусько Тихон, Зуев Семен, Гончаров Владислав, Батраков Михаил, Гаджиев Казанфар, Пак Владислав

Алгоритмы для студентов

2010-11-29T17:20:05Z

Miclus:

= Стандартные задачи на циклы =

== Простейшие алгоритмы ==

=== №1. Сумма вводимых целых чисел ===
<source lang="pascal">
begin
var x , n : integer;
var s := 0;
writeln('Введите число слагаемых');
readln(n);
for var i:=1 to n do
begin
writeln('Введите слагаемое');
readln(x);
s += x;
end;
writeln('Сумма слагаемых равна ',s);
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_01_Kazik.pas Ссылка на алгоритм в среде WDE]

=== №2. Произведение целых чисел ===
<source lang="pascal">
begin
var x , n : integer;
var p := 1;
writeln('Введите число множителей');
readln(n);
for var i:=1 to n do
begin
writeln('Введите множитель');
readln(x);
p *= x;
end;
writeln('Произведение равно ', p);
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_02_Kazik.pas Ссылка на алгоритм в среде WDE]

=== №3. Двойной факториал n!!=n*(n-2)*(n-4)*...*2 (или 1) ===
<source lang="pascal">
begin
var p := 1;
var x , n : integer;
writeln('Введите n');
readln(x);
while x>=2 do
begin
p *= x;
x -= 2;
end;
writeln('Двойной факториал равен ', p);
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_03_Kazik.pas Ссылка на алгоритм в среде WDE]

=== №4. Сколько нечетных среди n введенных ===
<source lang="pascal">
begin
var x , n : integer;
var c := 0;
writeln('Введите n');
readln(n);
for var i:=1 to n do
begin
writeln('Введите целое число');
readln(x);
if x mod 2 <> 0 then
c += 1;
end;
writeln('Количество нечетных равно ', c);
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_04_Kazik.pas Ссылка на алгоритм в среде WDE]

=== №5. Защита от неверного ввода ===
<source lang="pascal">
begin
var x : real;
repeat
write('Введите x>0 ');
read(x);
if x<=0 then
writeln('Неверный ввод');
until x>0;
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_05_Kazik.pas Ссылка на алгоритм в среде WDE]

=== №6. Табулирование функции f(x) на [a,b] в точках, разбивающих [a,b] на N частей ===
<source lang="pascal">
function f(x : real): real;
begin
//Введите любую функцию
result := sin(x);
end;

begin
var N : integer;
var a , b : real;
writeln('Введите N');
readln(N);
writeln('Введите a и b');
read(a,b);
Assert(N>0);
var h := (b-a)/N;
var x := a;
for var i:=0 to N do
begin
writeln('Значение икса равно ',x);
writeln('Значение функции равно ', f(x):10:4);
x += h;
end;
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_06_Kazik.pas Ссылка на алгоритм в среде WDE]

=== №6a. Решение, использующее while. Погрешность округления и вычислительная погрешность ===
<source lang="pascal">
function f(x : real): real;
begin
//Введите любую функцию
result := sin(x);
end;

begin
var N : integer;
var a , b : real;
writeln('Введите N');
readln(N);
writeln('Введите a и b');
read(a,b);
Assert(N>0);
var h := (b-a)/N;
var x := a;
while x <= b+h/2 do
begin
writeln('Значение икса равно ',x:5:2,' Значение функции ', f(x):10:4);
x += h;
end;
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_06a_Kazik.pas Ссылка на алгоритм в среде WDE]

== Рекуррентные соотношения ==

=== №7. Вывод 10 первых степеней двойки ===
<source lang="pascal">
begin
var x := 2;
for var i := 1 to 10 do
begin
writeln(i:2,x:5);
x *= 2;
end;
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_07.pas Ссылка на алгоритм в среде WDE]

=== №8. Вывод всех двухзначных чисел, кратных 5 ===
<source lang="pascal">
begin
var x := 10;
while x < 100 do
begin
writeln(x:3);
x += 5;
end;
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_08.pas Ссылка на алгоритм в среде WDE]

=== №9. Вывод n первых чисел Фибоначчи ===
<source lang="pascal">
begin
write('Введите целое число n (n > 1): ');
var n : integer;
readln(n);
var a := 1;
var b := 1;
write(1, ' ', 1, ' ');
for var i := 3 to n do
begin
var c := a + b;
write(c, ' ');
a := b;
b := c;
end;
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_09.pas Ссылка на алгоритм в среде WDE]

=== №10. Найти НОД(A,B), используя алгоритм Евклида: ===

НОД(A,B) = НОД(B,A mod B); НОД(A,0) = A
<source lang="pascal">
begin
write('Введите целые числа A и B: ');
var A,B,C : integer;
readln(A,B);
repeat
C := A mod B;
A := B;
B := C;
until C = 0;
write('НОД(A,B) = ', A);
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_10.pas Ссылка на алгоритм в среде WDE]

=== №11. Найти сумму цифр целого положительного числа m ===
<source lang="pascal">
begin
write('Введите целое положительное число m: ');
var m : integer;
readln(m);
assert(m > 0);
var s := 0;
while m > 0 do
begin
s += m mod 10;
m := m div 10;
end;
writeln('Сумма цифр числа m равна ', s);
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_11.pas Ссылка на алгоритм в среде WDE]

== Максимумы и минимумы ==

=== №12. Найти max из введенных чисел ===
<source lang="pascal">
begin
write('Введите целое число n (n>0): ');
var n : integer;
readln(n);
assert(n>0);
write('Введите 1 число: ');
var x : real;
readln(x);
var max := x;
for var i := 2 to n do
begin
write('Введите ', i, ' число: ');
readln(x);
if max < x then
max := x;
end;
writeln('Максимальное из введенных чисел: ', max);
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_12.pas Ссылка на алгоритм в среде WDE]

=== №12a. Найти min, удовлетворяющее условию p(x) ===
<source lang="pascal">
// Условие взятое как пример (Если число положительное, то условие p(x) возвращает true, иначе false)
function p(x : real) : boolean;
begin
if x > 0 then
Result := true
else
Result := false;
end;

begin
write('Введите целое число n (n>0): ');
var n : integer;
readln(n);
assert(n>0);
var min := real.MaxValue;
for var i := 1 to n do
begin
var x : real;
write('Введите ', i, ' число: ');
readln(x);
if (x < min) and p(x) then
min := x;
end;
if min = real.MaxValue then
writeln('Нет чисел удовлетворяющих условию (являющихся положительными)')
else
writeln('Минимальное из введенных чисел и удовлетворяющее условию (являющееся положительным): ', min);
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_12a.pas Ссылка на алгоритм в среде WDE]

== Суммирование рядов (конечных и бесконечных) ==

=== №13. Вычислить Σ(i=1..n) a^i/i! ===
<source lang="pascal">
begin
write('Введите число a и n (n>0): ');
var a : real;
var n : integer;
readln(a,n);
assert(n>0);
var x := a;
var s := x;
for var i := 2 to n do
begin
x *= a / i;
s += x;
end;
writeln('Сумма ',chrunicode(931),'(i=1..n) a^i/i! равна ', s);
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_13.pas Ссылка на алгоритм в среде WDE]

=== №13a. Вычислить Σ(i=1..∞) (-1)^i * a^i/i! ===
<source lang="pascal">
begin
write('Введите число a (0 < a < 1): ');
var a : real;
readln(a);
assert((a>0) and (a<1));
var eps := 0.0001;
var i := 1;
var s := 0.0;
var y := -a;
repeat
s += y / i;
i += 1;
y *= -a;
until abs(y/i) < eps;
writeln('Сумма ',chrunicode(931),'(i=1..',chrunicode(8734),') (-1)^i * a^i/i! равна ', s);
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_13a.pas Ссылка на алгоритм в среде WDE]

== Поиск значения ==

=== №14. Есть ли среди введенных число k? ===
<source lang="pascal">
begin
write('Введите целые числа n (n>0) и k: ');
var n,k : integer;
readln(n,k);
assert(n>0);
var Exists := false;
for var i := 1 to n do
begin
write('Введите ', i, ' целое число: ');
var x : integer;
readln(x);
if x = k then
Exists := true;
end;
if Exists then
writeln('Число ', k, ' было введено')
else
writeln('Число ', k, ' не было введено');
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_14.pas Ссылка на алгоритм в среде WDE]

=== №14a. Есть ли среди введенных число k? (то же с использованием break) ===
<source lang="pascal">
begin
write('Введите целые числа n (n>0) и k: ');
var n,k : integer;
readln(n,k);
assert(n>0);
var Exists := false;
for var i := 1 to n do
begin
write('Введите ', i, ' целое число: ');
var x : integer;
readln(x);
if x = k then
begin
Exists := true;
break;
end;
end;
if Exists then
writeln('Число ', k, ' было введено')
else
writeln('Число ', k, ' не было введено');
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_14a.pas Ссылка на алгоритм в среде WDE]

=== №14b. Есть ли среди введенных число k? (то же с использованием while) ===
<source lang="pascal">
begin
write('Введите целые числа n (n>0) и k: ');
var n,k : integer;
readln(n,k);
assert(n>0);
var Exists := false;
var i := 1;
while (i <= n) and not Exists do
begin
write('Введите ', i, ' целое число: ');
var x : integer;
readln(x);
i += 1;
if x = k then
Exists := true;
end;
if Exists then
writeln('Число ', k, ' было введено')
else
writeln('Число ', k, ' не было введено');
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_14b.pas Ссылка на алгоритм в среде WDE]

=== №15. Является ли число N>0 простым? ===
<source lang="pascal">
begin
write('Введите целое число N (N>0): ');
var N : integer;
readln(N);
assert(N>0);
var IsSimple := true;
// for var i := 2 to N-1 do
for var i := 2 to round(sqrt(N)) do
if N mod i = 0 then
begin
IsSimple := false;
break;
end;
if IsSimple then
writeln('Число ', N, ' является простым')
else
writeln('Число ', N, ' не является простым');
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_15.pas Ссылка на алгоритм в среде WDE]

== Другие алгоритмы ==

=== №16. Разложение числа на простые множители ===
<source lang="pascal">
begin
write('Введите целое число x (x>1): ');
var x : integer;
readln(x);
assert(x>1);
var i := 2;
write(x, ' = 1');
repeat
if x mod i = 0 then
begin
write(' * ', i);
x := x div i;
end
else
i += 1;
until x = 1;
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_16.pas Ссылка на алгоритм в среде WDE]

=== №17. Вычисление значения многочлена в точке x по схеме Горнера ===
<source lang="pascal">
begin
write('Введите значение x, значение старшей степени x - n (n>=0) и коэффициент при старшей степени x - a_{1}: ');
var x,a : real;
var n : integer;
readln(x,n,a);
assert(n>=0);
var s := a;
for var i := 1 to n do
begin
write('Введите a_{', i+1,'}: ');
readln(a);
s := s*x + a;
end;
writeln('Значение многочлена p(x) = a_{1}*x^n + a_{2}*x^(n-1) + ... + a_{n}*x + a_{n+1} в точке x = ', x, ' равно ', s);
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_17.pas Ссылка на алгоритм в среде WDE]

=== №18. Дана непрерывная на [a,b] функция f(x), имеющая на [a,b] ровно один корень (f(a)*f(b)<=0). Найти его методом половинного деления ===
<source lang="pascal">
// В качестве примера взяты eps = 0.0001 и функция f(x) = sin(x)
const eps = 0.0001;
const f = sin;

begin
write('Введите числа a и b (a<b): ');
var a,b : real;
readln(a,b);
assert(a<b);
var fa := f(a);
var fb := f(b);
assert(fb*fa<0);
while (b-a) > eps do
begin
var x := (b+a)/2;
var fx := f(x);
if fa*fx <= 0 then
b := x
else
begin
a := x;
fa := fx;
end;
end;
writeln('Корень функции на [a,b] равен ',(b+a)/2);
end.</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_18.pas Ссылка на алгоритм в среде WDE]

= Стандартные задачи на одномерные массивы =

== Простейшие алгоритмы ==

=== №1. Вывод массива ===
<source lang="pascal">procedure Println<T>(a: array of T; delim: string := ' ');
begin
foreach x: T in a do
write(x, delim);
writeln;
end;
</source>

[http://pascalabc.net/WDE/?shared=DaZzz/Arrays/1.pas Ссылка на алгоритм в среде WDE]

=== №2. Заполнение массива случайными числами ===
<source lang="pascal">procedure CreateRandomArray(var a: array of integer;
n: integer);
begin
SetLength(a,n);
for var i:=0 to n-1 do
a[i] := random(100);
end;</source>

[http://pascalabc.net/WDE/?shared=DaZzz/Arrays/2.pas Ссылка на алгоритм в среде WDE]

=== №3. Инвертирование массива ===
<source lang="pascal">procedure Invert<T>(a: array of T);
begin
var n := a.Length;
for var i:=0 to n div 2 - 1 do
Swap(a[i],a[n-i-1]);
end; </source>

[http://pascalabc.net/WDE/?shared=DaZzz/Arrays/3.pas Ссылка на алгоритм в среде WDE]

=== №4. Поиск элемента по заданному значению ===
<source lang="pascal">// С помощью for
function Find<T>(a: array of T; x: T): integer;
begin
Result := -1;
for var i := 0 to a.Length - 1 do
if a[i] = x then
begin
Result := i;
break;
end;
end;

// С помощью while
function FindWhile<T>(a: array of T; x: T): integer;
begin
var n := a.Length;
var i := 0;
while (i<n) and (a[i]<>x) do
i += 1;
if i=n then
Result := -1
else Result := i;
end;

// №4a. Поиск с барьером
function FindWithBarrier<T>(a: array of T; n: integer; x: T): integer;
begin
Assert((0 < n) and (n < a.Length));
a[n] := x; // барьерный элемент равен разыскиваему
var i := 0;
while a[i]<>x do
i += 1;
if i=n then
Result := -1
else Result := i;
end;</source>

[http://pascalabc.net/WDE/?shared=DaZzz/Arrays/4.pas Ссылка на алгоритм в среде WDE]

=== №5. Минимальный элемент и его индекс ===
<source lang="pascal">procedure MinElem(a: array of integer; var min: integer; var minind: integer);
begin
min := a[0];
minind := 0;
for var i:=1 to a.Length-1 do
if a[i]<min then
begin
min := a[i];
minind := i;
end;
end;</source>

[http://pascalabc.net/WDE/?shared=DaZzz/Arrays/5.pas Ссылка на алгоритм в среде WDE]

=== №6. Сдвиг влево ===
<source lang="pascal">procedure ShiftLeft<T>(a: array of T);
begin
for var i:=0 to a.Length-2 do
a[i] := a[i+1];
a[a.Length-1] := default(T);
end;</source>

[http://pascalabc.net/WDE/?shared=DaZzz/Arrays/6.pas Ссылка на алгоритм в среде WDE]

=== №7. Сдвиг вправо ===
<source lang="pascal">
procedure ShiftRight<T>(a: array of T);
begin
for var i := a.Length-1 downto 1 do
a[i] := a[i-1];
a[0] := default(T);
end;
</source>

[http://pascalabc.net/WDE/?shared=PacVlad/ShiftRight.pas Ссылка на алгоритм в среде WDE]

=== №8. Циклический сдвиг вправо ===
<source lang="pascal">
procedure CycleShiftRight<T>(a: array of T);
begin
var v := a[a.Length-1];
for var i := a.Length downto 1 do
a[i] := a[i-1];
a[0] := v;
end;
</source>

[http://pascalabc.net/WDE/?shared=PacVlad/CycleShiftRight.pas Ссылка на алгоритм в среде WDE]

=== №9. Удаление k-того ===
<source lang="pascal">
procedure Delete<T>(a: array of T; var n: integer; k: integer);
begin
Assert((0<=k) and (k<n) and (n<=a.Length));
for var i := k to n-2 do
a[i] := a[i+1];
a[n-1] := default(T);
n -= 1;
end;
</source>

[http://pascalabc.net/WDE/?shared=PacVlad/Delete.pas Ссылка на алгоритм в среде WDE]

=== №10. Вставка на k-тое место ===
<source lang="pascal">
procedure Insert<T>(a: array of T; var n: integer; k: integer; value: T);
begin
Assert((0<=k) and (k<=n) and (n<a.Length));
for var i := n-1 downto k do
a[i+1] := a[i];
a[k] := value;
n += 1;
end;
</source>

[http://pascalabc.net/WDE/?shared=PacVlad/Insert.pas Ссылка на алгоритм в среде WDE]

=== №11. Слияние двух упорядоченных в один упорядоченный ===
<source lang="pascal">
// a,b упорядочены по возрастанию
function Merge(a,b: array of real; na,nb: integer): array of real;
begin
Assert((0 < na) and (na < a.Length));
Assert((0 < nb) and (nb < b.Length));
a[na] := real.MaxValue;
b[nb] := real.MaxValue;
var c := new integer[na + nb];
var ia := 0;
var ib := 0;
for var ic := 0 to na + nb - 1 do
if a[ia]<b[ib] then
begin
c[ic] := a[ia];
ia += 1;
end
else
begin
c[ic] := b[ib];
ib += 1;
end;
Result := c;
end;
</source>

=== №12. Поиск в упорядоченном массиве ===
<source lang="pascal">
function BinarySearch(a: array of integer; x: integer): integer;
begin
var k: integer;
var i := 0;
var j := a.Length-1;
repeat
k := (i+j) div 2;
if x>a[k] then
i := k + 1
else j := k - 1;
until (a[k]=x) or (i>j);
if a[k]=x then
Result := k
else Result := -1;
end;
</source>

== Сортировка массивов. Использование предикатов в задачах на массивы ==

=== №13. Сортировка выбором ===
<source lang="pascal">
procedure SortByChoice(a: array of integer);
begin
for var i := 0 to a.Length - 2 do
begin
var min := a[i];
var imin := i;
for var j := i + 1 to a.Length - 1 do
if a[j] < min then
begin
min := a[i];
imin := j;
end;
a[imin] := a[i];
a[i] := min;
end;
end;
</source>

=== №14. Пузырьковая сортировка ===
<source lang="pascal">
procedure BubbleSort(a: array of integer);
begin
var n := a.Length;
for var i := 0 to n - 2 do
for var j := n - 1 downto i + 1 do
if a[j] < a[j - 1] then
Swap(a[j], a[j - 1]);
end;

procedure BubbleSort2(a: array of integer);
begin
var i := a.Length - 1;
var q: boolean;
repeat
q := true;
for var j := 0 to i - 1 do
if a[j + 1] < a[j] then
begin
Swap(a[j + 1], a[j]);
q := false;
end;
i -= 1;
until q;
end;
</source>

=== №15. Сортировка вставками ===
<source lang="pascal">
procedure SortByInsert(a: array of integer);
begin
for var i := 1 to a.Length - 1 do
begin
var x := a[i];
var j := i - 1;
while (j >= 0) and (x < a[j]) do
begin
a[j + 1] := a[j];
j -= 1;
end;
a[j + 1] := x;
end;
end;
</source>

=== №16. Поиск по условию ===
<source lang="pascal">
type
IPredicate = function(x: integer): boolean;

function Even(x: integer): boolean;
begin
result := not odd(x);
end;

function IsPositive(x: integer): boolean;
begin
Result := x > 0;
end;

function FindPred(a: array of integer; pred: IPredicate): integer;
begin
var n := a.Length;
var i := 0;
while (i < n) and not pred(a[i]) do
i += 1;
if i = n then
Result := -1
else
Result := i;
end;
</source>

=== №17. Количество по условию ===
<source lang="pascal">
function CountPred(a: array of integer; pred: IPredicate): integer;
begin
Result := 0;
for var i := 0 to a.Length - 1 do
if pred(a[i]) then
Result += 1;
end;
</source>

=== №18. Условный минимум ===
<source lang="pascal">
procedure MinElemPred(a: array of integer; pred: IPredicate; var min, imin: integer);
begin
min := Integer.MaxValue;
imin := -1;
for var i := 1 to a.length - 1 do
if pred(a[i]) and (a[i] < min) then
begin
min := a[i];
imin := i;
end;
end;
</source>

=== №19. Удаление по условию ===
<source lang="pascal">
procedure DeleteAll(a: array of integer; var n: integer; pred: IPredicate);
begin
Assert((0 < n) and (n <= a.Length));
var j := 0;
for var i := 0 to n - 1 do
if not pred(a[i]) then
begin
a[j] := a[i];
j += 1;
end;
n := j;
end;
</source>

----

by Буцев Виктор, Белоусько Тихон, Зуев Семен, Гончаров Владислав, Батраков Михаил, Гаджиев Казанфар, Пак Владислав

Алгоритмы для студентов

2010-11-29T17:06:52Z

Miclus:

= Стандартные задачи на циклы =

== Простейшие алгоритмы ==

=== №1. Сумма вводимых целых чисел ===
<source lang="pascal">
begin
var x , n : integer;
var s := 0;
writeln('Введите число слагаемых');
readln(n);
for var i:=1 to n do
begin
writeln('Введите слагаемое');
readln(x);
s += x;
end;
writeln('Сумма слагаемых равна ',s);
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_01_Kazik.pas Ссылка на алгоритм в среде WDE]

=== №2. Произведение целых чисел ===
<source lang="pascal">
begin
var x , n : integer;
var p := 1;
writeln('Введите число множителей');
readln(n);
for var i:=1 to n do
begin
writeln('Введите множитель');
readln(x);
p *= x;
end;
writeln('Произведение равно ', p);
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_02_Kazik.pas Ссылка на алгоритм в среде WDE]

=== №3. Двойной факториал n!!=n*(n-2)*(n-4)*...*2 (или 1) ===
<source lang="pascal">
begin
var p := 1;
var x , n : integer;
writeln('Введите n');
readln(x);
while x>=2 do
begin
p *= x;
x -= 2;
end;
writeln('Двойной факториал равен ', p);
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_03_Kazik.pas Ссылка на алгоритм в среде WDE]

=== №4. Сколько нечетных среди n введенных ===
<source lang="pascal">
begin
var x , n : integer;
var c := 0;
writeln('Введите n');
readln(n);
for var i:=1 to n do
begin
writeln('Введите целое число');
readln(x);
if x mod 2 <> 0 then
c += 1;
end;
writeln('Количество нечетных равно ', c);
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_04_Kazik.pas Ссылка на алгоритм в среде WDE]

=== №5. Защита от неверного ввода ===
<source lang="pascal">
begin
var x : real;
repeat
write('Введите x>0 ');
read(x);
if x<=0 then
writeln('Неверный ввод');
until x>0;
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_05_Kazik.pas Ссылка на алгоритм в среде WDE]

=== №6. Табулирование функции f(x) на [a,b] в точках, разбивающих [a,b] на N частей ===
<source lang="pascal">
function f(x : real): real;
begin
//Введите любую функцию
result := sin(x);
end;

begin
var N : integer;
var a , b : real;
writeln('Введите N');
readln(N);
writeln('Введите a и b');
read(a,b);
Assert(N>0);
var h := (b-a)/N;
var x := a;
for var i:=0 to N do
begin
writeln('Значение икса равно ',x);
writeln('Значение функции равно ', f(x):10:4);
x += h;
end;
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_06_Kazik.pas Ссылка на алгоритм в среде WDE]

=== №6a. Решение, использующее while. Погрешность округления и вычислительная погрешность ===
<source lang="pascal">
function f(x : real): real;
begin
//Введите любую функцию
result := sin(x);
end;

begin
var N : integer;
var a , b : real;
writeln('Введите N');
readln(N);
writeln('Введите a и b');
read(a,b);
Assert(N>0);
var h := (b-a)/N;
var x := a;
while x <= b+h/2 do
begin
writeln('Значение икса равно ',x:5:2,' Значение функции ', f(x):10:4);
x += h;
end;
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_06a_Kazik.pas Ссылка на алгоритм в среде WDE]

== Рекуррентные соотношения ==

=== №7. Вывод 10 первых степеней двойки ===
<source lang="pascal">
begin
var x := 2;
for var i := 1 to 10 do
begin
writeln(i:2,x:5);
x *= 2;
end;
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_07.pas Ссылка на алгоритм в среде WDE]

=== №8. Вывод всех двухзначных чисел, кратных 5 ===
<source lang="pascal">
begin
var x := 10;
while x < 100 do
begin
writeln(x:3);
x += 5;
end;
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_08.pas Ссылка на алгоритм в среде WDE]

=== №9. Вывод n первых чисел Фибоначчи ===
<source lang="pascal">
begin
write('Введите целое число n (n > 1): ');
var n : integer;
readln(n);
var a := 1;
var b := 1;
write(1, ' ', 1, ' ');
for var i := 3 to n do
begin
var c := a + b;
write(c, ' ');
a := b;
b := c;
end;
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_09.pas Ссылка на алгоритм в среде WDE]

=== №10. Найти НОД(A,B), используя алгоритм Евклида: ===

НОД(A,B) = НОД(B,A mod B); НОД(A,0) = A
<source lang="pascal">
begin
write('Введите целые числа A и B: ');
var A,B,C : integer;
readln(A,B);
repeat
C := A mod B;
A := B;
B := C;
until C = 0;
write('НОД(A,B) = ', A);
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_10.pas Ссылка на алгоритм в среде WDE]

=== №11. Найти сумму цифр целого положительного числа m ===
<source lang="pascal">
begin
write('Введите целое положительное число m: ');
var m : integer;
readln(m);
assert(m > 0);
var s := 0;
while m > 0 do
begin
s += m mod 10;
m := m div 10;
end;
writeln('Сумма цифр числа m равна ', s);
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_11.pas Ссылка на алгоритм в среде WDE]

== Максимумы и минимумы ==

=== №12. Найти max из введенных чисел ===
<source lang="pascal">
begin
write('Введите целое число n (n>0): ');
var n : integer;
readln(n);
assert(n>0);
write('Введите 1 число: ');
var x : real;
readln(x);
var max := x;
for var i := 2 to n do
begin
write('Введите ', i, ' число: ');
readln(x);
if max < x then
max := x;
end;
writeln('Максимальное из введенных чисел: ', max);
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_12.pas Ссылка на алгоритм в среде WDE]

=== №12a. Найти min, удовлетворяющее условию p(x) ===
<source lang="pascal">
// Условие взятое как пример (Если число положительное, то условие p(x) возвращает true, иначе false)
function p(x : real) : boolean;
begin
if x > 0 then
Result := true
else
Result := false;
end;

begin
write('Введите целое число n (n>0): ');
var n : integer;
readln(n);
assert(n>0);
var min := real.MaxValue;
for var i := 1 to n do
begin
var x : real;
write('Введите ', i, ' число: ');
readln(x);
if (x < min) and p(x) then
min := x;
end;
if min = real.MaxValue then
writeln('Нет чисел удовлетворяющих условию (являющихся положительными)')
else
writeln('Минимальное из введенных чисел и удовлетворяющее условию (являющееся положительным): ', min);
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_12a.pas Ссылка на алгоритм в среде WDE]

== Суммирование рядов (конечных и бесконечных) ==

=== №13. Вычислить Σ(i=1..n) a^i/i! ===
<source lang="pascal">
begin
write('Введите число a и n (n>0): ');
var a : real;
var n : integer;
readln(a,n);
assert(n>0);
var x := a;
var s := x;
for var i := 2 to n do
begin
x *= a / i;
s += x;
end;
writeln('Сумма ',chrunicode(931),'(i=1..n) a^i/i! равна ', s);
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_13.pas Ссылка на алгоритм в среде WDE]

=== №13a. Вычислить Σ(i=1..∞) (-1)^i * a^i/i! ===
<source lang="pascal">
begin
write('Введите число a (0 < a < 1): ');
var a : real;
readln(a);
assert((a>0) and (a<1));
var eps := 0.0001;
var i := 1;
var s := 0.0;
var y := -a;
repeat
s += y / i;
i += 1;
y *= -a;
until abs(y/i) < eps;
writeln('Сумма ',chrunicode(931),'(i=1..',chrunicode(8734),') (-1)^i * a^i/i! равна ', s);
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_13a.pas Ссылка на алгоритм в среде WDE]

== Поиск значения ==

=== №14. Есть ли среди введенных число k? ===
<source lang="pascal">
begin
write('Введите целые числа n (n>0) и k: ');
var n,k : integer;
readln(n,k);
assert(n>0);
var Exists := false;
for var i := 1 to n do
begin
write('Введите ', i, ' целое число: ');
var x : integer;
readln(x);
if x = k then
Exists := true;
end;
if Exists then
writeln('Число ', k, ' было введено')
else
writeln('Число ', k, ' не было введено');
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_14.pas Ссылка на алгоритм в среде WDE]

=== №14a. Есть ли среди введенных число k? (то же с использованием break) ===
<source lang="pascal">
begin
write('Введите целые числа n (n>0) и k: ');
var n,k : integer;
readln(n,k);
assert(n>0);
var Exists := false;
for var i := 1 to n do
begin
write('Введите ', i, ' целое число: ');
var x : integer;
readln(x);
if x = k then
begin
Exists := true;
break;
end;
end;
if Exists then
writeln('Число ', k, ' было введено')
else
writeln('Число ', k, ' не было введено');
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_14a.pas Ссылка на алгоритм в среде WDE]

=== №14b. Есть ли среди введенных число k? (то же с использованием while) ===
<source lang="pascal">
begin
write('Введите целые числа n (n>0) и k: ');
var n,k : integer;
readln(n,k);
assert(n>0);
var Exists := false;
var i := 1;
while (i <= n) and not Exists do
begin
write('Введите ', i, ' целое число: ');
var x : integer;
readln(x);
i += 1;
if x = k then
Exists := true;
end;
if Exists then
writeln('Число ', k, ' было введено')
else
writeln('Число ', k, ' не было введено');
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_14b.pas Ссылка на алгоритм в среде WDE]

=== №15. Является ли число N>0 простым? ===
<source lang="pascal">
begin
write('Введите целое число N (N>0): ');
var N : integer;
readln(N);
assert(N>0);
var IsSimple := true;
// for var i := 2 to N-1 do
for var i := 2 to round(sqrt(N)) do
if N mod i = 0 then
begin
IsSimple := false;
break;
end;
if IsSimple then
writeln('Число ', N, ' является простым')
else
writeln('Число ', N, ' не является простым');
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_15.pas Ссылка на алгоритм в среде WDE]

== Другие алгоритмы ==

=== №16. Разложение числа на простые множители ===
<source lang="pascal">
begin
write('Введите целое число x (x>1): ');
var x : integer;
readln(x);
assert(x>1);
var i := 2;
write(x, ' = 1');
repeat
if x mod i = 0 then
begin
write(' * ', i);
x := x div i;
end
else
i += 1;
until x = 1;
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_16.pas Ссылка на алгоритм в среде WDE]

=== №17. Вычисление значения многочлена в точке x по схеме Горнера ===
<source lang="pascal">
begin
write('Введите значение x, значение старшей степени x - n (n>=0) и коэффициент при старшей степени x - a_{1}: ');
var x,a : real;
var n : integer;
readln(x,n,a);
assert(n>=0);
var s := a;
for var i := 1 to n do
begin
write('Введите a_{', i+1,'}: ');
readln(a);
s := s*x + a;
end;
writeln('Значение многочлена p(x) = a_{1}*x^n + a_{2}*x^(n-1) + ... + a_{n}*x + a_{n+1} в точке x = ', x, ' равно ', s);
end.
</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_17.pas Ссылка на алгоритм в среде WDE]

=== №18. Дана непрерывная на [a,b] функция f(x), имеющая на [a,b] ровно один корень (f(a)*f(b)<=0). Найти его методом половинного деления ===
<source lang="pascal">
// В качестве примера взяты eps = 0.0001 и функция f(x) = sin(x)
const eps = 0.0001;
const f = sin;

begin
write('Введите числа a и b (a<b): ');
var a,b : real;
readln(a,b);
assert(a<b);
var fa := f(a);
var fb := f(b);
assert(fb*fa<0);
while (b-a) > eps do
begin
var x := (b+a)/2;
var fx := f(x);
if fa*fx <= 0 then
b := x
else
begin
a := x;
fa := fx;
end;
end;
writeln('Корень функции на [a,b] равен ',(b+a)/2);
end.</source>

[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_18.pas Ссылка на алгоритм в среде WDE]

= Стандартные задачи на одномерные массивы =

== Простейшие алгоритмы ==

=== №1. Вывод массива ===
<source lang="pascal">procedure Println<T>(a: array of T; delim: string := ' ');
begin
foreach x: T in a do
write(x, delim);
writeln;
end;
</source>

[http://pascalabc.net/WDE/?shared=DaZzz/Arrays/1.pas Ссылка на алгоритм в среде WDE]

=== №2. Заполнение массива случайными числами ===
<source lang="pascal">procedure CreateRandomArray(var a: array of integer;
n: integer);
begin
SetLength(a,n);
for var i:=0 to n-1 do
a[i] := random(100);
end;</source>

[http://pascalabc.net/WDE/?shared=DaZzz/Arrays/2.pas Ссылка на алгоритм в среде WDE]

=== №3. Инвертирование массива ===
<source lang="pascal">procedure Invert<T>(a: array of T);
begin
var n := a.Length;
for var i:=0 to n div 2 - 1 do
Swap(a[i],a[n-i-1]);
end; </source>

[http://pascalabc.net/WDE/?shared=DaZzz/Arrays/3.pas Ссылка на алгоритм в среде WDE]

=== №4. Поиск элемента по заданному значению ===
<source lang="pascal">// С помощью for
function Find<T>(a: array of T; x: T): integer;
begin
Result := -1;
for var i := 0 to a.Length - 1 do
if a[i] = x then
begin
Result := i;
break;
end;
end;

// С помощью while
function FindWhile<T>(a: array of T; x: T): integer;
begin
var n := a.Length;
var i := 0;
while (i<n) and (a[i]<>x) do
i += 1;
if i=n then
Result := -1
else Result := i;
end;

// №4a. Поиск с барьером
function FindWithBarrier<T>(a: array of T; n: integer; x: T): integer;
begin
Assert((0 < n) and (n < a.Length));
a[n] := x; // барьерный элемент равен разыскиваему
var i := 0;
while a[i]<>x do
i += 1;
if i=n then
Result := -1
else Result := i;
end;</source>

[http://pascalabc.net/WDE/?shared=DaZzz/Arrays/4.pas Ссылка на алгоритм в среде WDE]

=== №5. Минимальный элемент и его индекс ===
<source lang="pascal">procedure MinElem(a: array of integer; var min: integer; var minind: integer);
begin
min := a[0];
minind := 0;
for var i:=1 to a.Length-1 do
if a[i]<min then
begin
min := a[i];
minind := i;
end;
end;</source>

[http://pascalabc.net/WDE/?shared=DaZzz/Arrays/5.pas Ссылка на алгоритм в среде WDE]

=== №6. Сдвиг влево ===
<source lang="pascal">procedure ShiftLeft<T>(a: array of T);
begin
for var i:=0 to a.Length-2 do
a[i] := a[i+1];
a[a.Length-1] := default(T);
end;</source>

[http://pascalabc.net/WDE/?shared=DaZzz/Arrays/6.pas Ссылка на алгоритм в среде WDE]

=== №7. Сдвиг вправо ===
<source lang="pascal">
procedure ShiftRight<T>(a: array of T);
begin
for var i := a.Length-1 downto 1 do
a[i] := a[i-1];
a[0] := default(T);
end;
</source>

[http://pascalabc.net/WDE/?shared=PacVlad/ShiftRight.pas Ссылка на алгоритм в среде WDE]

=== №8. Циклический сдвиг вправо ===
<source lang="pascal">
procedure CycleShiftRight<T>(a: array of T);
begin
var v := a[a.Length-1];
for var i := a.Length downto 1 do
a[i] := a[i-1];
a[0] := v;
end;
</source>

[http://pascalabc.net/WDE/?shared=PacVlad/CycleShiftRight.pas Ссылка на алгоритм в среде WDE]

=== №9. Удаление k-того ===
<source lang="pascal">
procedure Delete<T>(a: array of T; var n: integer; k: integer);
begin
Assert((0<=k) and (k<n) and (n<=a.Length));
for var i := k to n-2 do
a[i] := a[i+1];
a[n-1] := default(T);
n -= 1;
end;
</source>

[http://pascalabc.net/WDE/?shared=PacVlad/Delete.pas Ссылка на алгоритм в среде WDE]

=== №10. Вставка на k-тое место ===
<source lang="pascal">
procedure Insert<T>(a: array of T; var n: integer; k: integer; value: T);
begin
Assert((0<=k) and (k<=n) and (n<a.Length));
for var i := n-1 downto k do
a[i+1] := a[i];
a[k] := value;
n += 1;
end;
</source>

[http://pascalabc.net/WDE/?shared=PacVlad/Insert.pas Ссылка на алгоритм в среде WDE]

=== №11. Слияние двух упорядоченных в один упорядоченный ===
<source lang="pascal">
// a,b упорядочены по возрастанию
function Merge(a,b: array of real; na,nb: integer): array of real;
begin
Assert((0 < na) and (na < a.Length));
Assert((0 < nb) and (nb < b.Length));
a[na] := real.MaxValue;
b[nb] := real.MaxValue;
var c := new integer[na + nb];
var ia := 0;
var ib := 0;
for var ic := 0 to na + nb - 1 do
if a[ia]<b[ib] then
begin
c[ic] := a[ia];
ia += 1;
end
else
begin
c[ic] := b[ib];
ib += 1;
end;
Result := c;
end;
</source>

=== №12. Поиск в упорядоченном массиве ===
<source lang="pascal">
function BinarySearch(a: array of integer; x: integer): integer;
begin
var k: integer;
var i := 0;
var j := a.Length-1;
repeat
k := (i+j) div 2;
if x>a[k] then
i := k + 1
else j := k - 1;
until (a[k]=x) or (i>j);
if a[k]=x then
Result := k
else Result := -1;
end;
</source>

== Сортировка массивов. Использование предикатов в задачах на массивы ==

=== №13. Сортировка выбором ===
<source lang="pascal">
procedure SortByChoice(a: array of integer);
begin
for var i := 0 to a.Length - 2 do
begin
var min := a[i];
var imin := i;
for var j := i + 1 to a.Length - 1 do
if a[j] < min then
begin
min := a[i];
imin := j;
end;
a[imin] := a[i];
a[i] := min;
end;
end;
</source>

=== №14. Пузырьковая сортировка ===
<source lang="pascal">
procedure BubbleSort(a: array of integer);
begin
var n := a.Length;
for var i := 0 to n - 2 do
for var j := n - 1 downto i + 1 do
if a[j] < a[j - 1] then
Swap(a[j], a[j - 1]);
end;

procedure BubbleSort2(a: array of integer);
begin
var i := a.Length - 1;
var q: boolean;
repeat
q := true;
for var j := 0 to i - 1 do
if a[j + 1] < a[j] then
begin
Swap(a[j + 1], a[j]);
q := false;
end;
i -= 1;
until q;
end;
</source>

=== №15. Сортировка вставками ===
<source lang="pascal">
procedure SortByInsert(a: array of integer);
begin
for var i := 1 to a.Length - 1 do
begin
var x := a[i];
var j := i - 1;
while (j >= 0) and (x < a[j]) do
begin
a[j + 1] := a[j];
j -= 1;
end;
a[j + 1] := x;
end;
end;
</source>

=== №16. Поиск по условию ===
<source lang="pascal">
type
IPredicate = function(x: integer): boolean;

function Even(x: integer): boolean;
begin
result := not odd(x);
end;

function IsPositive(x: integer): boolean;
begin
Result := x > 0;
end;

function FindPred(a: array of integer; pred: IPredicate): integer;
begin
var n := a.Length;
var i := 0;
while (i < n) and not pred(a[i]) do
i += 1;
if i = n then
Result := -1
else
Result := i;
end;
</source>

=== №17. Количество по условию ===
function CountPred(a: array of integer; pred: IPredicate): integer;
begin
Result := 0;
for var i := 0 to a.Length - 1 do
if pred(a[i]) then
Result += 1;
end;

=== №18. Условный минимум ===
<source lang="pascal">
procedure MinElemPred(a: array of integer; pred: IPredicate; var min, imin: integer);
begin
min := Integer.MaxValue;
imin := -1;
for var i := 1 to a.length - 1 do
if pred(a[i]) and (a[i] < min) then
begin
min := a[i];
imin := i;
end;
end;
</source>

=== №19. Удаление по условию ===
<source lang="pascal">
procedure DeleteAll(a: array of integer; var n: integer; pred: IPredicate);
begin
Assert((0 < n) and (n <= a.Length));
var j := 0;
for var i := 0 to n - 1 do
if not pred(a[i]) then
begin
a[j] := a[i];
j += 1;
end;
n := j;
end;
</source>

----

by Буцев Виктор, Белоусько Тихон, Зуев Семен, Гончаров Владислав, Батраков Михаил, Гаджиев Казанфар, Пак Владислав

Алгоритмы для студентов

2010-11-29T16:13:05Z

Miclus: добавлены 16, 18 и 19 алгоритмы

=== Вывод массива ===
<source lang="Delphi">procedure Println<T>(a: array of T; delim: string := ' ');
begin
foreach x: T in a do
write(x, delim);
writeln;
end;
</source>

=== Заполнение массива случайными числами ===
<source lang="Delphi">procedure CreateRandomArray(var a: array of integer;
n: integer);
begin
SetLength(a,n);
for var i:=0 to n-1 do
a[i] := random(100);
end;</source>

=== Инвертирование массива ===
<source lang="Delphi">procedure Invert<T>(a: array of T);
begin
var n := a.Length;
for var i:=0 to n div 2 - 1 do
Swap(a[i],a[n-i-1]);
end; </source>

=== Поиск элемента по заданному значению ===
<source lang="Delphi">// С помощью for
function Find<T>(a: array of T; x: T): integer;
begin
Result := -1;
for var i := 0 to a.Length - 1 do
if a[i] = x then
begin
Result := i;
break;
end;
end;

// С помощью while
function FindWhile<T>(a: array of T; x: T): integer;
begin
var n := a.Length;
var i := 0;
while (i<n) and (a[i]<>x) do
i += 1;
if i=n then
Result := -1
else Result := i;
end;

// Поиск с барьером
function FindWithBarrier<T>(a: array of T; n: integer; x: T): integer;
begin
Assert((0 < n) and (n < a.Length));
a[n] := x; // барьерный элемент равен разыскиваему
var i := 0;
while a[i]<>x do
i += 1;
if i=n then
Result := -1
else Result := i;
end;</source>

=== Минимальный элемент и его индекс ===
<source lang="Delphi">procedure MinElem(a: array of integer; var min: integer; var minind: integer);
begin
min := a[0];
minind := 0;
for var i:=1 to a.Length-1 do
if a[i]<min then
begin
min := a[i];
minind := i;
end;
end;</source>

=== Сдвиг влево ===
<source lang="Delphi">procedure ShiftLeft<T>(a: array of T);
begin
for var i:=0 to a.Length-2 do
a[i] := a[i+1];
a[a.Length-1] := default(T);
end;</source>

=== Сдвиг вправо ===
<source lang="pascal">
procedure ShiftRight<T>(a: array of T);
begin
for var i := a.Length-1 downto 1 do
a[i] := a[i-1];
a[0] := default(T);
end;
</source>

[http://pascalabc.net/WDE/?shared=PacVlad/ShiftRight.pas Ссылка на алгоритм в среде WDE]

=== Циклический сдвиг вправо ===
<source lang="pascal">
procedure CycleShiftRight<T>(a: array of T);
begin
var v := a[a.Length-1];
for var i := a.Length downto 1 do
a[i] := a[i-1];
a[0] := v;
end;
</source>

[http://pascalabc.net/WDE/?shared=PacVlad/CycleShiftRight.pas Ссылка на алгоритм в среде WDE]

=== Удаление k-того ===
<source lang="pascal">
procedure Delete<T>(a: array of T; var n: integer; k: integer);
begin
Assert((0<=k) and (k<n) and (n<=a.Length));
for var i := k to n-2 do
a[i] := a[i+1];
a[n-1] := default(T);
n -= 1;
end;
</source>

[http://pascalabc.net/WDE/?shared=PacVlad/Delete.pas Ссылка на алгоритм в среде WDE]

=== Вставка на k-тое место ===
<source lang="pascal">
procedure Insert<T>(a: array of T; var n: integer; k: integer; value: T);
begin
Assert((0<=k) and (k<=n) and (n<a.Length));
for var i := n-1 downto k do
a[i+1] := a[i];
a[k] := value;
n += 1;
end;
</source>

[http://pascalabc.net/WDE/?shared=PacVlad/Insert.pas Ссылка на алгоритм в среде WDE]

=== Слияние двух упорядоченных в один упорядоченный ===
<source lang="pascal">
// a,b упорядочены по возрастанию
function Merge(a,b: array of real; na,nb: integer): array of real;
begin
Assert((0 < na) and (na < a.Length));
Assert((0 < nb) and (nb < b.Length));
a[na] := real.MaxValue;
b[nb] := real.MaxValue;
var c := new integer[na + nb];
var ia := 0;
var ib := 0;
for var ic := 0 to na + nb - 1 do
if a[ia]<b[ib] then
begin
c[ic] := a[ia];
ia += 1;
end
else
begin
c[ic] := b[ib];
ib += 1;
end;
Result := c;
end;
</source>

=== Поиск в упорядоченном массиве ===
<source lang="pascal">
function BinarySearch(a: array of integer; x: integer): integer;
begin
var k: integer;
var i := 0;
var j := a.Length-1;
repeat
k := (i+j) div 2;
if x>a[k] then
i := k + 1
else j := k - 1;
until (a[k]=x) or (i>j);
if a[k]=x then
Result := k
else Result := -1;
end;
</source>

=== Сортировка выбором ===
<source lang="pascal">
procedure SortByChoice(a: array of integer);
begin
for var i := 0 to a.Length - 2 do
begin
var min := a[i];
var imin := i;
for var j := i + 1 to a.Length - 1 do
if a[j] < min then
begin
min := a[i];
imin := j;
end;
a[imin] := a[i];
a[i] := min;
end;
end;
</source>

=== Пузырьковая сортировка ===
<source lang="pascal">
procedure BubbleSort(a: array of integer);
begin
var n := a.Length;
for var i := 0 to n - 2 do
for var j := n - 1 downto i + 1 do
if a[j] < a[j - 1] then
Swap(a[j], a[j - 1]);
end;

procedure BubbleSort2(a: array of integer);
begin
var i := a.Length - 1;
var q: boolean;
repeat
q := true;
for var j := 0 to i - 1 do
if a[j + 1] < a[j] then
begin
Swap(a[j + 1], a[j]);
q := false;
end;
i -= 1;
until q;
end;
</source>

=== Сортировка вставками ===
<source lang="pascal">
procedure SortByInsert(a: array of integer);
begin
for var i := 1 to a.Length - 1 do
begin
var x := a[i];
var j := i - 1;
while (j >= 0) and (x < a[j]) do
begin
a[j + 1] := a[j];
j -= 1;
end;
a[j + 1] := x;
end;
end;
</source>

=== Поиск по условию ===
<source lang="pascal">
type
IPredicate = function(x: integer): boolean;

function Even(x: integer): boolean;
begin
result := not odd(x);
end;

function IsPositive(x: integer): boolean;
begin
Result := x > 0;
end;

function FindPred(a: array of integer; pred: IPredicate): integer;
begin
var n := a.Length;
var i := 0;
while (i < n) and not pred(a[i]) do
i += 1;
if i = n then
Result := -1
else
Result := i;
end;
</source>

=== Условный минимум ===
<source lang="pascal">
procedure MinElemPred(a: array of integer; pred: IPredicate; var min, imin: integer);
begin
min := Integer.MaxValue;
imin := -1;
for var i := 1 to a.length - 1 do
if pred(a[i]) and (a[i] < min) then
begin
min := a[i];
imin := i;
end;
end;
</source>

=== Удаление по условию ===
<source lang="pascal">
procedure DeleteAll(a: array of integer; var n: integer; pred: IPredicate);
begin
Assert((0 < n) and (n <= a.Length));
var j := 0;
for var i := 0 to n - 1 do
if not pred(a[i]) then
begin
a[j] := a[i];
j += 1;
end;
n := j;
end;
</source>