Главная

Олимпиада по информатике

Городской тур, Кемеровская область, 2006 г.

 

Морозов Владимир,

учитель математики и информатики

МОУ «Школа 17»

г. Полысаево Кемеровской области

 

Задача 1. Дан список, в каждой строке которого указано, какая страна какой стране сколько миллиардов должна. Оптимизировать список долгов, используя взаиморасчеты.

 

Пример входного файла:

 

England France 2

USA England 5

France USA 8

 

Пример выходного файла:

France England 3

France USA 3

 

Решение. Следует просматривать список долгов, и находить всевозможные пары, которые можно «склеить», то если кредитор одной пары совпадает с должником другой пары. Если удаётся обнаружить две такие пары, то возможны две ситуации:

1. Страна А должна стране Б, и страна Б должна стране А.

2. Страна А должна стране Б, и страна Б должна стране С.

 

В первом случае (Страна А должна стране Б, и страна Б должна стране А) следует найти минимальную сумму и вычесть её из максимальной, элемент списка долгов с минимальной суммой удалить из списка.

Для удаления строки из списка долгов не обязательно физически удалять эту строку, мучаясь потом со сдвигом остальных элементов списка. Для удаления элемента списка долгов мы введём множество индексов, в котором в начале процесса оптимизации будут все индексы от первого до последнего. Удалять строку списка долгов будем просто удаляя элемент множества индексов. Но впредь работать только с теми строками списка долгов, индексы которых есть в этом множестве, и выводить в качестве ответа список оптимизированных долгов только с индексами из этого множества.

 

Путь теперь страна А должна стране Б х млрд., и страна Б должна стране С y млрд.

 

Возможны три случая:

x=y;

– x<y;

– x>y.

 

Если x=y, то ясно, что долг страны А можно непосредственно перенаправить в страну С, а долг страны Б удалить из списка.

Если x<y, то эти х млрд. направляем из страны А сразу в страну С, и тогда страна Б будет должна стране С y–x млрд.

Если x>y, то эти х–y млрд. направляем из страны А сразу в страну С, а y млрд. направляем из страны А в страну Б.

 

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

После этого список долгов будет оптимизирован. Далее следует исходный код программы на языке Pascal с подробными комментариями.

 

program q;

  uses crt;

  const n=255; {Максимальное количество строк списка}

  type String20=string[20]; {Тип для хранения одной записи о долге}

       Dolg=record

         state1,state2:string20;

         money:integer

       end;

       TClub=array [1..n] of Dolg;

         {Тип для хранения всей системы долгов}

       SetByte=Set of Byte;

{Множество номеров строк, которые не стёрты}

  var f,g:Text; {Переменные-файлы для входных и выходных данных}

      x:TClub; {Массив для хранения записей о долгах}

      h,hh:string; {Строки для обработки входных данных}

      p1,p2,p,

         {переменные для поиска пробелов в строках входных файлов}

      s,code, {переменные для перевода строковых данных в числовые}

      k, {Количество строк во входном файле}

      i,j:integer; {Счётчики}

      exist:SetByte; {Множество для хранения одной записи о долге}

      L:Boolean;

        {Флаг-признак того, что больше в списке оптимизировать нечего}

 

  Function card(y:SetByte):integer; {Количество элементов множества}

    var i,s:integer;

    begin

      s:=0; {счетчик элементов множества}

      for i:=1 to 255 do if (i in y) then inc(s);

      card:=s

    end;

 

begin

  TextBackGround(1); TextColor(14); ClrScr; {Настройка цвета экрана}

  Assign(f,'c:/par.in'); reset(f); {Готовы читать файл}

  k:=0;{Количество долгов}

  while not(eof(f)) do {Пока не конец файла}

    begin

      readln(f,h); p1:=1; hh:='';inc(k);

      while h[p1]<>' ' do inc(p1); {Нашли первый пробел}

      for p:=1 to p1-1 do hh:=hh+h[p]; {Получили первую страну}

      x[k].State1:=hh; p2:=p1+1; hh:='';

      while h[p2]<>' ' do inc(p2); {Ищем второй пробел}

      for p:=p1+1 to p2-1 do hh:=hh+h[p]; {Строим название второй страны}

      x[k].State2:=hh; hh:='';

      for p:=p2+1 to length(h) do hh:=hh+h[p]; {Строим строку из суммы долга}

      val(hh,s,code); x[k].money:=s; {Определили долг}

    end;

  close(f); {Данные прочитаны и занесены в память

            k=количество записей о долгах}

  for i:=1 to k do {Выводим прочитанные данные}

    writeln(x[i].State1,' ',x[i].State2,' ',x[i].money);

  exist:=[1..k]; {Множество индексов рассматриваемых долгов}

  {По ходу взаимозачета долгов некоторые долги будут

   удалятся, и из множества рассматриваемых долгов

   будут удалятся их индексы с тем чтобы эти долги больше не   

   рассматривать и не выдавать в ответ}

  Repeat

    L:=True; {Флаг, признак того, что список долгов оптимизирован}

    for i:=1 to k do

    for j:=1 to k do

      begin

        if (i<>j)and(i in Exist)and(j in Exist)

          then {перебираем всевозможные пары долгов}

            begin

            {Сравниваем, можно ли построить ветку дерева x[i] -> x[j]}

            if (x[i].State2=x[j].state1)and(i in Exist)and(j in exist)

                then

                  begin

                    {Получилась ветка. Оптимизируем ветку}

                    if x[j].state2=x[i].state1

{Если ветка зациклилась:

                         A должен В, а В должен А}

                      then

                        begin

                          if (x[i].money=x[j].money)and(i in Exist)and(j in exist)

                            then

                              begin

                                {Удаляем оба долга из списка долгов. Полный взаимозачет}

                                 exist:=exist-[i]; exist:=exist-[j]; L:=False

                              end;

                          if (x[j].money<x[i].money)and(i in Exist)and(j in exist)

                            then

                              begin

                                x[i].money:=x[i].money-x[j].money;

                                Exist:=Exist-[j]; L:=False

                              end

                        end

                      else

                        begin {Ветка не цикличная}

                          if (x[i].money=x[j].money)and(i in Exist)and(j in exist)

                            then

                              begin

                                x[i].state2:=x[j].state2;

      {перенаправили долг целиком в другую страну}

  {Теперь j-й долг следует удалить}

                                Exist:=Exist-[j]; L:=False

                              end

                            else

                        if (x[i].money<x[j].money)and(i in Exist)and(j in exist)

                         {Проверку на наличие номеров долгов во множестве

                         Exist следует делать, потому что уже не нужно рассматривать

                         строки, которые только что были удалены

                         внутри этого шага цикла}

                                 then

                                   begin

                                     x[i].State2:=x[j].state2;                              

x[j].money:=x[j].money-x[i].money; L:=False

                                    end

                                  else

                                    if (i in Exist)and(j in exist)

                                      then

                                        begin

                                    x[i].money:=x[i].money-x[j].money;

                                          x[j].State1:=x[i].state1;

   L:=False;                          

                                        end

                        end

                  end

            end

      end

    Until L;

    writeln; TextColor(11); assign(g,'c:/par.out'); rewrite(g);

    {Готовы писать в выходной файл}

    if card(exist)=0 {Проверка оптимизированного списка на пустоту}

      then

        begin

          writeln('Все долги взаимозачтены');

          writeln(g,'Все долги взаимозачтены')

        end

      else

        begin

          for i:=1 to k do

            if (i in Exist) {Выводим только невыброшенные строки}

              then

                begin

                  writeln(x[i].State1,' ',x[i].State2,' ',x[i].money);

                writeln(g,x[i].State1,' ',x[i].State2,' ',x[i].money);

                end

        end;

  close(g);{Закрыли готовый файл с ответами}

  repeat until keypressed;

end.

 

Задача 2. Дана прямоугольная таблица из нулей и единиц – просканированный рисунок отпечатка древнего листа на угле. Найти количество сторон многоугольника.

 

Пример входного файла:

 

10101

01110

00100

01110

11111

 

Пример выходного файла:

9

 

Решение. Будем подсчитывать количество сторон многоугольника, буквально проходя по его сторонам, например, против часовой стрелки. Заметим, что число вершин многоугольника совпадает с числом его сторон. На самом деле, пудем считать количество вершин многоугольника.

Сначала найдём левую верхнюю вершину многоугольника. Для этого просматриваем строки слева направо, первую строку, втору строку и т. д. до тех пор, пока нам не встретится первая единица. Запоминаем её координаты. Это и есть левая верхняя вершина многоугольника.

Пронумеруем все возможные направления, например так:

вверх – 1;

вверх влево – 2;

влево – 3;

вниз влево – 4;

вниз – 5;

вниз вправо – 6;

вправо – 7;

вверх вправо – 8.

Всего – 8 направлений.

Теперь начинаем движение от первой точки. Начинаем «оглядываться», перебирая направления начиная от направления 2 (для первой точки там заведомо нет единицы), постепенно увеличивая номер направления и проверяем, есть ли единица в этом направлении. При увеличении направления следим, чтобы его номер был не больше 8. Если при увеличении направления номер направления равен 9, то номер направления следует установить на 1. Таким образом, мы «оглядываемся» против часовой стрелки, пока не найдём направление дальнейшего движения. Если новое направление не равно предыдущему направлению, то счётчик вершин увеличиваем на единицу. Теперь двигаемся в новом направлении. Для этого напишем процедуру движения от данной точки в данном направлении. Если же новое направление и старое направление совпадают,  то просто двигаемся в прежнем направлении.

Будем повторять описанную выше последовательность действий до тех пор, пока не встанем на исходную точку, координаты которой мы предусмотрительно сохранили. Остаётся теперь только вывести готовый ответ: число подсчитанных сторон многоугольника.

Описанный выше алгоритм позволяет не только подсчитать количество сторон многоугольника, но даже нарисовать его! Это действительно теперь не сложно: для этого в процедуру движения в данном направлении включим команду рисования отрезка фиксированной длинны в том же направлении.

Теперь программа умет ещё и рисовать данный лист!

Ниже приведён исходный код программы целиком.

 

program qq;

  uses crt,graph; {Библиотека Graph для рисования данного листа :) }

  const nn=30; {Максимальный размер сканируемого прямоугольника}

  Type List=array[1..nn,1..nn] of integer; {Тип для хранения сканированного рисунка}

  var f,g:Text; {Переменные для входных и выходных данных}

      i,j, {Переменные индексы. Также используются для хранения

            текущих координат на стороне литса при обходе листа

            против часовой стрелки}

      i0,j0, {координаты начальной точки. Служат для проверки того факта,

              что при обходе листта вернулись в начальную точку.

              Эта начальная точка - правый верхний угол листа}

      s,code, {переменные для преобразования строк в число}

      v, {Переменная - счётчик для подсчёта сторон многоугольника

         Будем аккуратно увеличивать на 1 при обнаружении новой стороны}

      dir1,dir2, {переменные для хранения направлений, предыдущее и последующее:

                  1 - вверх; 2 - вверх и влево и т.д. против часовой стрелке;

                  8 - вверх и вправо

                  При смене направлений увеличиваем счётчик сторон v на 1}

      gd,gm,{переменные для включения графического режима}

      p,q,{Текущие координаты на экране при рисовании листа в графическом

           режиме}

      n,{Высота прямоугольника. Будет определяться автоматически в

         зависимости от количества прочитанных строк}

      mm:integer; {Длина прямоугольника. Будет определяться автоматически

                   как длина самой длинной строки}

      h:string; {переменная для чтения строк из входного файла}

      x:List; {Матрица из нулей и единиц}

      L:Boolean; {Флаг, признак того, что не найден правый верхний угол листа}

 

  Function Check(i,j,dir:integer):Boolean;

    {Проверяет, есть ли 1 в данном направлении}

    var L:Boolean;

    begin

      case dir of

        1:if i=1 then L:=False else L:=(x[i-1,j]=1); {Вверх}

        2:if (i=1)or(j=1) then L:=False else L:=(x[i-1,j-1]=1); {Вверх Лево}

        3:if j=1 then L:=False else L:=(x[i,j-1]=1); {Влево}

        4:if (i=n)or(j=1) then L:=False else L:=(x[i+1,j-1]=1); {Вниз Влево}

        5:if (i=n) then L:=False else L:=(x[i+1,j]=1); {Вниз}

        6:if (i=n)or(j=mm) then L:=False else L:=(x[i+1,j+1]=1); {Вниз Вправо}

        7:if j=mm then L:=False else L:=(x[i,j+1]=1); {Вправо}

        8:if (i=1)or(j=mm) then L:=False else L:=(x[i-1,j+1]=1); {Вверх Вправо}

      end;

      Check:=L

    end;

 

  procedure Step(var i,j:integer; dir:integer);

    {Делает 1 шаг из точки с координатами (i,j) в данном направлении dir}

    begin

      Case dir of

        1:dec(i); {Шаг вверх}

        2:begin dec(i); dec(j) end; {Шаг вверх влево}

        3:dec(j); {Шаг влево}

        4:begin inc(i); dec(j) end; {Шаг вниз влево}

        5:inc(i);{Шаг вниз}

        6:begin inc(i); inc(j) end;{Шаг вниз вправо}

        7:inc(j);{Шаг вправо}

        8:begin dec(i); inc(j) end;{Шаг вверх вправо}

      end

    end;

 

  procedure stepgraph(var p,q:integer;dir:integer);

    {Рисует лист, вернее, строит очередную сторону многоугольника-листа}

    const m=25; {Длина одного шага}

    begin

      Case dir of

        1:begin p:=p-m; lineto (q,p) end; {Шаг вверх}

        2:begin p:=p-m; q:=q-m;lineto (q,p)end; {Шаг вверх влево}

        3:begin q:=q-m;lineto (q,p) end; {Шаг влево}

        4:begin p:=p+m; q:=q-m;lineto (q,p) end; {Шаг вниз влево}

        5:begin p:=p+m;lineto (q,p) end; {Шаг вниз}

        6:begin p:=p+m; q:=q+m;lineto (q,p) end;{Шаг вниз вправо}

        7:begin q:=q+m;lineto (q,p)end;{Шаг вправо}

        8:begin p:=p-m; q:=q+m;lineto (q,p) end;{Шаг вверх вправо}

      end

    end;

 

  Function card(x:List):integer; {Считает количество единиц в прямоугольнике

    и защищает от зацикливания, если таблице только 1 единица или только нули}

    var s,i1,j1:integer;

    begin

      s:=0; {Счётчик единиц}

      for i1:=1 to n do for j1:=1 to mm do if x[i1,j1]=1 then inc(s);

      card:=s

    end;

 

begin

  TextBackGround(1);  TextColor(14);  ClrScr;

  Assign(f,'c:/List.in');  reset(f);  n:=1; mm:=0; {Готовы читать строки данных}

  while not(eof(f))and (i<nn) do

    begin

      readln(f,h);

      if length(h)>mm then mm:=length(h);{Максимальная длина строки из 0 и 1}

      for j:=1 to length(h) do

        begin

          val(h[j],s,code); x[n,j]:=s

        end;

      inc(n)

    end;

  dec(n); close(f);{Данные прочитаны, матрица из 0 и 1 построена}

  for i:=1 to n do

    begin

      for j:=1 to mm do write(x[i,j]);

      writeln

    end;

  readln; TextColor(11); {Поиск верхнего правого угла}

  i:=1; j:=1;  L:=True;

  while L and (i<=n) do

    begin

      while (x[i,j]=0)and(j<mm) do inc(j);

      if x[i,j]=1

        then

          L:=False

        else

          begin

            inc(i);j:=1;

          end

    end;

  i0:=i;j0:=j; {Координаты верхнего правого угла}

  dir1:=3;

  v:=0; {Счетчик сторон}

  if card(x)>1

    then

      begin

        gd:=0;gd:=0;

        initgraph(gd,gm,'c:/tp/bgi');

        p:=100;q:=100; {Начало рисунка листа}

        Setcolor(11);

        moveto(q,p);

        repeat

          dir2:=dir1-2; if dir2<=0 then inc(dir2,8);

          while not(check(i,j,dir2)) do

            begin

              inc(dir2);

              if dir2>8 then dir2:=dir2-8;

            end;

          {Выбрано направление}

          if dir1<>dir2 then inc(v); {Посчитали еще одну сторону}

          {writeln(v);}

          {Направление выбрано, делаем шаг в направлении dir2}

          Step(i,j,dir2);

          StepGraph(p,q,dir2);

          dir1:=dir2; {Шаг завершен}

        until (i=i0)and(j=j0);

        readln; closegraph;

        ClrScr;

  end

  else

    begin

      writeln('Лист слишком мал, не более 1 точки')

    end;

  assign(g,'c:/List.Out'); {Вывод результата}

  rewrite(g); write(g,v);  write(v);  close(g);

  repeat until keypressed;

end.

 

Задача 3. Дан список претендентов в баскетбольную команду с указанием имени, фамилии, роста и возраста. Вывести список претендентов старше 13 лет в порядке возрастания возраста. Если возраст совпадает, то выводить спортсменов в порядке убывания роста.

 

Первая строка входного файла – количество претендентов.

В каждой из следующих строк – фамилия, имя, возраст и рост претендента.

В выходном файле – список принятых спортсменов в баскетбольную команду.

 

Пример входного файла:

 

7

Ivanov Petr 15 170

Petrov Ivan 12 130

Sidorov Semen 14 165

Pupkin Gosha 13 144

Tupin Vova 15 171

Alexandrov Alexandr 15 169

Gofman Georg 14 167

 

 

Пример выходного файла:

 

Gofman Georg  14 167

Sidorov Semen  14 165

Tupin Vova  15 171

Ivanov Petr  15 170

Alexandrov Alexandr  15 16

 

Решение. Программа довольно проста, используем простейший «пузырьковый» метод сортировки. Исходный код решения приведён ниже.

 

program q;

  uses crt;

  const n=50;

  type Person=record

         Name,Surname:string;

         Age,Height:integer

       end;

       TComanda=array [1..n] of Person;

  var f,g:Text;

      i,j,jj,k,kk,p,s,code:integer;

      h,hh:string;

      x,y:TComanda;

      c:Person;

      L:boolean;

 

  function Greater(a,b:Person):boolean;

    var L:boolean;

    begin

      if a.age>b.age

        then

          L:=True

        else

          if a.age=b.age

            then

              L:=(a.height<b.height);

      Greater:=L

    end;

 

begin

  TextBackGround(1);  TextColor(14);  ClrScr;

  Assign(f,'c:/bas.in');  reset(f);

  readln(f,k); {Количество человек в группе}

  for i:=1 to k do

    begin

      readln(f,h); j:=1; hh:='';

      while h[j]<>' ' do inc(j);

      for p:=1 to j-1 do hh:=hh+h[p];

      x[i].Surname:=hh; jj:=j+1;

      while h[jj]<>' ' do inc(jj);

      hh:='';

      for p:=j+1 to jj-1 do hh:=hh+h[p];

      x[i].Name:=hh; j:=jj+1;

      while h[j]<>' ' do inc(j);

      hh:='';

      for p:=jj+1 to j-1 do hh:=hh+h[p];

      val(hh,s,code); x[i].age:=s; hh:='';

      for p:=j+1 to length(h) do hh:=hh+h[p];

      val(hh,s,code); x[i].Height:=s;

    end;

  close(f);

  {Данные прочитаны и занесены в память}

  {i - номер просматриваемого спортсмена

   j - номер принимаемого спортсмена}

  i:=1; j:=1;

  while i<=k do

    begin

      {Проверяем i спортсмена}

      if (x[i].age>13)and(x[i].Height>164)

        then

          begin

            y[j]:=x[i]; inc(j)

          end;

      inc(i)

    end;

  kk:=j-1; {Количество принятых}

  repeat

    L:=True;

    for i:=1 to kk-1 do

      if Greater(y[i],y[i+1])

        then

          begin

            c:=y[i]; y[i]:=y[i+1]; y[i+1]:=c; L:=False;

          end;

  until L;

  assign(g,'c:/bas.out'); rewrite(g);

  for i:=1 to kk do

    begin

      write(y[i].Surname+' '); write(y[i].Name+' ');

      write(y[i].age:3); writeln(y[i].height:4);

      write(g,y[i].Surname+' '); write(g,y[i].Name+' ');

      write(g,y[i].age:3); writeln(g,y[i].height:4);

    end;

  close(g);

  repeat until keypressed;

end.

 

 

Сайт создан в системе uCoz