?
Solved

Closest_pair_problem I'll vote 500 points for you

Posted on 2006-04-19
15
Medium Priority
?
302 Views
Last Modified: 2012-05-05
{i wrote this based on Sedgewick'Book.,i feel very difficult, i understood algorithms, but this program can't run. Please help me as soon as possible, My experts, my brother, I'll vote 500 points for you, all of you.. after i finish "divide and conquer", " i will write this with algorithm:"a plane sweep, and sorry for bothering you."}

{ because i'm 14 years old pupil, please explain clearly, especially, this program seems to be correct but it can't run.}

{and i'd like to know how to use time function in pascal to display time of algorithm, when i use a large set of points, thank you}




program closest_pair; { divide and conquer}
uses crt,dos,overlay;

type
point = record
x: real;
y: real;
        end;
link = ^node;
node = record
p: point;
next: link;
end;


var
keeptrack: link;              { i'll use it to keep track of my list}
list,head: link;                   {i'll use list to input a set of points}
first: link;
minresult: real;
closest1,closest2: point;          {current closest pair, they can be updated}
sortx: boolean;                 {sortx = false -> sort y}
n,v: integer;                   {n points}



function merge(list1,list2 :link) : link;  
var list12: link;
addlist :boolean;
begin
list12:= keeptrack ;   {it seems to be unlimited loop, really difficult or i have a wrong list that declares in the main program }
repeat
if sortx = true then addlist:= list1^.p.x < list2^.p.x
          else addlist:= list1^.p.y < list2^.p.y ;
          if addlist then   begin list12^.next := list1; list12:= list1; list1 := list1^.next end
                  else begin list12^.next := list2; list12:=list2; list2 := list2^.next end
until list12 = keeptrack;
merge := keeptrack^.next;
keeptrack^.next := keeptrack;
end;

procedure check(p1,p2: point);         { it's easy, i got it}
var distance : real;
begin
if (p1.y <> keeptrack^.p.y) and (p2.y<> keeptrack^.p.y) then
begin distance := sqrt((p1.x -p2.x)*(p1.x -p2.x) + (p1.y -p2.y)*(p1.y - p2.y));
if distance < minresult then
begin minresult:= distance;
      closest1:= p1;
      closest2:= p2;
end;
end;
end;

function sort(c: link; n: integer):link;
var a,b: link;
    i: integer;
    middle: real;
    p1,p2,p3,p4: point;
begin
if c^.next = keeptrack then sort:= c else
begin a := c;
      for i:= 2 to (n div 2) do c:= c^.next;
      b:= c^.next;
      c^.next := keeptrack;
if sortx = false then middle := b^.p.x;
c := merge(sort(a, n div 2), sort(b,n-(n div 2)));
sort := c;
if sortx = false then
begin
a:= c; p1:=keeptrack^.p; p2:=keeptrack^.p; p3:= keeptrack^.p; p4:= keeptrack^.p;
repeat
if abs(a^.p.x - middle) < minresult then
   begin check(a^.p,p1);
         check(a^.p,p2);
         check(a^.p,p3);
         check(a^.p,p4);
         p1:=p2; p2:=p3; p3:=p4; p4:=a^.p;
   end;
a:= a^.next;
until a=keeptrack ;
end;
end;
end;



begin            { please check this for me,do i have s mistakes}
new(keeptrack);
keeptrack^.next:=keeptrack;
keeptrack^.p.x:= maxint;
keeptrack^.p.y:= maxint;
writeln('how many points are there on the plane: ????');
readln(n);
list := nil;
for v:=1 to n do begin
new(first);
first^.p.x := random(1000);
first^.p.y := random(1000);
first^.next := list;
list := first;
                  end;

new(head); head^.next:= list;
minresult := maxint;
sortx:= true; head^.next:=sort(head^.next,n);
sortx:= false; head^.next:= sort(head^.next,n);




writeln(closest1.x);   { the problem is not important anymore}


readln;
end.




0
Comment
Question by:quacau
  • 9
  • 6
15 Comments
 
LVL 10

Accepted Solution

by:
For-Soft earned 1500 total points
ID: 16495705
The program is running, for me. All I had to do was reducing the length of one line, because I received "line too long" compiller error.

Here is the line:
list12:= keeptrack ;{it seems to be unlimited loop, really difficult or i have a wrong list that declares in the main program }

What version of Pascal compiller are you using? I used Borland Pascal 7.
What sort of error message are you receiving? Is it a compiller error, or run time error?
0
 

Author Comment

by:quacau
ID: 16497836
it's runtime error, beside, could you tell me how to use time function in pascal to display time of algorithm, when i use a large set of points, thank you
0
 

Author Comment

by:quacau
ID: 16498508
the program can't run correctly

writeln(closest1.x);    it can't display,....
please check it for me.. thank you


0
Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

 
LVL 10

Expert Comment

by:For-Soft
ID: 16498745
I'll check in an hour.

What run time error? I did not get any.
0
 
LVL 10

Expert Comment

by:For-Soft
ID: 16498783
You can remove CRT and DOS units. These libraries were not used in the code.
0
 

Author Comment

by:quacau
ID: 16505913
so could you make a file *.exe for me?
And i do want to know a function in pascal ( or a source code) to display time of algorithms,  please answer me as soon as possible. Thank you.
0
 
LVL 10

Expert Comment

by:For-Soft
ID: 16506017
Please explain: "to display time of algorithms"
Because, I do not understand it.

What Pascal compiler version are you using?

The program needs a lot of memory to work correctly and there are no safety routines for low memory situations. So, it is not safe to use large points on a plane amounts.
0
 

Author Comment

by:quacau
ID: 16514073


1. "to display time of algorithms" means :  for example in Visual basic, i have function " now" so i can use:

time1 = now{ in Vb}

sortx:= true; head^.next:=sort(head^.next,n);
sortx:= false; head^.next:= sort(head^.next,n);  { implement algorithm}

write( minresult); {found result}
time2 = now; {in Vb}

processed_time := time2 - time1; { second}


 
2. When i check, i use 3 points, 4 points, 7 points, 10 points, 50 points, ... I don't use a large set of point. Sure...

3. I use borland pascal 7, free pascal compiler, tubor pascal...all gives the same result,.....

4. If you said that my program is alright, I must say that It's wonderful for me, so please use this code and build a file for me. And send it here.
5. I have a little doubt, if my list in " head^.next:= list" is alright... do i have a good "list" above.

6. Here is some ebooks, http://www.ingenieriauai.com.ar/eBooks/

   and in chapter 28 of this book:  http://www.ingenieriauai.com.ar/eBooks/Algorithms%20-%20Robert%20Sedgewick.rar

please check it for me, you are an expert , I tried my best and i know my ability have a lot of restriction, Please help me as soon as possible. Thank you.



0
 
LVL 10

Expert Comment

by:For-Soft
ID: 16514215
So, you want to add the time difference between start and end of the algorithm.

There is a GetTime procedure in DOS unit. But it is much less convenient to use than the VB "now" function.

procedure GetTime(var Hour, Minute, Second, Sec100: Word);
0
 
LVL 10

Expert Comment

by:For-Soft
ID: 16514320
There is some error in the code.

There is a high possibility of the program going into an endless loop.

I think the problem is somewhere in the merge function.
0
 

Author Comment

by:quacau
ID: 16514348
but this merge function is based on Sedgewick' book as I give in the link,  you can use this:


function merge(a,b: link): link;
  var c: link; comp: boolean;
  begin
  c:=z;
  repeat
    if pass=1
      then comp:=a^.p.x<b^.p.x
      else comp:=a^.p.y<b^.p.y;
    if comp
      then begin c^.next:=a; c:=a; a:=a^.next end
      else begin c^.next:=b; c:=b; b:=b^.next end
  until c=z;
  merge:=z^.next; z^.next:=z;
  end;
 
procedure check(p1,p2: point);
  var dist: real;
  begin
  if (p1.y<>z^.p.y) and (p2.y<>z^.p.y) then
    begin
    dist:=sqrt((p1.x-p2.x)*(p1.x-p2.x)+(p1.y-p2.y)*(p1.y-p2.y));
    if dist<min then
      begin min:=dist; cp1:=p1; cp2:=p2 end;
    end;
  end;
 
function sort(c: link; N: integer): link;
  var a,b: link; i: integer;
      middle: real;
      p1,p2,p3,p4: point;
  begin
  if c^.next=z then sort:=c else
    begin
    a:=c;
    for i:= 2 to N div 2 do c:=c^.next;
    b:=c^.next; c^.next:=z;
    if pass=2 then middle:=b^.p.x;
    c:=merge(sort(a,N div 2),sort(b,N-(N div 2)));
    sort:=c;
    if pass=2 then
      begin
      a:=c; p1:=z^.p; p2:=z^.p; p3:=z^.p; p4:=z^.p;
      repeat
        if abs(a^.p.x-middle)<min then
          begin
          check(a^.p,p1);
          check(a^.p,p2);
          check(a^.p,p3);
          check(a^.p,p4);
          p1:=p2; p2:=p3; p3:=p4; p4:=a^.p
          end;
        a:=a^.next
      until a=z
      end
    end;
  end;
 
new(z); z^.next:=z;
z^.p.x:=maxint; z^.p.y:=maxint;
new(h); h^.next:=readlist;
min:=maxint;
pass:=1; h^.next:=sort(h^.next,N);
pass:=2; h^.next:=sort(h^.next,N);

 this code is in chapter 28 of Algorithm ...

It seems to be easy when i found this code, but i can't make program run..
Please help me.

0
 
LVL 10

Expert Comment

by:For-Soft
ID: 16514434
The code of the merge procedure is not designed to work correctly when "list1" or "list2" argument is equal to "nil". When this happens, the procedure can enter an endless loop.
0
 
LVL 10

Expert Comment

by:For-Soft
ID: 16514490
The "sort" function gets a "nil" value as c variable, as well.
0
 
LVL 10

Expert Comment

by:For-Soft
ID: 16514546
Well, I do not understand the algorithm you are using. But, many loops in the code are exited with keeptrack as the last list element.

Your code is different from the example code in the list generation part.
I think the keeptrack element should be on the end of the list. After changing the line from "list := nil;" to "list := keeptrack;" the program stopped doing stupid things.

I added the time function as well, but my computer is too fast to show any time used:

 var H,M,S,SS: Word;
     StartTime,EndTime: Real;

begin          { please check this for me,do i have s mistakes}
 new(keeptrack);
 keeptrack^.next:=keeptrack;
 keeptrack^.p.x:= maxint;
 keeptrack^.p.y:= maxint;
 writeln('how many points are there on the plane: ????');
 readln(n);
 GetTime (H,M,S,SS);
 StartTime:=(SS/100)+S+M*60+H*3600;
 list := keeptrack;
 for v:=1 to n do
  begin
   new(first);
   first^.p.x := random(1000);
   first^.p.y := random(1000);
   first^.next := list;
   list := first;
  end;

 new(head); head^.next:= list;
 minresult := maxint;
 sortx:= true;
 head^.next:=sort(head^.next,n);
 sortx:= false;
 head^.next:= sort(head^.next,n);



 writeln(closest1.x);   { the problem is not important anymore}
 GetTime (H,M,S,SS);
 EndTime:=(SS/100)+S+M*60+H*3600;
 WriteLn ('Time taken [s]: ',EndTime-StartTime :5 :2);


 readln;
end.

the DOS unit declaration is necesary, as well:

program closest_pair; { divide and conquer}
uses DOS,Overlay;
0
 

Author Comment

by:quacau
ID: 16518560
Thank you so much, this program is ok.
I'd like to say to all of you, For-sort is a real expert.
thanks again, For-sort.
0

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This shares a stored procedure to retrieve permissions for a given user on the current database or across all databases on a server.
Social messanging services like WhatsApp and Facebook can help businesses in ways that many owners don't even imagine, giving new opportunities to connect with customers. Discover some of the most innovative things they can do for your company.
This video shows how to quickly and easily deploy an email signature for all users in Office 365 and prevent it from being added to replies and forwards. (the resulting signature is applied on the server level in Exchange Online) The email signat…
This lesson discusses how to use a Mainform + Subforms in Microsoft Access to find and enter data for payments on orders. The sample data comes from a custom shop that builds and sells movable storage structures that are delivered to your property. …
Suggested Courses

850 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question