Помощь - Поиск - Пользователи - Календарь
Полная версия: Помогите плз решить задачу на множество
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
kpaqp4er
Доброго времени суток всем...
Честно скажу - с програмированием не сложилось еще с начала обучения... Но сессию сдавать надо. Поэтому очень прошу помочь !help.gif

Вот такое условие:

Цитата
Даны два множества точек на плоскости. Из первого множества выбрать три различные точки так, чтобы треугольник с вершинами в этих точках содержал(строго внутри себя) равное количество точек первого и второго множеств.


Путем поиска в интернете было найдено следуещее решение:

uses Crt;
 
type point = record
     x, y : integer;
     end;
 
const MaxArraySize = 10; {Max. array points}
 
var
 ar1, ar2 : array [1..MaxArraySize] of point;
 ar1size, ar2size : integer; {inputed array sizes}
 i, j, k, g, n1, n2 : integer;
 F : Text;
 
{---------------------------------------------------}
procedure ExitProg;
begin
    Writeln('Input error');
    ReadKey;
    Halt;
end;
 
{---------------------------------------------------}
{Fill array by hand, return number of entered points}
{---------------------------------------------------}
function FromKeyb(var mas:array of point; max:integer):integer;
var i,n : integer;
begin
     Writeln('Enter points number (3<x<', max, ')');
     Readln(n);
     if (n < 3) then
     begin
          Writeln('Minimum 3 points need!.');
          ExitProg;
     end;
     if (n > max) then
     begin
          Writeln('Too many points!.');
          ExitProg;
     end;
 
     for i := 0 to n-1 do
     begin
         Write('point #', i+1, ' ');
         Readln(mas[i].x, mas[i].y);
     end;
     FromKeyb := n; {return entered points number}
end;
 
{-----------------------------------------------------}
{Fill array from file, return number of entered points}
{-----------------------------------------------------}
function FromFile(var mas:array of point; fname:string; max:integer):integer;
var i : integer;
    F : text;
 begin
      Assign(F, fname);
      Reset(F);
      {read points}
      i := 0;
      while ((not Eof(F)) and (i < max)) do
      begin
           Readln(F, mas[i].x, mas[i].y);
           i := i+1;
      end;
      Close(F);
 
      if (i < 3) then
      begin
           Writeln('File: ', fname, ' Minimum 3 points need!.');
           ExitProg;
      end;
      Writeln('File: ', fname, ' Readed ', i, ' points.');
      FromFile := i; {return entered points number}
 end;
 
{---------------------------------}
{Is the point strongly in triangle}
{---------------------------------}
function InTriangle(a,b,c,p:point):boolean;
  function pr(t1,t2:point):boolean;
  begin
       pr:=((p.x-t1.x)*(t2.y-t1.y))>((t2.x-t1.x)*(p.y-t1.y));
  end;
begin
     if (pr(a,b)=pr(b,c)) and (pr(a,b)=pr(c,a))
     then
     begin
          if ((a.x=p.x) or (b.x=p.x) or (c.x=p.x)) and
             ((a.y=p.y) or (b.y=p.y) or (c.y=p.y))
          then InTriangle := False
          else InTriangle := True
     end
     else InTriangle := False;
end;
 
begin
 ClrScr;
 Writeln('Input no more ', MaxArraySize, ' points from:');
 Writeln('(1) keyboard');
 Writeln('(2) files in1.txt and in2.txt');
 
 case ReadKey of
 '1': begin
           ClrScr;
           Writeln('Input (x y) coordinats pair for 1st array.');
           ar1size := FromKeyb(ar1, MaxArraySize);
           Writeln('Input (x y) coordinats pair for 2nd array.');
           ar2size := FromKeyb(ar2, MaxArraySize);
      end;
 '2': begin
           ClrScr;
           ar1size := FromFile(ar1, 'c:\in1.txt', MaxArraySize);
           ar2size := FromFile(ar2, 'c:\in2.txt', MaxArraySize);
      end;
 else
    ExitProg;
 end;
 
 Assign(F, 'c:\out.txt');
 Rewrite(F);
 for i:=1 to ar1size do
     for j:=i+1 to ar1size do
         for k:=j+1 to ar1size do
         begin
             n1:=0; n2:=0;
             for g:=1 to ar1size do {points in triangle from array1}
             begin
                           {Write( '(',ar1[i].x,',',ar1[i].y,')',
                                   ' (',ar1[j].x,',',ar1[j].y,')',
                                   ' (',ar1[k].x,',',ar1[k].y,')',
                                   ' ',ar1[g].x,',',ar1[g].y);
                           if (InTriangle(ar1[i],ar1[j],ar1[k],ar1[g]) = True)
                           then Writeln('  true') else Writeln;}
 
                  if (InTriangle(ar1[i],ar1[j],ar1[k],ar1[g]) = True)
                  then n1:=n1+1;
             end;
             for g:=1 to ar2size do {points in triangle from array2}
             begin
                           {Write( '(',ar1[i].x,',',ar1[i].y,')',
                                   ' (',ar1[j].x,',',ar1[j].y,')',
                                   ' (',ar1[k].x,',',ar1[k].y,')',
                                   ' ',ar2[g].x,',',ar2[g].y);
                           if (InTriangle(ar1[i],ar1[j],ar1[k],ar2[g]) = True)
                           then Writeln('  true') else Writeln;}
 
                  if (InTriangle(ar1[i],ar1[j],ar1[k],ar2[g]) = True)
                  then n2:=n2+1;
             end;
             if ((n1=n2) and (n1<>0)) then
             begin
                  Writeln('Triangle: (',ar1[i].x,',',ar1[i].y,')',
                                   ' (',ar1[j].x,',',ar1[j].y,')',
                                   ' (',ar1[k].x,',',ar1[k].y,')');
                  Writeln(F,'Triangle: (',ar1[i].x,',',ar1[i].y,')',
                                   ' (',ar1[j].x,',',ar1[j].y,')',
                                   ' (',ar1[k].x,',',ar1[k].y,')');
                  Writeln(n1,' points strongly in triangle from both arrays.');
                  Writeln(F,n1,' points strongly in triangle from both arrays.');                  Close(F);
                  ReadKey;
                  Halt;
             end;
         end;
 Writeln('Solution not found');
 Writeln(F,'Solution not found');
 Close(F);
 ReadKey;
end.


Но, как мне кажется, это решение не соответствует условию... Вообщем разьясните, плз, если ошибаюсь или представьте свое решение. Буду очень признателен!
Lapp
Во-первых, прочти Правила и убери картинку (да еще и анимированную) из подписи.

Во-вторых, я мог бы сделать две вещи: либо помочь тебе исправить/доделать твое собственное решение, либо, если хочешь, сделать набросок своего. Чье-то постороннее решение, чтобы ты свалил свою курсовую, у меня нет ни малейшего желания даже смотреть. Либо разбирайся с ним сам, либо давай помогу сделать с нуля.
Вот так.
kpaqp4er
Цитата(Lapp @ 13.05.2009 23:01) *

Во-первых, прочти Правила и убери картинку (да еще и анимированную) из подписи.

Сорри за подпись, исправил.

Цитата(Lapp @ 13.05.2009 23:01) *

Во-вторых, я мог бы сделать две вещи: либо помочь тебе исправить/доделать твое собственное решение, либо, если хочешь, сделать набросок своего. Чье-то постороннее решение, чтобы ты свалил свою курсовую, у меня нет ни малейшего желания даже смотреть. Либо разбирайся с ним сам, либо давай помогу сделать с нуля.
Вот так.

Помощь "с нуля" меня вполне устроит, я бы даже сказал, что это более подходящий вариант. Я выложил найденное решение, чтобы оно возможно помогло (натолкнуло на мысль)...
Спасибо за оперативный ответ!
Lapp
Цитата(kpaqp4er @ 14.05.2009 0:24) *
выложил найденное решение, чтобы оно возможно помогло (натолкнуло на мысль)...
Этого добра пока хватает, слава Богу..

Цитата(kpaqp4er @ 13.05.2009 23:22) *
Даны два множества точек на плоскости. Из первого множества выбрать три различные точки так, чтобы треугольник с вершинами в этих точках содержал(строго внутри себя) равное количество точек первого и второго множеств.
Как заданы точки - в файле?

Вообще, условие не очень четкое. Например, я легко выбираю треугольник, который не содержит совсем точек - получается, что ноль тех и ноль этих - поровну! Может также быть случай, когда возможно сделать по одной точке и по две.. Так что хорошо бы это уточнить. Может, там еще есть условие типа максимальности? Можешь уточнить у препа или еще где-то?
kpaqp4er
Цитата(Lapp @ 13.05.2009 23:45) *


Как заданы точки - в файле?

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


Условие препод давал с книжицы, я ее скачал, если надо вот она Нажмите для просмотра прикрепленного файла А. В. Панюков, Т. А. Панюкова
"Практикум по программированию" Учебное пособие для студентов специальностей «Статистика» и «Математические методы в экономике»
Мое задание находится на 65й странице, 31й вариант.

Больше никаких условий не давал, но я думаю подойдут все варианты, кроме треугольника содержащего 0 точек.
Lapp
Цитата(kpaqp4er @ 14.05.2009 1:05) *
я думаю подойдут все варианты, кроме треугольника содержащего 0 точек.
Если эти два множества разнесены в пространстве, то никакого другого решения, кроме того нулевого, не будет совсем. Так что, если оно тебя не устраивает... sad.gif
kpaqp4er
Цитата(Lapp @ 14.05.2009 0:17) *

Если эти два множества разнесены в пространстве, то никакого другого решения, кроме того нулевого, не будет совсем. Так что, если оно тебя не устраивает... sad.gif

В этом случае согласен good.gif
Lapp
Цитата(kpaqp4er @ 14.05.2009 1:24) *
В этом случае согласен good.gif
Ок yes2.gif
А в остальных случаях тебя устраивает любое решение - так?

Ну, собственно, чего там писать-то.. Полный перебор тебя, надеюсь, устроит? Кстати, какой порядок количества точек?

Общая схема простейшая. Проходим по всем тройкам точек первого множества и считаем, сколько точек того и другого множества попало унутро. Я ничего не забыл?
kpaqp4er
Цитата(Lapp @ 14.05.2009 0:35) *

Ок yes2.gif
А в остальных случаях тебя устраивает любое решение - так?

Ну, собственно, чего там писать-то.. Полный перебор тебя, надеюсь, устроит? Кстати, какой порядок количества точек?

Общая схема простейшая. Проходим по всем тройкам точек первого множества и считаем, сколько точек того и другого множества попало унутро. Я ничего не забыл?

Если, чтото и забыл, то я уж точно не подскажу blink.gif Со всем согласен, так как сам до этого и не додумал бы smile.gif
Lapp
Извиняюсь, пришлось немного отвлечься..
Цитата(kpaqp4er @ 14.05.2009 1:54) *
Со всем согласен,
Ну и отлично. Вот тогда набросочек:
const
  m=100; {maximum set size}

type
  tCoord= integer;
  tPoint= record
    x,y: tCoord
  end;

function ASide(p1,p2,q1,q2: tPoint): boolean;
begin
  {
    checking if the line p1,p2 crosses the interval q1,q2
  }
end;

var
  a,b: array[1..m]of tPoint;
  i,j,k,n,Na,Nb,Ia,Ib: integer;

begin
  {
    data input here
  }
  for i:=1 to Na do
    for j:=1 to Na do if i<>j then
      for k:=1 to Na do if (k<>i)and(k<>j) then begin
        Ia:=0;
        Ib:=0;
        for n:=1 to Na do if (n<>i)and(n<>j)and(n<>k) then if (
          ASide(a[i],a[j],a[k],a[n]) and
          ASide(a[k],a[i],a[j],a[n]) and
          ASide(a[j],a[k],a[i],a[n])
        ) then Inc(Ia);
        for n:=1 to Nb do if (n<>i)and(n<>j)and(n<>k) then if (
          ASide(a[i],a[j],a[k],b[n]) and
          ASide(a[k],a[i],a[j],b[n]) and
          ASide(a[j],a[k],a[i],b[n])
        ) then Inc(Ib);
        if Ia=Ib then begin
          {
            results output here
          }
          Halt
        end
      end
end.

Посмотри его, что непонятно - спрашивай.
Логика типа готова, а завтра сделаем геометрию.
Lapp
крафчег, чего молчишь?
Без твоих твоих ответов, показывающих, что ты успеваешь разобраться, продолжения не жди.
kpaqp4er
Цитата(Lapp @ 14.05.2009 20:05) *

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

Спасибо за помощь. Сорри, что оперативно не ответил, учеба, домашние дела...
Так по програме понятно в общих чертах... Не совсем понятно как, что и как задавать в функции ASide. Как организовать проверку? Какое условие должно выполнятся?
Lapp
Цитата(kpaqp4er @ 14.05.2009 21:33) *
Не совсем понятно как, что и как задавать в функции ASide.
Это другой вопрос, рн впереди. Тебе понятна логика программы? Все циклы, условия.. Это очень важно. Это тот случай, когда ты можешь "сложить" то, что у тебя не сложилось раньше с программированием.

Цитата(kpaqp4er @ 14.05.2009 21:33) *
Как организовать проверку? Какое условие должно выполнятся?
Это ты про ASide? Ну, подумай, если хочешь. Я могу дать тебе время, не спойлить решение. Это все чистая геометрия. С привлечением графического изображения функций (линейных).


Добавлено через 2 мин.
Результатом функции ASide должен быть ответ на вопрос: лежат ли q1 и q2 по одну сторону от прямой, проходящей через p1 и p2.
kpaqp4er
Цитата(Lapp @ 14.05.2009 20:45) *

Это другой вопрос, рн впереди. Тебе понятна логика программы? Все циклы, условия.. Это очень важно. Это тот случай, когда ты можешь "сложить" то, что у тебя не сложилось раньше с программированием.

Это ты про ASide? Ну, подумай, если хочешь. Я могу дать тебе время, не спойлить решение. Это все чистая геометрия. С привлечением графического изображения функций (линейных).
Добавлено через 2 мин.
Результатом функции ASide должен быть ответ на вопрос: лежат ли q1 и q2 по одну сторону от прямой, проходящей через p1 и p2.

Что должно быть в результате я впринципе понял... структура програмы понятна в общих чертах, так как не все из синтаксиса в Паскале мне сейчас понятно, я бы хотел вернуться к этому вопросу чуть позже, если конечно потом сможешь уделить внимание...
Сейчас просто срочное задание, надо 1.gif wacko.gif Апачь и SQL запустить и набросать базу на завтра.
Я отпишу в теме с коментами по представленому тексту, как только с этим справлюсь, а ты уж как сможеш ответиш...
Спасибо за понимание !zdarov.gif
Lapp
Синтаксис Паскаля прост и естественен)).
Ты попробуй написать математические выражения для того, что должна делать ASide. Если у тя с математикой все ничего - должно получиться. Если нет - я помогу. Там единственная сложность - как обойти крайние случаи, когда прямые (p1,p2) параллельны осям.
Успехов.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.