Помощь - Поиск - Пользователи - Календарь
Полная версия: Графическая задача
Форум «Всё о Паскале» > Современный Паскаль и другие языки > Делфи
Tribunal
Задача такова:
Дан файл вещественных чисел,которые являются координатами точек.
Нужно найти такие 3 точки, что треугольник, построенный на этих точках
будет содержать максимальное количество точек множества.
Координаты этих трёх точек сохранить в файле, как результат
+нужна графическая иллюстрация к этой задаче.

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

Буду благодарна за помощь.
мисс_граффити
как узнать, принадлежит ли точка треугольнику - есть здесь:
http://algolist.manual.ru/olimp/geo_prb.php

а в целом....
перебором, наверное. для каждых 3 точек считать, сколько точек будет внутри этого треугольника. если больше, чем хранящееся в переменной max значение - запоминать точки.
надеюсь, проблем с чтением из файла и с записью в него нет?

иллюстрация... тут придется координаты округлять. или брать масштаб побольше, а потом все равно округлять - Паскаль при рисовании любит целочисленные.
Tribunal
а для того,чтобы координаты можно было редактировать(изменять,удалять),их лучше считать из файла в список?

и всё же мне не очень понятьно,как перебирать разные треуголники и при этом делать проверку на кол-во точек...(( может кто-нибудь помочь разобраться?...(
Malice
Где-то вот так:
max:=0; t1_max:=1; t2_max:=2;  t3_max:=3; 
for t1:=1 to n-2 do {точка 1}
for t2:=t1+1 to n-1 do {точка 2}
for t3:=t2+1 to n do begin {точка 3}
попал=0;
for x:=1 to n do begin {перебор всех точек}
if Принадлежит (x, t1,t2,t3) then inc (попал);
end;
if попал>max then begin max:=попал; t1_max:=t1; t2_max:=t2; t3_max:=t3; end;
end;


можно еще добавить проверку, чтоб x был не равен t1,t2,t3.
Tribunal
я решила считывать координаты из файла в список.
вот,что получилось,но появляется ошибка: invalid numeric input

type
t_ptr=^t_element;
t_element=
record
infx:real;
infy:real;
next:t_ptr;
end;

var
f:text;
x,y:real;
i,n,k:byte;
first,pos:t_ptr;
begin
assignfile(f,'position.txt');
readln(n);

reset(f);
repeat
new(first);
first^.next:=nil;
readln(f,x,y);
first^.infx:=x;
first^.infy:=y;
for i:=1 to n-1 do
begin
new(pos);
readln(f,x,y);
pos^.infx:=x;
pos^.infy:=y;
pos^.next:=nil;
pos^.next:=first;
first:=pos;
inc(k);
end;
until (eof(f)) or (k=n-1);
close(f);


в файле записаны вещ-ные числа таким образом:
40,5 8
26,4 5,099
Бродяжник
Если они записаны именно таким образом, то замените запятую на точку.

И потом, что значит вот это:
pos^.next:=nil;
pos^.next:=first;

Зачем присваивать nil, если это значение все равно будет тут же утеряно?
мисс_граффити
может, я не права, но... не логичнее ли работать с типизированным, а не тестовым файлом?
имхо, "файл вещественных чисел"(по условию) - не text, а file of real.
Tribunal
нет.я не написала в условии,
но сказано работать с текстовым файлом.
Tribunal
значит у меня получается вот какая штука:
есть файл координат, которые в свою очередь находятся в списке для обработки.
я хочу сделать так,чтобы можно было изменять координаты конкретной точки,то есть по ее номеру.
процедура,которая у меня получилась почему-то очищает файл...(
почему?подскажите,пожалуйста...

Код
var
   xe,ye:real;
   ne,k:byte;
begin
writeln('Введите x');read(xe);
writeln('Введите y');read(ye);
writeln('Введите n');read(ne);

assign(f,'position.txt');
rewrite(f);
if ne>kol then writeln('Такой координаты нет.Добавьте.')
else begin
pos:=first;
k:=1;
while (pos^.next<>nil) and (not eof(f))  do
if k=ne then begin
pos^.infx:=xe;
pos^.infy:=ye;
writeln(f,pos^.infx,pos^.infy);
end
else begin
inc(k);
pos:=pos^.next;
readln;
end;
end;
close(f);
volvo
Tribunal, все правильно... Только файл не "очищается", а НЕ создается... Смотри:
assign(f,'position.txt'); rewrite(f); { ты затерла файл новым, пустым... }

if ne>kol then writeln('Такой координаты нет.Добавьте.')
else begin
pos:=first;
k:=1;
while (pos^.next<>nil) and (not eof(f)) do { Все, дальше неважно...}
...

А неважно - потому, что там, где я поставил комментарий у тебя при первом же проходе УЖЕ достигнут конец файла (файл-то пустой), и ничего выполняться, естественно, не будет...
Tribunal
а как тогда мне изменить файл?
volvo
Что-то типа:
writeln('Введите x');read(xe);
writeln('Введите y');read(ye);
writeln('Введите n');read(ne);

assign(f, 'position.txt'); rewrite(f);

pos := first;
{ ищешь в СПИСКЕ точку с нужным номером }
while (pos <> nil) and (ne > 0) do begin
pos := pos^.next; dec(ne);
end;

{ если NE = 0, значит точка с заданным номером есть в списке }
if ne = 0 then begin
pos^.infx:=xe;
pos^.infy:=ye;
{ ... И теперь сохранять ВЕСЬ список в файл ... }
pos := first;
while pos <> nil do begin
writeln(f,pos^.infx,pos^.infy);
pos := pos^.next;
end;
close(f);
{ Сохранено ... }
end
else
writeln('Введенный номер точки больше, чем их общее количество.');


Набирал прямо здесь - могут проявиться глюки. Но идея у меня именно такая...
Tribunal
...эээ...проблема в том,что когда я записываю из файла
в список координаты,я записываю не весь файл,а задаваемое число координат...
поэтому при редактировании в файл записывается только та часть,которая была в списке.
можно ли сделать,чтобы редактировалась только часть файла,а остальное оставалось на месте?
и вообще целесообразно ли для этого использовать списки?
volvo
Нет... Для того, чтобы отредактировать текстовый файл, его надо редактировать полностью... Текстовый файл - файл с последовательным доступом...

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

if Принадлежит (x, t1,t2,t3) then inc (попал);
Malice
Цитата(Tribunal @ 17.05.2006 7:54) *
а что обозначает сие выражение?
if Принадлежит (x, t1,t2,t3) then inc (попал);


Это значит, что нужно определить эту функцию (название конечно не русское будет, я для примера написал), которая будет проверять вхождение точки х в треугольник t1,t2,t3. И если принадлежит - прибавить счетчик.
Tribunal
а,ну тогда ясно...
Tribunal
выкладываю то,что у меня получилось.
делала на Delphi...
если нужно,могу создать аналогичную тему в соответсвующем разделе.

очень большая просьба посмотреть то,что у меня получилось...
там есть ошибка плана компилирования в delphi и я не знаю,как ее исправить((
посмотрите,пожалуйста...
в архиве есть и файл для тестирования...
на мой взгляд,вроде всё логично...проверьте,пожалуйста...
исправьте или укажите на ошибку там,где считаете нужным....

буду очень благодарна за вашу помощь...

сдавать просто завтра((
volvo
Чтобы программа компилировалась, нужно добавить один End, ты его упустила...
procedure TForm1.N5Click(Sender: TObject);
var
popal,max,xp,x1,x2,x3,x1_max,x2_max,x3_max,i:byte;
begin
max:=0;
x1_max:=1; x2_max:=2; x3_max:=3;
for x1:=1 to kol-2 do
for x2:=x1+1 to kol-1 do
for x3:=x2+1 to kol do begin
popal:=0;
for xp:=1 to kol do
if posession(xp,x1,x2,x3)=true then inc(popal);

// Проверку на максимум надо бы делать ВНУТРИ циклов ...
if popal>max then begin
max:=popal;
x1_max:=x1; x2_max:=x2; x3_max:=x3;
end;
end;

// Начальное значение I присвой, и изменение добавь в конце цикла
while i<>kol do begin
if i=x1_max then begin
x1_res:=point[i].x;
y1_res:=point[i].y;
end;
if i=x2_max then begin
x2_res:=point[i].x;
y2_res:=point[i].y;
end;
if i=x3_max then begin
x3_res:=point[i].x;
y3_res:=point[i].y;
end;
end; // <--- Вот этого End-а не было у тебя ...
end;
Проверь, у меня нет кириллицы, а все переделывать на транслит неохота... Должно работать.
Tribunal
я тут кое-что еще исправила...
у меня возник вопрос.

дело в том,что нужный треугольник находится неправильно.
это видно по рисунку....или всё же мне кажется?
посмотрите,пожалуйста...


кстати,в смысле нет кириллицы?комментарии?или что?я могу переделать...
Tribunal
и еще у меня что-то не то с процедурой удаления
(ради которой я ,собственно,и сделала считывание из файла в список)

//ввод-правка-удаление
procedure TForm1.N7Click(Sender: TObject);
begin
Label3.Caption:='Введите номер точки';
edit.Visible:=false;
del.Visible:=true;
add.Visible:=false;
end;

procedure TForm1.delClick(Sender: TObject);
var
ne:byte;
t:t_ptr;
begin
ne:=strtoint(n_edit.Text);

pos := first;
{ищем в списке точку с нужным номером}
while (pos<>nil) and (ne>0) do
begin
dec(ne);
if ne=0 then begin
t:=pos^.next;
pos^.next:=t^.next;
dispose(t);
end
else pos := pos^.next;
end;
{сохраняем в файл}
if SaveDialog1.Execute then
assignfile(f,SaveDialog1.FileName);
rewrite(f);
pos := first;
while pos<>nil do
begin
writeln(f,pos^.infx:8:2,pos^.infy:8:2);
pos:=pos^.next;
end;
closefile(f);

end;
Tribunal
я понимаю,что я вас уже достала...(
но я очень надеюсь на вашу помощь...

вот еще проблема вылезла...
здесь я пытаюсь добавить еще один элемент...
но не получается...может лучше через список?

procedure TForm1.addClick(Sender: TObject);
var
i:byte;
xe,ye:real;
begin
xe:=strtofloat(x_edit.Text);
ye:=strtofloat(y_edit.Text);
inc(kol);
point[kol].x:=xe;
point[kol].y:=ye;

{сохраняем в файл}
if SaveDialog1.Execute then
assignfile(f,SaveDialog1.FileName);
rewrite(f);
i:=1;
while i<kol do
begin
writeln(f,point[i].x:8:2,point[i].y:8:2);
inc(i);
end;
closefile(f);
end;
Tribunal
вот текущий вариант моей программы
Tribunal
с удалением и изменением я разобралась.
только вот точки треугольника находятся явно неправильно.

что-то не то либо в процедуре поиска точек нужного координат:
var
popal,max,xp,x1,x2,x3,x1_max,x2_max,x3_max,i:byte;
begin
max:=0;
x1_max:=1;
x2_max:=2;
x3_max:=3;
for x1:=1 to kol-2 do {точка 1}
for x2:=x1+1 to kol-1 do {точка 2}
for x3:=x2+1 to kol do {точка 3}
begin
popal:=0;
for xp:=1 to kol do {перебор всех точек}
if posession(xp,x1,x2,x3)=true then inc(popal);
if popal>max then
begin
max:=popal;
x1_max:=x1;
x2_max:=x2;
x3_max:=x3;
end;
end;
i:=1;
while i<>kol do
begin
if i=x1_max then begin
x1_res:=point[i].x;
y1_res:=point[i].y;
end;
if i=x2_max then begin
x2_res:=point[i].x;
y2_res:=point[i].y;
end;
if i=x3_max then begin
x3_res:=point[i].x;
y3_res:=point[i].y;
end;
inc(i);
end;
end;


либо в проверке условия принадлежности точки треугольнику:

//принадлежность точки треугольнику
function posession(x,t1,t2,t3:byte):boolean;
begin
if square(line(t1,t2),line(t2,t3),line(t3,t1))=square(line(x,t1),line(t1,t2),line(t
2,x))+square(line(x,t2),line(t2,t3),line(t3,x))+square(line(x,t1),line(t1,t3),li
ne(t3,x))
then posession:=true
else posession:=false;
end;


помогите,пожалуйста...
Malice
Цитата(Tribunal @ 18.05.2006 5:32) *

помогите,пожалуйста...

У меня, к сожалению, делфи стоит 4.5, поэтому проверить не могу, но на вскидку:
Мне не нравится вот эта формула:
Код
if square(1)=square(2)+square(3)+square(4)
в функции posession.
Я не думаю, что после вычислений с типом real получится точное равенство, нужно сравнить с какой нибудь точностью.
т.е.
Код
if abs(square(1)-(square(2)+square(3)+square(4)))<0.001 then
Tribunal
спасибо большое,...я действительно упустила из виду,что числа вещественные...
теперь треугольник ищется верно...
Tribunal
ура)всё получилось...всем большое спасибо за помощь))
плюс ко всему этому я сделала масштабирование рисунка.
если нужно,могу выложить конечную версию программы.
Tribunal
в общем,вот оно...
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.