Алгоритмы для студентов: различия между версиями

Материал из Вики проекта PascalABC.NET
Перейти к навигацииПерейти к поиску
Нет описания правки
Строка 4: Строка 4:




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


== Простейшие алгоритмы ==
=== №1. Сумма вводимых целых чисел ===
<source lang="pascal">
var s: real;
begin
  write('Введите число слагаемых: ');
  var n := ReadInteger;
  s := 0;
  for var i:=1 to n do
  begin
    write('Введите слагаемое: ');
    var x := ReadReal;
    s += x;
  end;
  writeln('Сумма слагаемых равна ',s);
end.
</source>
[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_01_Kazik.pas Ссылка на алгоритм в среде WDE]
=== №2. Произведение целых чисел ===
<source lang="pascal">
var p: real;
begin
  write('Введите число множителей: ');
  var n := ReadInteger;
  p := 1;
  for var i:=1 to n do
    begin
      write('Введите множитель: ');
      x := ReadReal;
      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
  write('Введите x: ');
  var x := ReadInteger;
  var p := 1;
  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
  write('Введите n: ');
  var n := ReadInteger;
  var c := 0;
  for var i:=1 to n do
  begin
    write ('Введите целое число: ');
    var x := ReadInteger;
    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">
var x: real;
begin
  repeat
    write('Введите x>0: ');
    x := ReadReal;
    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)*x;
end;
var
  N: integer;
  a, b: real;
begin
  write('Введите N: ');
  N := ReadInteger;
  Assert(N>0);
  write('Введите a и b: ');
  a := ReadReal;
  b := ReadReal;
  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;
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)*x;
end;
var
  N: integer;
  a, b: real;
begin
  write('Введите N: ');
  N := ReadInteger;
  Assert(N>0);
  write('Введите a и b: ');
  a := ReadReal;
  b := ReadReal;
  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 := ReadInteger;
  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">
var A,B,C: integer;
begin
  write('Введите целые числа A и B: ');
  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 := ReadInteger;
  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 := ReadInteger;
  assert(n>0);
  write('Введите 1 число: ');
  var x := ReadReal;
  var max := x;
  for var i := 2 to n do
  begin
    write('Введите ', i, ' число: ');
    x := ReadReal;
    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
  Result := x > 0;
end;
begin
  write('Введите целое число n (n>0): ');
  var n := ReadInteger;
  assert(n>0);
  var min := real.MaxValue;
  for var i := 1 to n do
  begin
    write('Введите ', i, ' число: ');
    var x := ReadReal;
    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">
var
  a: real;
  n: integer;
begin
  write('Введите a и n (n>0): ');
  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('Сумма = ', s);
end.
</source>
[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_13.pas Ссылка на алгоритм в среде WDE]
=== №13a. Вычислить Σ(i=1..∞) (-1)^i * a^i/i! ===
<source lang="pascal">
var a: real;
begin
  write('Введите a (0 < a < 1): ');
  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('Сумма = ', s); 
end.
</source>
[http://pascalabc.net/WDE/?shared=UnREAL/Algoritm_13a.pas Ссылка на алгоритм в среде WDE]
== Поиск значения ==
=== №14. Есть ли среди введенных число k? ===
<source lang="pascal">
var n,k: integer;
begin
  write('Введите целые числа n (n>0) и k: ');
  readln(n,k);
  assert(n>0);
  var Exists := false;
  for var i := 1 to n do
  begin
    write('Введите ', i, ' целое число: ');
    var x := ReadInteger;
    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">
var n,k: integer;
begin
  write('Введите целые числа n (n>0) и k: ');
  readln(n,k);
  assert(n>0);
  var Exists := false;
  var i := 1;
  while (i <= n) and not Exists do
  begin
    write('Введите ', i, ' целое число: ');
    var x := ReadInteger;
    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 := ReadInteger;
  assert(N>0);
  var IsSimple := True;
  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 := ReadInteger;
  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">
var
  x,a: real;
  n: integer;
begin
  write('Введите x: ');
  readln(x);
  write('Введите степень многочлена n (n>0): ');
  readln(n);
  assert(n>=0);
  write('Введите коэффициенты: ');
  readln(a);
  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;
var a,b: real;
begin
  write('Введите числа a и b (a<b): ');
  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]


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

Версия от 00:39, 30 ноября 2010

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

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



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

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

№1. Вывод массива

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

Ссылка на алгоритм в среде WDE

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

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;

Ссылка на алгоритм в среде WDE

№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;

Ссылка на алгоритм в среде WDE

№4. Поиск элемента по заданному значению

// С помощью 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;

Ссылка на алгоритм в среде WDE

№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;

Ссылка на алгоритм в среде WDE

Сдвиги, вставка, удаление

№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;

Ссылка на алгоритм в среде WDE

№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;

Ссылка на алгоритм в среде WDE

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

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;

Ссылка на алгоритм в среде WDE

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

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;

Ссылка на алгоритм в среде WDE

№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;

Ссылка на алгоритм в среде WDE

Слияние упорядоченных и бинарный поиск в упорядоченном массиве

№11. Слияние двух упорядоченных в один упорядоченный

// 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;

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

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

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;

№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;

Использование процедурных типов в задачах на массивы

Пусть сделаны следующие описания:

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;

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

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 := 1 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;



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