Разбор и решение олимпиадных задач по информатике (Выпуск 1 2010г.)

Во всех задачах:
ограничение по времени:   1 сек
ограничение по памяти:   32  Мб
входной файл      Input.txt
выходной файл  Output.txt
Задача  1       Замечательные числа
Назовем целое число N замечательным, если для него справедливо равенство   (*)
   N²=(N – 1)² + M², где М – целое число. Даны два целых числа А и В. Найти количество замечательных
чисел из диапазона [A,B] включительно. Например, в диапазоне [1,10] таких чисел два, а именно
числа 1 и 5.
Входные  данные:            во  входном  файле  содержатся  два  целых  числа  А  и  В  (1<=A<=B<=109),
разделенных пробелом.
Выходные данные:     в выходной файл записать количество замечательных чисел из заданного
диапазона.
Пример:

Эта задача на сокращение перебора. Если просто пробежать отрезок от А до В, то мы не успеем по
времени. Значит надо сокращать перебор.
Упрощаем равенство (*), получим 2*N-1= M² . В левой части этого равенства находится нечетное
число, следовательно, М тоже нечетное и принадлежит отрезку от 1 до квадратного корня  из числа
2*N-1. Так как максимальное значение N равно В, то правая граница отрезка, содержащего М  
равна квадратному корню из числа 2*1000000000-1. Увеличим ее и возьмем равную квадратному
корню  из числа 2*1000000000. А это число меньше 50000 и можно перебирать.
program zad1;
var m,a,b,n:integer;
    kol:integer;
begin
 reset(input,’input.txt’); rewrite(output,’output.txt’);
  read(a,b);
  kol:=0;
  for m:=1 to trunc(sqrt(2000000000)) do                          перебираем  М
   if m mod 2 = 1 then                                                         если М нечетное
    begin
     n:=(m*m+1) div 2;                                                        вычисляем N
     if (n>=a)and(n<=b) then inc(kol);                                и проверяем принадлежность N отрезку
    end;
  writeln(kol);
 close(input); close(output);
end.
nd.
Задача  2        Симметричные последовательности  
Последовательность чисел назовем симметричной, если она одинаково читается как
слева направо, так и справа налево. Например, следующие последовательности являются
симметричными:
1 2 3 4 5 4 3 2 1
1 2 1 2 2 1 2 1
Вашей программе будет дана последовательность чисел. Требуется определить, какое
минимальное количество и каких чисел надо приписать в конец этой последовательности, чтобы
она стала симметричной.
Входные данные:     в первой строке содержится   число N - количество элементов исходной
последовательности. Во второй строке записано N чисел, разделенных пробелом - элементы этой
последовательности. 1 ≤ N ≤ 100, элементы последовательности - натуральные числа от 1 до 9.
Выходные данные:      в первой строке число M - минимальное количество элементов, которое
надо дописать к последовательности,  во второй строке  M чисел, которые надо дописать к
последовательности.
Пример:

Это задача на  полный перебор вариантов. Алгоритм понятен из пояснений к программе.
program zad2;
var a,b:array[1..300]of integer;
    i,j,n,k:integer;
function check:boolean;    проверяет последовательность на симметричность
var i:integer;
begin
 result:=false;
 for i:=1 to n+k do
  if b[i]<>b[n+k-i+1] then exit;
 result:=true;
end;
begin
 assign(input,’input.txt’); reset(input);
 assign (output,’output.txt’); rewrite(output);
  read(n);        считываем массив
  for i:=1 to n do read(a[i]);
  for k:=0 to n do      перебираем все возможные добавления
   begin
    fillchar(b,sizeof(b),0);    очищаем массив b
    b:=a;         копируем массив а в массив b
    for i:=n+1 to n+k do      добавляем в массив b к чисел
     b[i]:=a[n+k-i+1];
    if check then        проверяем массив на симметричность
      begin
        writeln(k);        если получили симметричную последовательность, то
        for i:=n+1 to n+k do     выводим количество добавленных чисел и сами числа
         write(b[i],’ ‘);
        close(input); close(output);
        halt(0);        прерываем работу программы
      end;
   end;
 close(input); close(output);

end.
Задача 3    Вавилонская башня
При строительстве Вавилонской башни, как известно, Бог смешал все языки. В результате
оказалось, что каждый человек знает некоторое множество языков. Два человека могут передать
друг другу информацию, если существует язык, который они оба знают. Руководитель стройки
передает команды на известных ему языках. Те, кто эти команды получил, могут их передавать
дальше, переводя на известные им языки. Определить количество людей, до которых доходят
команды руководителя.
Входные данные:
Для удобства пронумеруем все языки числами от 1 до 50. Во входном файле Input.txt задано количество
людей N (1≤N≤100), а дальше идут описания того, какие языки знают эти люди. Для каждого человека
записано сначала число Mi (0≤Mi≤50), определяющее количество языков, известных i-ому человеку, а
затем перечисляются номера самих этих языков в возрастающем порядке (номера языков — числа
от 1 до 50). Считается, что руководитель строительства — это человек с номером 1.
Выходные данные:
В выходной файл вывести одно число — количество человек, до которых может «дойти» отданная
руководителем команда (включая самого руководителя).
Примеры:

Эта задача на графы. Решается поиском в глубину. Приводим два возможных решения задачи.
program zad3;
var a:array[1..200,1..200]of integer;
    u:array[1..200]of boolean;
    i,j,n,m,ans,k:integer;
procedure dfs(v:integer);    процедура обхода в глубину
var i0:integer;
begin
  if v>50 then
               begin
                 u[v]:=true;
                 inc(ans);
              end;
 for i0:=1 to 50+n do
  if (not u[i0])and(a[v,i0]=1) then dfs(i0);    
end;
begin
 reset(input,’input.txt’);
 rewrite(output,’output.txt’);
  read(n);
  fillchar(a,sizeof(a),0);
  for i:=1 to n do       перебираем людей
   begin
    read(m);        считываем количество языков, которые знает человек
    for j:=1 to m do      заполняем матрицу смежности
     begin
      read(k);        считываем номер языка
      a[k,50+i]:=1;
      a[50+i,k]:=1;
     end;
   end;
   fillchar(u,sizeof(u),false);
   ans:=0;
   dfs(51);        запускаем обход в глубину
   writeln(ans);
 close(input); close(output);
end.
Вот второе решение с использование множества.
program zad3;
Const InputFile=’Input.TxT’;
      OutputFile=’Output.TxT’;
      MaxN=100;
      MaxK=50;
Type Sset=Set Of 1..50;    тип - множество
Var A: Array[1..MaxN] Of Sset;    массив множеств языков, которые знают люди
    was: Array[1..MaxN] Of Boolean;  массив флагов (рассмотрен человек или нет)
55
    N: Integer;
    cnt: Integer;
 Procedure Init;
  Var i, j, sc, p: Integer;
   Begin
     FillChar(A, SizeOf(A), 0);    заполняем массивы нулями
     FillChar(was, SizeOf(was), 0);
     cnt:=0;
     Assign(Input, InputFile);
      Reset(Input);
       Read(N);
       For i:=1 To N Do Begin    перебираем людей
         Read(sc);        считываем количество языков, которые знает человек
          For j:=1 To sc Do Begin
             Read(p);
             Include(A[i], p);      добавляем язык  в множество
          End;
       End;
      Close(Input);
   End;
 Procedure Rec(Const p: Integer);  рекурсивная процедура обхода в глубину
  Var i: Integer;
   Begin
     If was[p] Then Exit;      если человек рассмотрен, то возвращаемся на один
шаг назад
     was[p]:=True; Inc(cnt);    отмечаем человека и считаем его
     For i:=1 To N Do      перебираем людей
     If A[i]*A[p]<>[] Then Rec(i);    если пересечение множеств пусто, т.е. i человек не
рассмотрен, то запускаем рекурсию от него
   End;
 Procedure Out;       процедура вывода результатов
  Begin
   Assign(Output, OutputFile);  Rewrite(Output);
   WriteLn(cnt);
    Close(Output);
  End;
begin Init;  Rec(1); Out; end.

Задача 4   Сумма к первых
Известный ламер  Вася Пупкин не смог найти сумму первых К цифр 2000- значного числа. А вы
сможете?
Входные данные: В первой строке  одно число К, во второй одно число, содержащее 2000 цифр.
Выходные данные : одно число - сумму первых К цифр данного числа.
Пример:

Это утешительная задача.
program zad4;
Var  n,i,j,k:longint;
         c:char;
Procedure closing;
begin
 close(input); close(output);
 halt(0);
end;
begin
 assign(input,’input.txt’); reset(input);
 assign(output,’output.txt’); rewrite(output);
 readln(k);            считываем количество цифр
 n:=0;
 for i:=1 to k do            считываем К символов
  begin
   read(c);
56
   n:=n+(ord(c)-ord(‘0’));        преобразуем символ в цифру
  end;
  write(n);            выводим результат
 closing;
end.
Задача 5   Площади островов  
Карта моря задана матрицей размера N*M, состоящей из квадратиков, в которых записаны  0 или
1. 0 –это вода,1-суша. Два квадратика с единицами  принадлежат одному острову, если они имеют
общую сторону. Найти количество островов и площадь каждого острова. Площади островов вывести
в порядке неубывания.
Входные данные:
в первой строке два целых числа N и M (1<=N,M<=100)- размеры матрицы:;
В  последующих  N  строках  карта  моря.  В  каждой  строке  M  нулей  и  единиц,    не  разделенных
пробелом.
Выходные данные:
В первой строке одно целое число – количество островов.
Во второй строке площади островов, выведенные в порядке неубывания.
Пример:

Алгоритм  решения  этой  задачи  следующий.  Просматривая  двумерный  массив  построчно,  найти
единицу, принадлежащую острову. Рекурсивно или двумя очередями найти площадь острова, при
этом потопив его. Повторять процесс поиска до тех пор пока есть острова. Найденные площади
островов  запоминаем  в  одномерном  массиве.    Когда  все  острова  будут  потоплены,  сортируем
массив площадей по неубыванию и выводим результат.
program zad5;
Var a:array[0..200,0..200] of longint;
    di:array[1..4] of integer=(-1,0,1,0);      массивы приращений индексов
    dj:array[1..4] of integer=( 0,1,0,-1);
    pl:array[1..100]of longint;        массив площадей островов
    log:boolean;
    n,m,i,j,k,s,i0,j0,kol:longint;
     c:char;
Procedure closing;
begin
 close(input); close(output); halt(0);
end;
Procedure qsort(l,r:integer);      процедура сортировки
var i,j,x,p:integer;
begin
 i:=l; j:=r;
 x:=pl[(l+r) div 2];
 repeat
  while(pl[i]
  while (x
  if(i<=j) then
  begin
   p:=pl[i]; pl[i]:=pl[j]; pl[j]:=p;
   inc(i); dec(j);
  end;
 until (i>j);
 if (l
 if (i
end;
procedure poisk(var i0,j0:integer);    процедура поиска острова
var i,j:integer;
 begin
  for i:=1 to n do
for j:=1 to m do
    if a[i,j]=1          если остров найден
    then
     begin
      i0:=i;          запоминаем индексы единицы
      j0:=j;
      log:=true;          отмечаем, что поиск успешен
      exit;           выходим
     end;
 end;
procedure top(i0,j0:integer);      рекурсивная процедура нахождения
var i,j,k:integer;         площади острова
begin
 a[i0,j0]:=0;          топим кусочек острова
 inc(s);            увеличиваем площадь на 1
  for k:=1 to 4 do        просматриваем четыре соседние клетки
   begin
     i:=i0+di[k];
     j:=j0+dj[k];
    if a[i,j]=1          если в клетке 1, то
     then  top(i,j);         запускаем рекурсию от этой клетки
   end;
end;
begin
 assign(input,’input.txt’);
 reset(input);
 assign(output,’output.txt’);
 rewrite(output);
 readln(n,m);          считываем размеры
 fillchar(a,sizeof(a),0);
 for i:=1 to n do
 begin
  for j:=1 to m do
  begin
    read(c);          считываем символ
    if c=’1’
     then a[i,j]:=1         и помещаем соответствующее значение в массив
     else a[i,j]:=0;
  end;
  readln;          переходим на новую строку
 end;
 repeat            повторяем до тех пор пока есть острова
  s:=0;
  log:=false;
  poisk(i0,j0);          ищем остров
  if log then          если нашли
  begin
    top(i0,j0);          находим его площадь
    inc(kol);          считаем остров
    pl[kol]:=s;          запоминаем площадь в массиве
  end;
 until not log;
 qsort(1,kol);          сортируем площади островов
 writeln(kol);          выводим результат
 for i:=1 to kol do
 write(pl[i],’ ‘);
 closing;
end.
Вот второе решение этой задачи с использованием двух очередей.
program zad5;
Const nmax=10;
      di:array[1..4]of integer=(0,1,0,-1);
      dj:array[1..4]of integer=(1,0,-1,0);
Var n,m,io,jo,i,j,kolnew,kolold,kol:integer;
    new,old:array[1..2,1..nmax] of integer;  новая и старая очереди
    a:array[0..nmax+1,0..nmax+1]of integer;  карта
    s:array[1..nmax*nmax div 2]of integer;  массив площадей островов
    log:boolean;          сигнал о том есть ли острова
procedure Init;
begin
 assign(input,’input.txt’);
 reset(input);
 readln(n,m);          считываем размеры
 fillchar(a,sizeof(a),0);
 for i:=1 to n do
  begin
   for j:=1 to m do
    begin
     read(c);          считываем символ
     if c=’1’
      then a[i,j]:=1         и помещаем соответствующее значение в массив
      else a[i,j]:=0;
    end;
    readln;          переходим на новую строку
  end;
end;
Procedure out;          вывод результатов
var i:integer;
begin
 assign(Output,’Output.txt’);
 Rewrite(Output);
  writeln(kol);          выводим количество и площади островов
 for i:=1 to kol do
  write(s[i],’ ‘);
 close(Output);
end;
procedure Poisk(var i0,j0:integer);     ищем остров
var i,j:integer;
begin
 for i:=1 to n do
  for j:=1 to m do
   if a[i,j]=1 then         если 1 найдена
    begin
     i0:=i;           запоминаем ее координаты
     j0:=j;
     log:=true;          сигнал о том, что остров найден
     exit;
    end;
end;
Procedure Solve;
var t:integer;
begin
   kol:=0;
 repeat            повторяем пока есть острова
  log:=false;
  Poisk(io,jo);
  if log then          если остров найден
   begin
    inc(kol);
    old[1,1]:=io;          помещаем координаты острова в старую очередь
    old[2,1]:=jo;
    kolold:=1;          количество элементов в старой очереди
    s[kol]:=1;          площадь острова под номером kol равна 1
    Repeat          пока есть элементы в новой очереди
повторяем
     fillchar(new,sizeof(new),0);      очищаем новую очередь
     kolnew:=0;            кол-во элементов в новой очереди равно 0
     for i :=1 to kolold do        бежим по старой очереди
      begin
a[old[1,i],old[2,i]]:=0;      топим кусочек острова
        for t:=1 to 4 do        просматриваем 4 соседние клетки
         if a[old[1,i]+di[t],old[2,i]+dj[t]]=1    если в соседней клетке 1, то
          then
           begin
            inc(kolnew);        кол-во элементов в новой очереди
увеличиваем на 1
            new[1,kolnew]:=old[1,i]+di[t];    заносим клетку с 1 в новую очередь
            new[2,kolnew]:=old[2,i]+dj[t];
            inc(s[kol]);        увеличиваем площадь острова на 1
            a[old[1,i]+di[t],old[2,i]+dj[t]]:=0;   топим кусочек острова
           end;
      end;
       old:=new;          новую очередь делаем старой
       kolold:=kolnew;
     Until kolnew=0;
    end
 until not log;
end;
procedure sort;         сортируем острова по неубыванию
площадей
var i,j,p:integer;
begin
 for i:=1 to kol-1 do
  for j:=i+1 to kol do
     if s[i]>s[j]
       then
        begin   p:=s[i];  s[i]:=s[j];  s[j]:=p;   end;
end;
begin  init;  solve; sort; out; end.
Задача 6   Олимпиада
Напишите программу, генерирующую по результатам отдельных соревнований итоговый рейтинг
всех стран. В первой строке входного файла содержатся целое число – количество соревнований N
(0<=50). Далее следует N строк, каждая строка имеет вид:
GGG SSS BBB
где GGG, SSS, BBB – это трехбуквенные коды стран (3 прописных латинских буквы), получивших
соответственно золотую, серебряную и бронзовую медали. Коды стран разделены одним пробелом.  
Например, строка ”RUS KOR USA” означает, что в данном виде спорта страна с кодом RUS – получила
золотую медаль, KOR – серебряную и USA – бронзовую. В результатах соревнований появляется не
более 50 различных кодов стран.
В выходной файл вывести итоговый рейтинг всех стран в формате:
CCC G S B
где CCC – это трехбуквенный код страны, G – число золотых медалей, завоеванных этой страной,
S – число серебряных, B – число бронзовых. Страны нужно выводить в порядке убывания числа
золотых медалей, при равенстве числа золотых – в порядке убывания числа серебряных медалей,
при  равенстве  числа  золотых  и  серебряных  –  в  порядке  убывания  числа  бронзовых  медалей,  а
если и их количество одинаково, то страны должны быть выведены в алфавитном порядке по их
трехбуквенному коду. Все данные разделены одним пробелом.
Пример:

Эта задача на технику программирования.
program zad6;
var res:array[1..3,1..100]of integer;
    ctr:array[1..100]of string;
    s,cur:string;
i,j,n,ind,kol:integer;
procedure swap(var a,b:integer);      обмен содержимым двух переменных
var p:integer;
begin
 p:=a; a:=b; b:=p;
end;
function find(s0:string):integer;       поиск страны в массиве
var i0:integer;
begin
 for i0:=1 to kol do
  if s0=ctr[i0] then begin
                      result:=i0;
                      exit;
                     end;
 result:=-1;
end;
begin
 assign(input,’input.txt’); reset(input);
 assign (output,’output.txt’); rewrite(output);
  readln(n);            считываем количество строк
  kol:=0;
  for i:=1 to n do           перебираем строки
   begin
    readln(s);            считываем очередную строку
    cur:=copy(s,1,3);          получаем название страны
    ind:=find(cur);          находим ее индекс в массиве
    if ind=-1 then           если такой страны нет
      begin inc(kol); ind:=kol; ctr[ind]:=cur; end;    считаем ее и добавляем в массив
    delete(s,1,4);           стираем 4 символа из строки s
    inc(res[1,ind]);          прибавляем одну золотую медаль
    
    cur:=copy(s,1,3);          получаем название следующей страны
    ind:=find(cur);
    if ind=-1 then
      begin inc(kol); ind:=kol; ctr[ind]:=cur; end;
    delete(s,1,4);
    inc(res[2,ind]);          прибавляем одну серебряную медаль
    cur:=copy(s,1,3);          получаем название следующей страны
    ind:=find(cur);
    if ind=-1 then
      begin inc(kol); ind:=kol; ctr[ind]:=cur; end;
     inc(res[3,ind]);          прибавляем одну бронзовую медаль
   end;
  for i:=1 to kol-1 do          сортируем, учитывая все требования задачи
   for j:=i+1 to kol do
    if (res[1,i]
       ((res[1,i]=res[1,j])and(res[2,i]
       ((res[1,i]=res[1,j])and(res[2,i]=res[2,j])and(res[3,i]
       ((res[1,i]=res[1,j])and(res[2,i]=res[2,j])and(res[3,i]=res[3,j])and(ctr[i]>ctr[j]))then
         begin
          swap(res[1,i],res[1,j]);
          swap(res[2,i],res[2,j]);
          swap(res[3,i],res[3,j]);
          s:=ctr[i];
          ctr[i]:=ctr[j];
          ctr[j]:=s;
         end;
   for i:=1 to kol do          выводим результат
    begin
     write(ctr[i],’ ‘,res[1,i],’ ‘,res[2,i],’ ‘,res[3,i]);
     writeln;
    end;
 close(input); close(output);
end.
Задача 7   Индейские бои.
Давным-давно, когда компьютеров еще не было, на острове в океане жили два племени аборигенов
.  Жили  они  скучно  и  однообразно.  Единственным  развлечением  были  спортивные  игры  между
племенами. Судил игры главный жрец по имени Рамбапутка. Одно из соревнований проводилось
следующим образом: два племени  выстраивались в две отдельные прямые шеренги. Затем жрец
Рамбапутка давал команду «Пуск 1» и аборигены первого племени начинали стрелять  в аборигенов
другого племени из плевательных трубочек.  Если в хотя бы одного аборигена из второго племени
попадает горошина аборигена из первого племени, то все второе племя считается  проигравшим.
Потом следовала команда «Пуск 2» и все повторялось снова.  Для упрощения будем представлять
шеренгу аборигенов отрезком. Если бы жрец Рамбапутка,  заранее разметив на земле положение
шеренг,  мог  вычислить  кратчайшее  расстояние  между  шеренгами  то,  зная  лучшие  результаты
племен,  заранее предсказал бы победителя, тем самым, укрепляя свой авторитет. Помогите жрецу
в деле укрепления авторитета.
Вам  необходимо  написать  программу,  которая  определит  кратчайшее  расстояние  между
шеренгами.
 Входные данные:
В первой строке входного файла  четыре целых числа x1, y1, x2, y2 (-10000≤xi, yi≤10000) записанные
через пробел – координаты начала и конца отрезка, который задает шеренгу первого племени. В
третьей строке идут координаты начала и конца отрезка x3, y3, x4, y4 (-10000≤xi, yi≤10000), который
представляет собой шеренгу второго племени.
Выходные данные:
В  выходной  файл  вывести  единственное  вещественное  число-  кратчайшее  расстояние  между
шеренгами с точностью до трех знаков после десятичной точки.
Пример:

Это геометрическая задача на нахождение расстояния между двумя отрезками. Искомым
расстоянием может быть или расстояние между концами отрезков или длина перпендикуляра,
опущенного из конца одного отрезка на второй отрезок.
Program zad7;
const eps=0.0005;
Var x1,y1,x2,y2,x3,y3,x4,y4,x0,y0: extended;
    rast,p,min,a2,b2,c2,a1,b1,c1,d,d1,d2: Extended;
Function Len(X1, Y1, X2, Y2: extended): Extended;  находит расстояние между двумя
              точками
Begin
  Len := Sqrt((X1 - X2)*(X1 - X2) + (Y1 - Y2)*(Y1 - Y2));
End;
procedure swap(var d,e:extended);       
begin
  p:=d;d:=e;e:=p;
end;
Begin
  Assign(Input, ‘input.txt’);  Assign(Output, ‘output.txt’);
  Reset(Input);  Rewrite(Output);
  min:=maxint;
  Read(x1,y1,x2,y2,x3,y3,x4,y4);
   a1:=y2-y1;            находим уравнение прямой, содержащей
первый
              отрезок
   b1:=x1-x2;
   c1:=y1*x2-x1*y2;
    a2:=-b1;            находим уравнение прямой, перпендикулярной  
              найденной прямой и проходящей через точку
(x3.y3)
   b2:=a1;
   c2:=-a2*x3-b2*y3;
   x0:=(b1*c2-c1*b2)/(a1*b2-a2*b1);      находим координаты точки пересечения этих
              прямых
   y0:=(a2*c1-a1*c2)/(a1*b2-a2*b1);
   d:=len(x1,y1,x2,y2);          находим длины отрезков
   d1:=len(x1,y1,x0,y0);
   d2:=len(x2,y2,x0,y0);
if abs(d-d1-d2)<=eps then begin      если точка пересечения прямых лежит на
              первом отрезке, то
    rast:=(abs(a1*x3+b1*y3+c1))/sqrt(a1*a1+b1*b1);  вычисляем расстояние от точки (x3,y3) до прямой
    if rast
    end;       
              расстояние от точки (x3y3) до концов первого  
              отрезка
   d1:=len(x1,y1,x3,y3);
   if d1   d2:=len(x2,y2,x3,y3);
   if d2    a2:=-b1;
   b2:=a1;
   c2:=-a2*x4-b2*y4;
   x0:=(b1*c2-c1*b2)/(a1*b2-a2*b1);
   y0:=(a2*c1-a1*c2)/(a1*b2-a2*b1);
   d:=len(x1,y1,x2,y2);
   d1:=len(x1,y1,x0,y0);
   d2:=len(x2,y2,x0,y0);
   if abs(d-d1-d2)<=eps then begin
      rast:=(abs(a1*x4+b1*y4+c1))/sqrt(a1*a1+b1*b1);
      if rast      end;
 расстояние от точки (x4y4) до концов первого отрезка
   d1:=len(x1,y1,x4,y4);
   if d1   d2:=len(x2,y2,x4,y4);
   if d2    swap(x1,x3);        меняем отрезки местами и делаем еще раз тоже самое
    swap(x2,x4);
    swap(y1,y3);
    swap(y2,y4);
   a1:=y2-y1;
   b1:=x1-x2;
   c1:=y1*x2-x1*y2;
   a2:=-b1;
   b2:=a1;
   c2:=-a2*x3-b2*y3;
   x0:=(b1*c2-c1*b2)/(a1*b2-a2*b1);
   y0:=(a2*c1-a1*c2)/(a1*b2-a2*b1);
   d:=len(x1,y1,x2,y2);
   d1:=len(x1,y1,x0,y0);
   d2:=len(x2,y2,x0,y0);
   if abs(d-d1-d2)<=eps then begin
    rast:=(abs(a1*x3+b1*y3+c1))/sqrt(a1*a1+b1*b1);
    if rast    end;
   d1:=len(x1,y1,x3,y3);
   if d1   d2:=len(x2,y2,x3,y3);
   if d2   a2:=-b1;
   b2:=a1;
   c2:=-a2*x4-b2*y4;
   x0:=(b1*c2-c1*b2)/(a1*b2-a2*b1);
   y0:=(a2*c1-a1*c2)/(a1*b2-a2*b1);
   d:=len(x1,y1,x2,y2);
   d1:=len(x1,y1,x0,y0);
   d2:=len(x2,y2,x0,y0);
   if abs(d-d1-d2)<=eps then begin
      rast:=(abs(a1*x4+b1*y4+c1))/sqrt(a1*a1+b1*b1);
      if rast      end;
   d1:=len(x1,y1,x4,y4);
   if d1   d2:=len(x2,y2,x4,y4);
   if d2   write(min:0:3);      выводим результат
  Close(Input);  Close(Output);
End.

Рябова А.А.
Заместитель заведующего Центра информационных технологий и дистанционного образования
ИРО РТ