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

Материал из Вики проекта PascalABC.NET
Перейти к навигацииПерейти к поиску
Строка 143: Строка 143:
<source lang="pascal">
<source lang="pascal">
// a,b упорядочены по возрастанию
// a,b упорядочены по возрастанию
function Merge(a,b: array of real; n,m: integer): array of integer;
function Merge(a,b: array of real; n,m: integer): array of real;
begin
begin
   Assert((0 < n) and (n < a.Length));
   Assert((0 < n) and (n < a.Length));

Версия от 22:04, 28 ноября 2010

Здесь будет ряд алгоритмов из курса лекций "Основы программирования"

Вывод массива

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

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

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;

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

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;

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

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

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

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;

Сдвиг влево

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;

Сдвиг вправо

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

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

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

Удаление 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;

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

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

procedure Insert<T>(a: array of T; var n: integer; var 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

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

// a,b упорядочены по возрастанию
function Merge(a,b: array of real; n,m: integer): array of real;
begin
  Assert((0 < n) and (n < a.Length));
  Assert((0 < m) and (m < b.Length));
  a[n] := real.MaxValue;
  b[m] := real.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;

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

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;