Задача такова: Дан файл вещественных чисел,которые являются координатами точек. Нужно найти такие 3 точки, что треугольник, построенный на этих точках будет содержать максимальное количество точек множества. Координаты этих трёх точек сохранить в файле, как результат +нужна графическая иллюстрация к этой задаче.
Предложите,пожалуйста,варианты решения этой задачи или какие-нибудь идеи. У меня они пока не могут оформиться...
а в целом.... перебором, наверное. для каждых 3 точек считать, сколько точек будет внутри этого треугольника. если больше, чем хранящееся в переменной max значение - запоминать точки. надеюсь, проблем с чтением из файла и с записью в него нет?
иллюстрация... тут придется координаты округлять. или брать масштаб побольше, а потом все равно округлять - Паскаль при рисовании любит целочисленные.
Tribunal
15.05.2006 13:28
а для того,чтобы координаты можно было редактировать(изменять,удалять),их лучше считать из файла в список?
и всё же мне не очень понятьно,как перебирать разные треуголники и при этом делать проверку на кол-во точек...(( может кто-нибудь помочь разобраться?...(
Malice
15.05.2006 13:53
Где-то вот так:
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
15.05.2006 15:17
я решила считывать координаты из файла в список. вот,что получилось,но появляется ошибка: 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
Бродяжник
15.05.2006 16:13
Если они записаны именно таким образом, то замените запятую на точку.
И потом, что значит вот это:
pos^.next:=nil; pos^.next:=first;
Зачем присваивать nil, если это значение все равно будет тут же утеряно?
мисс_граффити
15.05.2006 20:57
может, я не права, но... не логичнее ли работать с типизированным, а не тестовым файлом? имхо, "файл вещественных чисел"(по условию) - не text, а file of real.
Tribunal
16.05.2006 12:16
нет.я не написала в условии, но сказано работать с текстовым файлом.
Tribunal
16.05.2006 14:05
значит у меня получается вот какая штука: есть файл координат, которые в свою очередь находятся в списке для обработки. я хочу сделать так,чтобы можно было изменять координаты конкретной точки,то есть по ее номеру. процедура,которая у меня получилась почему-то очищает файл...( почему?подскажите,пожалуйста...
Код
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
16.05.2006 14:41
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 { Все, дальше неважно...} ...
А неважно - потому, что там, где я поставил комментарий у тебя при первом же проходе УЖЕ достигнут конец файла (файл-то пустой), и ничего выполняться, естественно, не будет...
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
16.05.2006 17:56
...эээ...проблема в том,что когда я записываю из файла в список координаты,я записываю не весь файл,а задаваемое число координат... поэтому при редактировании в файл записывается только та часть,которая была в списке. можно ли сделать,чтобы редактировалась только часть файла,а остальное оставалось на месте? и вообще целесообразно ли для этого использовать списки?
volvo
16.05.2006 18:22
Нет... Для того, чтобы отредактировать текстовый файл, его надо редактировать полностью... Текстовый файл - файл с последовательным доступом...
Ты не можешь изменить только середину файла, не трогая всего остального.
Tribunal
16.05.2006 19:04
а тогда можно ли в моем случае это сделать как-то иначе? может стоит остаток файла записывать в еще один список?
мисс_граффити
16.05.2006 21:46
а если все несколько упростить - предположить, что количество точек заранее известно. соответственно, работать не со списками, а с массивом... все, что идет после интересующего кол-ва точек - игнорировать.
Tribunal
17.05.2006 11:39
просто я решила работать со списками по той причине, что так вроде бы удобно редактировать,да и потом обращаться...
Tribunal
17.05.2006 11:54
а что обозначает сие выражение?
if Принадлежит (x, t1,t2,t3) then inc (попал);
Malice
17.05.2006 12:00
Цитата(Tribunal @ 17.05.2006 7:54)
а что обозначает сие выражение?
if Принадлежит (x, t1,t2,t3) then inc (попал);
Это значит, что нужно определить эту функцию (название конечно не русское будет, я для примера написал), которая будет проверять вхождение точки х в треугольник t1,t2,t3. И если принадлежит - прибавить счетчик.
Tribunal
17.05.2006 13:10
а,ну тогда ясно...
Tribunal
17.05.2006 16:04
выкладываю то,что у меня получилось. делала на Delphi... если нужно,могу создать аналогичную тему в соответсвующем разделе.
очень большая просьба посмотреть то,что у меня получилось... там есть ошибка плана компилирования в delphi и я не знаю,как ее исправить(( посмотрите,пожалуйста... в архиве есть и файл для тестирования... на мой взгляд,вроде всё логично...проверьте,пожалуйста... исправьте или укажите на ошибку там,где считаете нужным....
буду очень благодарна за вашу помощь...
сдавать просто завтра((
volvo
17.05.2006 16:34
Чтобы программа компилировалась, нужно добавить один 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
17.05.2006 18:18
я тут кое-что еще исправила... у меня возник вопрос.
дело в том,что нужный треугольник находится неправильно. это видно по рисунку....или всё же мне кажется? посмотрите,пожалуйста...
кстати,в смысле нет кириллицы?комментарии?или что?я могу переделать...
Tribunal
17.05.2006 18:43
и еще у меня что-то не то с процедурой удаления (ради которой я ,собственно,и сделала считывание из файла в список)
//ввод-правка-удаление 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
17.05.2006 19:02
я понимаю,что я вас уже достала...( но я очень надеюсь на вашу помощь...
вот еще проблема вылезла... здесь я пытаюсь добавить еще один элемент... но не получается...может лучше через список?
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
17.05.2006 20:33
вот текущий вариант моей программы
Tribunal
18.05.2006 9:32
с удалением и изменением я разобралась. только вот точки треугольника находятся явно неправильно.
что-то не то либо в процедуре поиска точек нужного координат:
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
18.05.2006 14:51
Цитата(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
19.05.2006 17:25
спасибо большое,...я действительно упустила из виду,что числа вещественные... теперь треугольник ищется верно...
Tribunal
19.05.2006 19:17
ура)всё получилось...всем большое спасибо за помощь)) плюс ко всему этому я сделала масштабирование рисунка. если нужно,могу выложить конечную версию программы.
Tribunal
19.05.2006 20:10
в общем,вот оно...
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.