В двумерном массиве Aplace[1..n,1..m] для каждого робота значениями, равными единице, будем указывать те населенные пункты, в которых данный робот может находиться в данный момент времени. Поясним логику решения на примере. Четыре робота находятся в пунктах 1,2,7,8.

Alink                                                                            Aplace

Первый робот может остаться в первом пункте или пойти во второй или третий пункты, в соответствии со связями в матрице Alink. Таким образом, в первом столбце матрицы Aplace во второй и третьей строках вместо 0 должны появиться 1. Изменения матрицы Aplace для роботов с номерами 2, 3 и 4 выполняются аналогичным образом.

Aplace через 1 момент времени              Aplace в следующий момент времени

Итак, появилась строка или строки матрицы Aplace, состоящие из одних единиц. Эта строка будет соответствовать населенному пункту, в котором возможна встреча роботов.

Однако для пунктов

                                                                               SHAPE  \* MERGEFORMAT

И при начальном расположении двух роботов в пунктах 1 и 6 встреча роботов никогда не произойдет, и строки Aplace, состоящей из одних единиц, не появится. Это требует введения второй матрицы (Aold), в которой должны фиксироваться достижимые пункты для каждого робота в предыдущий момент времени. Итак, если Aplace и Aold совпадают и нет ни одной строки, состоящей из одних единиц, то встреча роботов невозможна. Это схема решения первого задания. Решение второго задания отличается от первого тем, что требуется найти время Т2=Т1 – 1 (Т1 – время встречи роботов в одном населенном пункте), в которое все роботы находятся в одном из двух (произвольных) населенных пунктов, соединенных дорогой. В этом случае возможна их встреча и вне населенного пункта. Другими словами, в каждый момент времени необходимо проверять (находить) две строки матрицы Aplace, поэлементная логическая сумма которых дает строку, состоящую из одних единиц. При решении задания три матрицу Aplace следует не дополнять элементами, равными единице, а обновлять в соответствии со связями из матрицы Alink. Причем обновление выполнять не для всех роботов одновременно: в нечетные моменты времени 1,3,… для роботов, имеющих скорость 2, а в четные – 2, 4, …для всех роботов.    

    (Текст программы см. Приложение 7)

Вожатый в лагере. У вожатого в отряде дети разных возрастов от 10 до 17. каждое утро дети выходят на линейку, где они должны построится по старшинству (сначала старшие, затем младшие), но на первой линейке дети этого не знали и построились в произвольном порядке. Вожатый составил список возрастов построившихся. Необходимо составить алгоритм – программу, которая бы помогла вожатому как можно быстрее выстроить детей по старшинству.

Решение. Входные данные представляют собой список возрастов, который считывается из файла. Пример:

13  10  15  17  14  16  12  11

Выходные данные для данного примера:

17  16  15  14  13  12  11  10

Идея решения: задача решается с использованием методов сортировки. Так как в задаче указано, что необходимо выстроить детей как можно быстрее, то необходимо применить один из методов быстрой сортировки, например метод Хоара, эффективность данного алгоритма, по Д. Кнуту, составляет С=О(N*logN). Для некоторых исходных данных время сортировки пропорционально О(N²). (Текст программы см. Приложение 8)

Егерь. У егеря в лесном хозяйстве 4 станции, уезжая в командировку, он оставил своему молодому напарнику, подробную карту, на которой изображены все дороги из одной станции в другую. В качестве приложения он оставил таблицу, в которую занес время, которое понадобиться напарнику, чтобы добраться из одной станции в другую, таблица имеет следующий вид:

Где номер строки, это номер станции из которой напарник должен выйти, а номер столбца – это номер станции, в которую он должен попасть. Необходимо написать алгоритм-программу, которая укажет станции, через которые напарнику придется пройти, чтобы очутиться в нужной станции за минимальное время. Начальная и конечная станции вводятся с клавиатуры.

Решение. Данную таблицу можно рассматривать как матрицу смежности и построить по ней граф, который наглядно отобразит схему дорог из одной станции в другую. Таким образом можно применить один из алгоритмов поиска кратчайших путей, в данном случае наиболее удобно использовать алгоритм Флойда, который позволит не только найти минимальное время, которое потребуется напарнику, но и сам путь. Временная сложность данного алгоритма пропорциональна О(N³).

(Текст программы см. Приложение 9)

Игра «Найди друга». Всем ребятам выдаются карточки с номерами, они выстраиваются в ряд, по возрастанию номеров. Ребенку, который водит, также выдается карточка с номером. Считается, что ребенок нашел друга, если номер на его карточке совпадает с номером человека, к которому он подходит. Написать алгоритм – программу, которая позволит ребенку найти друга так, чтобы ребенок подходил к минимальному количеству участников. В случае если невозможно найти друга программа выводит результат «No», если же это возможно, то программа должна выводить количество детей, к которым подходил «вожа».

Примечание: номера детей определяются с помощью датчика случайных чисел, а номер ребенка, который водит, вводится с клавиатуры.

Решение. Так как мы знаем, что ребята расположены по возрастанию номеров на карточке, то наиболее быстрый способ найти друга можно реализовать с помощью бинарного поиска.

(Текст программы см. Приложение 10)

Приложение.

1  Комнаты музея.

Uses crt;

  Const n=100;

        X:array[0..3]of -1..1=(0,-1,0,1); {массив координат перемещения по

        Y:array[0..3]of -1..1=(-1,0,1,0);    клеткам. Индекс элемента массива

   Type Mas=array[0..n,0..n]of Integer; соответствует степени двойки}

 var A:mas;

     B:array[0..n,0..n]of Boolean;

     m,p,col,rooms,indexX,indexY:integer;

 procedure Init(Z:string);       {заполнение из входного файла массива, представляющего цифровую карту музея}

  Var f:text;                              

      i,j:integer;

  Begin

   Assign(f,z);

   Reset(f);

   ReadLn(f,m,p);

   For i:=1 to m do

    begin

    For j:=1 to p do

    Read(f,A[i,j]);

    ReadLn(f);

    end;

   FillChar(B,SizeOf(B),true);

   For i:=1 to m do

    For j:=1 to p do

    B[i,j]:=false;

   Close(f);

  end;

 function Degree2(i:integer):integer; {функция, вычисляющая i–ую степень двойки}

  var j,t:integer;

  begin

  t:=1;

   For j:=1 to i do

   t:=t*2;

  Degree2:=t;

  end;

 Procedure Solve(i,j:integer);

  Var k:integer;

   begin

  k:=3;

   While k>=0 do

     begin

   If A[i,j]<Degree2(k)then     {смотрим имеет ли клетка стену в заданном направлении}

    begin

   If not B[i+X[k],j+Y[k]] then {определяем, заходили ли мы в клетку ранее}

    begin

    Inc(col); {учитываем клетку в общей площади комнаты}

    B[i,j]:=true; {отмечаем, что в текущей клетке мы уже были}

    Solve(i+X[k],j+Y[k]); {переходим в следующую клетку}

    B[i,j]:=False; {делаем клетку, в которой последний раз были не просмотренной, чтобы рассмотреть другие варианты хода из неё в другую клетку}

    end;

    end

    Else A[i,j]:=A[i,j]-Degree2(k);

     Dec(k);

     end;

   end;

 procedure Prosmotr; {данная процедура отмечает уже просмотренную комнату}

  var i,j:integer;

   begin

  For i:=1 to m do

   For j:=1 to p do

   If A[i,j]=0 then B[i,j]:=True;

   end;

 begin

 clrscr;

 Init('A:museum.txt');

 rooms:=0;

 For indexX:=1 to m do         {ищем ранее не просмотренную клетку}

  For indexY:=1 to p do

   If not B[indexX,indexY] Then

    begin

 col:=1;

 Inc(rooms);

 Solve(indexX,indexY);

 Write(Col,' '); {вывод площади только что просмотренной комнаты}

 Prosmotr;

    end;

  WriteLn;

  WriteLn(rooms); {вывод количества комнат}

 readkey;

 end.

 2  Пират в подземелье.

uses crt;

 Const k=100;

       dx:array[1..4] of Integer=(1,0,-1,0); {массив координат перемещения пирата}

       dy:array[1..4] of Integer=(0,1,0,-1);

 Type mas=array[0..k,0..k]of Integer;

      mas2=array[0..k,0..k]of boolean; {массив логического типа для пометки комнат, в которых пират уже побывал}

  var n,m,sum1,sum,col:integer;

      A:mas;

      B:mas2;

   Procedure Init(z:string); {инициализация входных данных}

    Var f:text;

        i,j:integer;

    Begin

   Assign(f,z);

   Reset(f);

   FillChar(A,SizeOf(A),0);

   FillChar(B,SizeOf(B),true);

   ReadLn(f,n,m,col);

    for i:=1 to n do

      begin

     for j:=1 to m do

      Read(f,A[i,j]);

      ReadLn(f);

      end;

   Close(f);

    End;

  Procedure Solve(x,y,p:integer);

   var i,j:integer;

  begin

 If p=0 then begin

      If sum>sum1 then {сравниваем текущую стоимость набранных камней со стоимотью набранных ранее, с целью увеличения стоимости}

      sum1:=sum;

            end

   Else begin

      For i:=1 to 4 do

       If (A[x+dx[i],y+dy[i]]>0)and B[x+dx[i],y+dy[i]] then {просматриваем варианты перехода пирата в другую комнату, проверяя не был ли пират в ней до этого}

         begin

        sum:=sum+A[x+dx[i],y+dy[i]]; {прибавляем стоимость камня, находящегося в данной комнате к суммарной стоимости}

        B[x+dx[i],y+dy[i]]:=false; {отмечаем, что в данной комнате мы уже были}

        Solve(x+dx[i],y+dy[i],p-1);

        sum:=sum-A[x+dx[i],y+dy[i]];

        B[x+dx[i],y+dy[i]]:=true;

         end;

        end;

  end;

 begin

  clrscr;

   Init('A:241.txt');

   sum1:=0; sum:=A[1,1];

   Solve(1,1,col);

   WriteLn('Result= ',sum1);

  readkey;

 end.

3 Диспетчер и милиция.

Uses crt;

  Const n=100;

   Type mas=array[1..n,1..n]of Integer;

        mas1=array[1..n]of Integer;

        mn=Set of 1..n;

 Var m,first,last:integer;

     D:mas1;

     A:mas;

 procedure Init(z:string); {инициализация входных данных}

  Var i,j:integer;

      f:text;

   begin

  Assign(f,z);

  Reset(f);

  ReadLn(f,m);

 For i:=1 to m do

  begin

   For j:=1 to m do

    Read(f,A[i,j]);

    ReadLn(f);

  end;

  Close(f);

   end;

function MinZn(R:mn):integer; {вычисляет номер района, путь до которого из района отправления минимален}

  var i,minn:integer;

   Begin

  minn:=MaxInt;

  For i:=1 to m do

   If (D[i]<minn)and(D[i]>0)and(i in R) then

     begin

   MinZn:=i;

   minn:=D[i];

     end;

   End;

 Function Min(i,j:integer):integer;{возвращает минимальное значение из двух возможных}

  Begin

  If i<>0 then

    begin

   If j<>0 then

     begin

     If j<i then Min:=j else Min:=i;

     end Else Min:=i;

    end Else Min:=j;

  End;

 procedure Milicia(s:integer);

  var v,u:integer;

        T:mn;

  Begin

   for v:=1 to m do D[v]:=A[s,v];

   D[s]:=0; T:=[1..m]-[s];

    While T<>[] do

       Begin

     u:=MinZn(T);

     T:=T-[u];

   For v:=1 to m do

    If v in T then

     If A[u,v]<>0 Then

    D[v]:=Min(D[v],D[u]+A[u,v]);

       end;

  End;

 Begin

 clrscr;

 Init('A:milicia.txt');

 WriteLn('Введите пункт отправления и пункт назначения');

 ReadLn(first,last);

 Milicia(first);

 WriteLn(D[last]);

      readkey;

 End.

4  Задача о футболистах.

uses crt;

  Const k=100;

   Type mas=array[1..k]of Integer;

 Var m,q:integer;

     A,B:mas;

 procedure Init(z:string); {инициализация исходных данных}

  var i:integer;

      f:text;

   begin

  Assign(f,z);

  Reset(f);

  ReadLn(f,m,q);

  For i:=1 to m do  

   Read(f,A[i]);

   ReadLn(f);

  For i:=1 to q do

   Read(f,B[i]);

  Close(f);

   end;

  procedure Solve;

   var i,j,t:integer;

       D:mas;

    begin

   i:=1; j:=1; t:=1;

    While (i<=m)and(j<=q)do {пока не вышли футболисты хотя бы из одного автобуса}

    Begin

{сравниваем номера футболистов в разных автобусах, выходит в строй футболист с наименьшим номером}

     If A[i]<=B[j] Then begin D[t]:=A[i]; Inc(i); end

      Else begin D[t]:=B[j]; Inc(j); end;

    Inc(t);

    end;

{из одного автобуса вышли все футболисты, осталось выйти остальным}

     While i<=m do begin D[t]:=A[i]; Inc(i); Inc(t); end;

     While j<=q do begin D[t]:=B[j]; Inc(j); Inc(t); end;

     For i:=1 to t-1 do Write(D[i],' ');

    end;

  begin

  clrscr;

  Init('A:socker.txt');

  Solve;

  readkey;

  end.

5 Задача о семьях.

Uses crt;

 Const MaxN=1000;

Var A:array[1..maxN]of byte;

       N, cnt,i,j:integer;

Procedure Swap(var a,b:byte);

  Var c:byte;

Begin

c:=a; a:=b; b:=c;

End;   

Begin

Write(‘введите N’); readln(N);

Write(‘введите массив через пробел(0 – Петров, 1 - Иванов)’);

For i:=1 to N do read(A[i]);

i:=1; j:=N; cnt:=0;

While i<j do

  If A[i]=1 then Inc(i) else

    If A[j]=0 then Dec(j) else begin

       Swap(A[i],A[j]);

Inc(i); dec(j);

Inc(cnt);

End;

writeLn(‘Число обменов - ’, cnt);

End.  

6 Метро.

uses crt;

  const p=100;

   Type mas=array[1..p,1..p]of 0..1;

 var k,n:integer;

     A:mas;

 procedure Init(z:string); {инициализация данных}

  var f:text;

      i,j:integer;

   begin

  Assign(f,z);

  Reset(f);

  ReadLn(f,n);

   For i:=1 to n do

    begin

   For j:=1 to n do

    Read(f,A[i,j]);

    ReadLn(f);

    end;

  Close(f);

   end;

  procedure Get(i:integer); {i – номер станции, из которой необходимо отправится}

   var S,T:Set of 1..p;

       j,l:integer;

     begin

     T:=[i];

     Repeat

      S:=T;

     For l:=1 to n do

      If l in S then     {по строкам матрицы смежности А, принадлежащим множеству S}

       For j:=1 to n do

        If A[l,j]=1 Then T:=T+[j]; {смотрим если есть путь из данного пункта в пункт j, то добавляем номер пункта j в множество Т}

      Until S=T;

       For j:=1 to n do

        If (j in T)and(i<>j) then Write(j,' '); {просматриваем содержится ли номер пункта j в множестве имеющих путь из пункта i}

     end;

   begin

   clrscr;

   Init('A:metro.txt');

   readLn(k);

   Get(k);

   readkey;

   end.

7 Роботы.

Program Robots;

 Const max=50;

 Type Sset=Set of 1..max;

    Mas=array[1..max]of Sset;

  Var A,B:Mas;

 {A – матрица достижимостей, B[i] – какие роботы могут быть в i пункте}

SOne, STwo: SSet; {SOne – роботы, которые едут со скоростью 1, STwo – роботы, которые едут со скоростью 2}

N, M:integer; {N – число пунктов, M – число роботов}

Procedure Init; {инициализация входных данных}

 Var K, i, FrP, ToP:integer;

 Begin

FillChar(A,SizeOf(A),0);

Write(‘Число пунктов:’); ReadLn(N);

Write(‘Число дорог:’); ReadLn(K);

 For i:=1 to K do begin

writeLn(‘Введите пункты, которые соединяет дорога №’, i);

ReadLn(FrP, ToP);

Include(A[FrP],ToP);

Include(A[ToP],FrP);

End;

Write(‘Число роботов:’); ReadLn(M);

 For i:=1 to M do Begin

Write(‘Пункт, где находится робот №’,i,’:’); ReadLn(K);

 Include(B[k],i);

Write(‘скорость робота №’,i,’:’);

ReadLn(k);

 If K=1 then Include(SOne,i) Else Include(STwo,i);

  End;    

 End;

Function ProvCanMet: Boolean;

 Var i:integer;

   Begin

i:=1;

  While (i<=N)and(B[i]<>[1..M])do Inc(i);

ProvCanMet:=i<=N;

    End;  

Function InTwoNear: Boolean;

 Var i,j:integer;

Begin

i:=1; j:=N+1;

 while (i<N)and(j>N)do begin

j:=i+1;

 while(j<=N)and Not((j in A[i])and(B[i]+B[j]=[1..M]))do Inc(j);

 Inc(i);

End;

InTwoNear:=j<=N;

End;

Function AddIfCan(mode:integer; S:Sset):Boolean;

 Var i,j:integer;

         C:mas;

Begin

AddIfCan:=false; {S – множество роботов, которые едут}

If mode=0 then

   For i:=1 to N do C[i]:=B[i]-S

  Else C:=B;

For i:=1 to N do

For j:=1 to N do

 If (i<>j)and(j in A[i])and(C[i]*B[j]*S<>B[j]*S) Then Begin

AddIfCan:=true;

C[i]:=C[i]+B[j]*S;

End;

B:=C;

End;

Function InTwoForC: byte;

 Var i,j:integer;

    Begin

i:=1; j:=N+1;

 while (i<N)and(j>N)do begin

j:=i+1;

While (j<=N)and (not(j in A[i])or(B[i]+B[j]<>[1..m])or Not((SOne=[])or(STwo=[])or((B[i]*SOne=SOne)and(B[j]*STwo=STwo))or (B[j]*SOne=SOne)and(B[i]*STwo=STwo)))do Inc(j);

Inc(i);

End;

If j>N Then InTwoForC:=0 Else

 If STwo=[] Then InTwoForC:=1 Else

 If SOne=[] Then InTwoForC:=2 Else

   InTwoForC:=3;

    End;

Procedure SolveC;

 Var time:integer;

 FindS, IncS: Boolean;

 ForMet: integer;

Begin

Time:=0;

IncS:=true;

 ForMet:=InTwoForC;

FindS:=ProvCanMet;

While IncS and Not FindS and(time<=N*2)and(ForMet=0)do begin

Inc(time);

 If Time Mod 2=0 then IncS:=AddIfCan(0,[1..m])

 Else incS:=AddIfCan(0,STwo);

ForMet:=InTwoForC;

FindS:=ProvCanMet and(time mod 2=1);

End;

If Time>N*2 then WriteLn(‘Пункт В: Роботы не встретятся’)

  Else begin

Write(‘Пункт В: Роботы встретятся через’);

If FindS Then Write(Time/2:0:3)

Else Case ForMet of

1: write((time+1)/2:0:3);

2: write(time/2+1/4:0:3);

3: write(time/2:0:3,’+1/’,(time mod 2+1)*3);

End;

WriteLn(‘Момент(а,ов) времени’);

          End;

End;

Procedure SolveAB;

 Var time:integer;

   ForB, FindS, IncS: Boolean;

   Old:mas;

Begin

Old:=B;

Time:=0;

IncS:=true; FindS:=ProvCanMet;

While IncS and Not FindS do begin

ForB:=InTwoNear;

Inc(time);

incS:=AddIfCan(1,[1..m]);

FindS:=ProvCanMet;

End;

If FindS Then begin

WriteLn(‘Пункт А:’,time,’момент(а,ов) времени’);

WriteLn(‘Пункт Б:’,time – Byte(ForB)*0.5:0:1,’момент(а,ов) времени’);

SolveC;

End

Else begin

WriteLn(‘Пункт А: Роботы не встретятся’);

 writeLn(‘Пункт Б: Роботы не встретятся’);

writeLn(‘Пункт В: Роботы не встретятся’);

end;

B:=Old;

End;

Begin

Init;

SolveAB;

End.

8 Вожатый в лагере.

uses crt;

  Const k=50;

  Type mas=array[1..k]of integer;

  var col:integer;

      A:mas; {массив представляющий собой список возрастов детей}

  procedure Init(z:string); {инициализация данных}

   var i:integer;

       f:text;

    begin

  Assign(f,z);

  Reset(f);

  i:=0;

  While not EoLn(f) do

   begin

   Inc(i);

  Read(f,A[i]);

   end;

  col:=i;

  Close(f);

    end;

 procedure Print; {вывод списка на экран}

  var i:integer;

   begin

 For i:=1 to col do

  Write(A[i],' ');

   end;

 procedure Solve(m,t:integer);

  var i,j,w,x:integer;

   begin

  If m>=t then exit;

   i:=m; j:=t; x:=A[(m+t)div 2]; {x- барьерный элемент, т.е. возраст, относительно которого будет сортироваться список, i,j – нижний и верхний номер, рассматриваемой части списка}

    While i<j do

     If A[i]>x then Inc(i)else    {смотрим элементы списка относительно

     If A[j]<x then Dec(j)else     барьерного элемента, пока не найдем из правой и

      Begin                                   левой части по элементу, которые стоят не на 

      w:=A[i]; A[i]:=A[j]; A[j]:=w;  своем месте. Меняем их местами}

      end;

    Solve(m,j-1); Solve(i+1,t); {ищем далее барьерный элемент, сначала в правой

   end;                                    части списка, затем в левой}

 begin

 clrscr;

 Init('A:alfa.txt');

 Print;

 WriteLn;

 Solve(1,col);

 Print;

 readkey;

end.

9 Егерь.

Program Eger;

 uses crt;

 Const n=4;

 var A,P,D:array[1..n,1..n]of Integer; {A – матрица смежности; D – массив кратчайших путей, где D[i,j] – минимальное время, которое потребуется, чтобы добраться из станции i до станции j; P – массив, элементами которого являются номера станций, которые будут составлять путь с минимальным временем}

     k,m:integer; {начальная и конечная станции движения}

  procedure Init(z:string); {инициализация данных}

   var i,j:integer;

       f:text;

    begin

     Assign(f,z);

     Reset(f);

    For i:=1 to n do

     begin

    For j:=1 to n do

     Read(f,A[i,j]);

     ReadLn(f);

     end;

     Close(f);

    end;

 Procedure Solve;

  var i,j,k:integer;

   begin

   For i:=1 to n do

   For j:=1 to n do

     begin

    D[i,j]:=A[i,j];

    P[i,j]:=i;

     end;

  for k:=1 to n do begin

  for i:=1 to n do

  for j:=1 to n do

   If D[i,j]>D[i,k]+D[k,j]  then begin         {определение пути с минимальным

                                 D[i,j]:=D[i,k]+D[k,j]; временем}

                                 P[i,j]:=k; {заносим номер станции, которая будет

                                 end;          предпоследней, посещенной напарником}

                   end;

   end;

 procedure Way(i,j:integer); {рекурсивная процедура, выводит

  begin                                     последовательность станций, которые посетит

   If P[i,j]<>i then begin          напарник, отталкиваясь от данных,

                     Way(i,P[i,j]);      занесенных в массив P}

                     Write (P[i,j]:2,'->');

                     Way(P[i,j],j);

                     end

  end;

 begin

  clrscr;

  Init('A:eger.txt');

  Solve;

  Writeln('Введите из какой станции и в какую будем искать путь:');

  Readln(k,m);

  Write(k:2,'->');

  Way(k,m);

  WriteLn(m:2);

  WriteLn(‘Время пути= ‘,D[k,m]);

  readkey;

 end.

10 Игра «Найди друга».

uses crt;

  Const n=20;

   type mas=array[1..n]of Integer;

   var A:mas;

       X,b:integer;

 procedure Init(z:string);

  var i:integer;

      f:text;

   begin

   Assign(f,z);

   Reset(f);

  For i:=1 to n do

   Read(f,A[i]);

   Close(f)

   end;

 procedure Print;

  var i:integer;

  begin

   For i:=1 to n do

    Write(A[i],' ');

  end;

procedure Solve(i,j:integer;Var t:integer);

  var m:integer;

   begin

    If i>j then Writeln('No')

     else begin m:=(i+j)div 2;

                Inc(b);

      If A[m]<X then Solve(m+1,j,t)

      else If A[m]>X then Solve(i,m-1,t)

       else Write(b);

          end;

   end;

 begin

 clrscr;

 Init('A:game.txt');

 Print;

 WriteLn;

 ReadLn(x);

 Solve(1,n,b);

 readkey;

 end.