Цифровая сортировка (DigidalSort)

Пусть нужно отсортировать массив по возрастанию, а на вход поступают числа в диапазоне [-100;100]. При этом их количество настолько большое, что не поможет даже быстрая сортировка. Выходом служит так называемая цифровая сортировка. Возьмем 

a:array[-100..100] of integer

Предварительно обнулим его.

for i:=-100 to 100 do  a[i]:=0;

var

   a:array[-100..100] of integer;

   i,n,c,j:integer;

begin

 readln(n);

 for i:=1 to n do

  begin

   read(c);

   inc(a[c]);

  end;

 for i:=-100 to 100 do

  for j:=1 to a[i] do

   write(i,' ');

 readln

end.

Двоичный (бинарный) поиск

var

   n,v,i,r:integer;

   a:array[1..1000] of integer;

   

procedure binsearch(left,right:integer);

begin

    if left=right then

    begin

       r:=right;

       exit;

    end;

     

   r:=(right+left) div 2;

   if a[r]<v then

   begin

      left:=r+1;

      binsearch(left,right)

   end

   else

   begin

      right:=r;

      binsearch(left,right);

   end;

end;

 

begin

   readln(n);

   for i:=1 to n do

      read(a[i]);

   readln(v);

   binsearch(1,n);

   if a[r]=v then

      writeln(r)

   else

      writeln('Absent');

end.

Работа с матрицей одним циклом

Все знают как работать с двумерными массивами с помощью двух циклов:

For i:=1 to N do  For j:=1 to M do   A[i,j] ...

А что если осуществить работу с матрицей в одном цикле? Легко! Достаточно реализовать цикл от 0 до кол-во элементов -1. Обращение к элементу осуществляется по формуле: A[(i div кол-во строк)+1, (i mod кол-во столбцов)+1]

const

 N = 7; {кол-во строк}

 M = 6; {кол-во столбцов}

var

 A: array[1..N,1..M] of byte;

 i: byte;

Begin

 Randomize;

 For i:=0 to N*M-1 do

  Begin

   A[(i div N)+1, (i mod M)+1]:=random(99);

   write(A[(i div N)+1, (i mod M)+1]:4);

   if ((i+1) mod M = 0) then writeln;

  End;

 readln;

End.

Заполнение массива случайными неповторяющимися значениями

var

  a: array [1..100] of integer;

  i, j, k, n: integer;

 

begin

  repeat

    write('Задайте размер массива: ');

    readln(n);

  until n in [1..100];

  writeln('Массив:');

  for i := 1 to n do

  begin

    repeat

      k := 0;

      a[i] := random(-101, 101);

      for j := 1 to i - 1 do

        if a[j] = a[i] then inc(k);

    until k = 0;

    write(a[i], ' ');

  end;

  writeln;

end.

Удалить все элементы, которые встречаются больше 1 раза

Пусть нужно удалить все нулевые элементы из введенного пользователем массива.  Удаление:

var

   a:array[1..100] of integer;

   i,m,n:integer;

begin

 readln(n);    {ñ÷èòûâГ*ГҐГ¬ êîëè÷åñòâî ýëåìåГ*òîâ}

 for i:=1 to n do

  read(a[i]);

 writeln('ГЊГ*Г±Г±ГЁГў');

 for i:=1 to n do

  write(a[i],' ');

 writeln;

 writeln('Ïîñëå ГіГ¤Г*ëåГ*ГЁГї');

 m:=0;

 for i:=1 to n do

  if (a[i]=0) then inc(m) else a[i-m]:=a[i]; {ГіГ¤Г*ëÿåì ýëåìåГ*ГІГ»}

 dec(n,m);  {óìåГ*ГјГёГ*ГҐГ¬ êîëè÷åñòâî ýëåìåГ*òîâ Г¬Г*Г±Г±ГЁГўГ* Г*Г* êîëè÷åñòâî Г*óëåâûõ ýëåìåГ*òîâ}

 for i:=1 to n do

  write(a[i],' '); {âûâîä Г*Г* ГЅГЄГ°Г*Г*}

 readln

end.

как удалить все элементы, которые встречаются больше 1 раза?

uses crt;

var a:array[1..100] of integer;

    n,i,j,k,p,x:integer;

    f:boolean;

begin

clrscr;

randomize;

write('n=');readln(n);

writeln('Исходный массив:');

for i:=1 to n do

 begin

  a[i]:=random(10);

  write(a[i],' ');

 end;

writeln;

i:=1;

while i<n do

 begin

  f:=false;

  j:=i+1; //смотрим впереди

  while (j<=n)and not f do

  if a[j]=a[i] then  f:=true//если есть такой же, меняем флаг

  else j:=j+1; //иначе идем дальше

  if f then //если есть повторы

   begin

    x:=a[i];//запомним элемент

    p:=i;//и его текущую позицию

    while p<=n do //идем к концу

    if a[p]=x then //если такой же

     begin

      if p=n then n:=n-1 //если последний, убавляем размер массива

      else //иначе

       begin

        for k:=p to n-1 do //сдвигаем на него конец массива

        a[k]:=a[k+1];

        n:=n-1; //убавляем

       end

     end

    else p:=p+1;//если не такой, дальше

   end

  else i:=i+1;//если не удаляли, дальше

 end;

if n=0 then write('Все элементы более 1 раза, массив пустой')

else

 begin

  writeln('Более 1 раза удалены:');

  for i:=1 to n do

  write(a[i],' ');

 end;

readln

end.