Стандартные задачи на циклы и массивы

Циклы

1. Сумма

s := 0;
for var i:=1 to n do
 s += xi

2. Произведение

p := 1;
for var i:=1 to n do
 p *= xi

3. n!!=n*(n-2) *(n-4)*...*2 (или 1)

p := 1;
x := n;
while x>=2 do
begin
 p *= x;
 x -= 2;
end;

4. Сколько нечетных среди 10 введенных

c:=0;
for var i:=1 to n do
begin
 var x := ReadInteger;
 if x mod 2 <> 0 then
 c += 1;
end;

5. Защита от неверного ввода

repeat
 write(' Введите x (>0): ');
 var x := ReadReal;
 if x<=0 then
 writeln(' Неверный ввод');
until x>0;

6. Табулирование функции f(x) на [a,b] в точках, разбивающих [a,b] на

N частей
Assert(N>0);
var h := (b-a)/N;
var x := a;
for var i:=0 to N do
begin
 writeln(x:5:2, f(x):10:4);
 x += h;
end;

6a. Решение, использующее while. Погрешность округления и вычислительная погрешность

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;

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

7. Вывод 10 первых степеней двойки

x := 1;
for var i:=1 to 10 do
begin
 writeln(i:2,x:5);
 x *= 2;
end;

8. Вывод всех двузначных чисел, кратных 5

x := 10;
while x<100 do
begin
 write(x:3);
 x += 5;
end;

9. Вывод n первых чисел Фибоначчи Assert(n>1);

a := 1; b := 1;
write(1,' ',1,' ');
for var i:=3 to n do
begin
 c := a + b;
 write(c,' ');
 a := b;
 b := c;
end;

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

read(A,B);
repeat
 C := A mod B;
 A := B;
 B := C;
until C=0;
write(A);

11. Найти сумму цифр целого положительного числа m

var m := ReadInteger;
s := 0;
while m>0 do
begin
 s += m mod 10;
 m := m div 10;
end;

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

12. Найти max из введенных чисел

var x := ReadReal;
var max := x;
for var i:=2 to n do
begin
 read(x);
 if max<x then
 max := x;
end;

12a. Найти min, удовлетворяющее условию p(x)

var min := real.MaxValue;
for var i:=1 to n do
begin
 var x := ReadReal;
 if (x < min) and p(x) then
 min := x;
end;
if min = real.MaxValue then
 writeln(' нет удовлетворяющих условию' );

Суммирование рядов (конечных и бесконечных), нахождение предела последовательности

13. Вычислить

read(a, n);
x := a;
s := x;
for var i := 2 to n do
begin
 x *= a / i;
 s += x;
end;

13а. Вычислить Assert((a > 0) and (a < 1));

eps := 0.0001;
i := 1;
s := 0;
y := -a;
repeat
 s += y / i;
 i += 1;
 y *= -a;
until abs(y/i) < eps;

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

14. Есть ли среди введенных число k?

var Exists := False;
for var i:=1 to n do
begin
 var x := ReadInteger;
 if x=k then
 Exists := True;
end;

14a. То же с использованием break

var Exists := False;
for var i:=1 to n do
begin
 var x := ReadInteger;
 if x=k then
 begin
 Exists := True;
 break;
 end;
end;

14б. То же с использованием while

var Exists := False;
i := 1;
while (i<=n) and not Exists do
begin
 var x := ReadInteger;
 i += 1;
 if x=k then
 Exists := True;
end;

15. Является ли число N>1 простым?

IsSimple := True;
// for 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;

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

16. Разложение числа на простые множители Assert(x>=2);

i := 2;
repeat
 if x mod i = 0 then
beginwrite(i,' ');
 x : = x div i;
 end
 else i += 1;
until x = 1;

17. Вычисление значения многочлена в точке x по схеме Горнера

var x := ReadReal;
var a := ReadReal;
s := a;
for var i:=1 to n do
begin
 a := ReadReal;
 s := s*x+a;
end;

18. Дана непрерывная на [a,b] функция f(x), имеющая на [a,b] ровно один корень (f(a)*f(b)<=0). Найти его методом половинного деления Assert(b>a); 

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((b+a)/2);

Массивы

1. Вывод

procedure WriteArray<T>(a: array of T; delim: string := ' ');
begin
 foreach x: T in a do
 write(x,delim);
end;

procedure WritelnArray<T>(a: array of T; delim: string := ' ');
begin
 WriteArray(a,delim);
 writeln;
end;

2. Заполнение случайными числами

function CreateRandomArray(n: integer) : array of integer;
begin
 SetLength( Result,n);
 for var i:=0 to n-1 do
 Result[i] := random(100);
end;

1-2. Использование стандартного модуля Arrays

uses Arrays;
begin
 var a := CreateRandomIntegerArray(10);
 a.Writeln;
 Sort(a);
 a. Writeln(',');
end.

3. Инвертирование массива

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;

4. Поиск

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;

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;

4а. Поиск с барьером

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;

5. Минимальный элемент и его индекс

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;

6. Сдвиг влево

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;

7. Сдвиг вправо

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;

8. Циклический сдвиг вправо

procedure CycleShiftRight<T>(a: array of T);
begin
 var v := a[a.Length-1];
 for var i:=a.Length-1 downto 1 do
 a[i] := a[i-1];
 a[0] := v;
end;

9. Удаление k-того

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;

10. Вставка на k-тое место

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;

11. Слияние двух упорядоченных в один упорядоченный // a,b упорядочены по возрастанию

function Merge(a,b: array of integer; n,m: integer):
 array of integer;
begin
 Assert((0 < n) and (n < a.Length));
 Assert((0 < m) and (m < b.Length));
 a[n] := integer.MaxValue;
 b[m] := integer.MaxValue;
 SetLength(Result,m+n);
 var ia := 0;
 var ib := 0;
 for var ir:=0 to n+m-1 do
 if a[ia]<b[ib] then
 begin
 Result[ir] := a[ia];
 ia += 1;
 end
 else
 begin
 Result[ir] := b[ib];
 ib += 1;
 end;
end;

12. Поиск в упорядоченном массиве

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;

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

13. Сортировка выбором

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[j];
 imin := j;
 end;
 a[imin] := a[i];
 a[i] := min;
 end;
end;

14. Пузырьковая сортировка

procedure BubbleSort(a: array of integer);
begin
 for var i := 0 to a.Length - 2 do
 for var j := a.Length - 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;

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

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;

16. Поиск по условию

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;

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. Условный минимум

procedure MinElemPred(a: array of integer; pred: IPredicate; var min, imin: integer);
begin
 min := Integer.MaxValue;
 imin := -1;
 for var i:=0 to a.Length - 1 do
 if pred(a[i]) and (a[i] < min) then
 begin
 min := a[i];
 imin := i;
 end;
end;

19. Удаление по условию

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;