Показать сообщение отдельно
Старый 15.08.2015, 19:03   #2 (permalink)
Vladimir_S
Специалист
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
По умолчанию

Фу, ну и головоломка!
В общем, сотворил.
1. Работа только с файлами, без массивов (использовать и то, и другое - IMHO некультурно ).
2. В выходной файл заносятся значения площадей и туда же - итоговый результат.
3. Имена файлов и пути к ним можно, естественно, поменять.
4. Критерием расположения трёх точек на одной прямой является непревышение площадью треугольника заранее заданного малого числа (Eps). Если сгенерированная точка легла на одну прямую с двумя уже имеющимися, то такая точка не записывается и координаты генерируются заново.
Код:
uses CRT;

Const
 Eps=0.0001;

var
 x,y,x_1,y_1,x_2,y_2,x_3,y_3,
 x1mn,y1mn,x2mn,y2mn,x3mn,y3mn,
 x1mx,y1mx,x2mx,y2mx,x3mx,y3mx:integer;
 N,i,j,k,q:byte;
 s,mn,mx:real;
 f1,f2:Text;
 B:boolean;

function Pl(x1,y1,x2,y2,x3,y3:integer):real;
begin
 Pl:=abs((x1-x3)*(y2-y3)-(x2-x3)*(y1-y3))/2;
end;

Begin
 clrscr;
 randomize;
 repeat
  write('Number of points exceeding 3, N = ');
  readln(N);
 until N>2;
 assign(f1,'D:\inp.txt');
 repeat
  rewrite(f1);
  for i:=1 to 3 do
   begin
    x:=-100+random(201);
    y:=-100+random(201);
    writeln(f1,x:4,y:14);
   end;
  close(f1);
  reset(f1);
  readln(f1,x_1,y_1);
  readln(f1,x_2,y_2);
  readln(f1,x_3,y_3);
  s:=Pl(x_1,y_1,x_2,y_2,x_3,y_3);
  mx:=s;
  mn:=s;
 until s>Eps;
 close(f1);
 assign(f2,'D:\out.txt');
 rewrite(f2);
 writeln(f2,s:12:5);
 i:=3;
 repeat
  x_3:=-100+random(201);
  y_3:=-100+random(201);
  j:=0;
  repeat
   inc(j);
   reset(f1);
   for q:=1 to j-1 do readln(f1);
   readln(f1,x_1,y_1);
   k:=j;
   repeat
    inc(k);
    reset(f1);
    for q:=1 to k-1 do readln(f1);
    readln(f1,x_2,y_2);
    s:=Pl(x_1,y_1,x_2,y_2,x_3,y_3);
    B:=(s<Eps);
    writeln(f2,s:12:5);
    if Not(B) then
     begin
      if s<mn then
       begin
        x1mn:=x_1;
        y1mn:=y_1;
        x2mn:=y_2;
        y2mn:=y_2;
        x3mn:=x_3;
        y3mn:=y_3;
        mn:=s;
       end;
      if s>mx then
       begin
        x1mx:=x_1;
        y1mx:=y_1;
        x2mx:=y_2;
        y2mx:=y_2;
        x3mx:=x_3;
        y3mx:=y_3;
        mx:=s;
       end;
     end;
   until B or (k=i);
  until B or (j=i-1);
 if Not(B) then
  begin
   inc(i);
   close(f1);
   append(f1);
   writeln(f1,x_3:4,y_3:14);
   writeln(f2,s:12:5);
   close(f1);
  end;
 until i=N;
 writeln(f2);
 writeln(f2,'Minimal square triange:');
 writeln(f2,'(',x1mn:3,',',y1mn:3,')');
 writeln(f2,'(',x2mn:3,',',y2mn:3,')');
 writeln(f2,'(',x3mn:3,',',y3mn:3,')');
 writeln(f2,'Square = ',mn:0:2);
 writeln(f2);
 writeln(f2,'Maximal square triangle:');
 writeln(f2,'(',x1mx:3,',',y1mx:3,')');
 writeln(f2,'(',x2mx:3,',',y2mx:3,')');
 writeln(f2,'(',x3mx:3,',',y3mx:3,')');
 writeln(f2,'Square = ',mx:0:2);
 close(f2);
End.
Vladimir_S вне форума   Ответить с цитированием
Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070