Написала решение задачи найти все различные максимальные подмножества точек на плоскости, содержащие более двух точек.
Программа считывает данные из входного файла InL.txt макета
-----------------------------------------
N(число точек на считывание)
x (координата x заданной точки)
y (координата y заданной точки)
--------------------------------------------
Промежуточные вычисления записываюцца в файл PROTL.txt, выходной файл - OutL.txt
Проблема в следующем: при записи во входной файл большого количества значений программа выдает ошибку 105: file not open for output и устанавливает курсор в строке, выделенной подчеркиванием.
program linefinder;
uses crt;
type
A=array[1..100] of real;
var
lineExists : boolean;
l,lines: integer;
x,y,x1,x2,y1,y2:A; {для хранения координат пар точек,определяющих прямые }
f,w,h:text;
procedure Vvod (var l:integer; var x,y:A; var f,w:text);
var i:integer;
begin
writeln(w,'Kontrolniy vivod danix: ');
readln(f,l);
if (l>100) or (l<=0) then begin l:=100; write(w,'Chislo tochek nekorrektno');
end;
writeln(w,' ');
writeln(w,'Tochek schitano: ',l);
for i:=1 to l do
begin
read(f,x[i]);
write(w,x[i]:4:2,' ');
end;
readln(f);
writeln(w);
for i:=1 to l do
begin
read(f,y[i]);
write(w,y[i]:4:2,' ');
end;
writeln(w);
writeln(w);
end;
procedure RaschetLin (var Lines:integer; var x1,x2,y1,y2:A; x,y:A; var h:text);
var i,j,k:integer; lineExists:boolean;
begin
writeln(h,'Logi raschetov:');
lines:= 0; {количество прямых, содержащих три и более точки}
{перебираем все возможные пары точек и проверяем не существует ли точки,
лежащей на одной прямой с ними. если да - сохраняем координаты этой пары
и увеличиваем счетчик прямых (lines) на ед.}
for i:=1 to l do
begin
for j:=i+1 to l do
begin
{проверяем не принадлежит ли выбранная пара точек какой-либо уже
найденной прямой. если да - устанавливаем флаг lineExists в значение
"Истина" для того, чтобы исключить эту пару из дальнейшего рассмотрения}
lineExists:= false;
for k:=1 to lines do
begin
if ((y[i]-y1[k])*(x2[k]-x1[k])=(x[i]-x1[k])*(y2[k]-y1[k]))
and ((y[j]-y1[k])*(x2[k]-x1[k])=(x[j]-x1[k])*(y2[k]-y1[k])) then
begin
lineExists:=true;
break;
end;
end;
if not lineExists then
for k:=j+1 to l do begin
if ((y[k]-y[i])*(x[j]-x[i])=(x[k]-x[i])*(y[j]-y[i])) then
begin
inc(lines);
writeln(h); { <--- Здесь !!! }
writeln(h,'Liniy stalo: ',lines ,'. Zadayushie tochki:');
writeln(h,x[i]:4:2,' ',y[i]:4:2);
x1[lines]:=x[i];
x2[lines]:=x[j];
writeln(h,x[j]:4:2,' ',y[j]:4:2);
y1[lines]:=y[i];
y2[lines]:=y[j];
break;
end; {if}
end; {k}
end; {j}
end; {i}
end;
procedure Vivod (lines,l:integer; x,y,x1,x2,y1,y2:A; var w:text);
var i,j,k:integer;
begin
writeln('Naudeno Liniy: ',lines);
writeln;
writeln(' x y');
writeln;
writeln(w,'Naudeno Liniy: ',lines);
writeln(w);
writeln(w,' x y');
writeln(w);
for k:=1 to lines do
begin
writeln(' Line ',k);
writeln(w,' Line ',k);
for i:=1 to l do
if ((y[i]-y1[k])*(x2[k]-x1[k])=(y2[k]-y1[k])*(x[i]-x1[k])) then
begin
writeln(x[i]:5:2,' ',y[i]:5:2);
writeln(w,x[i]:5:2,' ',y[i]:5:2);
end;
writeln;
writeln(w);
end;
end;
begin
clrscr;
assign(f,'InL.txt');
assign(w,'OutL.txt');
rewrite(w);
assign(h,'Protl.txt');
rewrite(h);
reset(f);
Vvod(l,x,y,f,w);
RaschetLin(Lines,x1,x2,y1,y2,x,y,h);
vivod(lines,l,x,y,x1,x2,y1,y2,w);
close(f);
close(w);
close(h);
write(' Press any key for EXIT...');
readkey;
end.
Помогите, пожалуйста, установить в чем причина ошибки. При других входных данных работает нормально.
Заранее спасибо.
