% FIND THE DISTANCE BETWEEN TWO POINTS % function distance((x1,y1),(x2,y2)) = sqrt((x2-x1)^2 + (y2-y1)^2) $ % SIMILAR, BUT RETURNS A LARGE NUMBER IF THE TWO POINTS ARE THE SAME% function distancex((x1,y1),(x2,y2)) = let d = sqrt((x2-x1)^2 + (y2-y1)^2) in if zerop(d) then 1e100 else d $ % THIS IS AN N^2 ALGORITHM FOR FINDING CLOSEST PAIRS % function stupid_closest_pairs(a) = let i = {min_index({distancex(pt1,pt2) : pt2 in a}) : pt1 in a} in {pt1,pt2: pt1 in a; pt2 in a->i} $ function near_boundary(a,x0,d) = {k,((x1,x2),y) : ((x1,x2),y) in a ; k in [0:#a] | abs(x1-x0) < d} $ function new_nearest(a,b) = if #b == 0 then a else let bp = {pt1 : k,pt1,pt2 in b}; is = {min_index({distance(pt1,pt2): pt2 in bp}) : (k,pt1,pt2) in a}; na = {k,pt1,(if distance(pt1,pn) < distance(pt1,pt2) then pn else pt2) : (k,pt1,pt2) in a; pn in bp->is}; in na $ function merge_pairs(x0,a,b) = let d = max(max_val({distance(pt1,pt2): (pt1,pt2) in a}), max_val({distance(pt1,pt2): (pt1,pt2) in b})); an = near_boundary(a,x0,d); bn = near_boundary(b,x0,d); newa = a <- new_nearest(an,bn); newb = b <- new_nearest(bn,an); in newa ++ newb $ % THIS IS THE DIVIDE-AND-CONQUER SOLUTION FOR FINDING CLOSEST PAIRS. It use merge_pairs as a subroutine. % function closest_pairs(a) = % If the size of the problem is small, call the n^2 version % if #a < 5 then stupid_closest_pairs(a) else let % Find the x and y widths -- we want to cut the wider dimension % xd = max_val({x: (x,y) in a})-min_val({x: (x,y) in a}); yd = max_val({y: (x,y) in a})-min_val({y: (x,y) in a}); % If y is wider, then flip the dimensions -- will flip back later % a = if yd > xd then {(y,x) : (x,y) in a} else a; % Find the median along the wider dimension and split along it % mid = median({x: (x,y) in a}); spl = split(a,{x >= mid: (x,y) in a}); % Call closest_pairs recursively on the two halves % bar = {closest_pairs(x) : x in spl}; % Merge the results % a = merge_pairs(mid,bar[0],bar[1]); % Flip the dimensions back if they were flipped earlier % a = if yd > xd then ({(y1,x1),(y2,x2) : (x1,y1),(x2,y2) in a}) else a; in a $ % ********************* TEST ROUTINES ********************** % % THIS ROUTINE TESTS A SINGLE MERGE. % function closest_pairs_single_step(pts) = let % Generate the closest pairs for each half using the n^2 algorithm % mid = median({x: (x,y) in pts}); pairs1 = stupid_closest_pairs({(x,y) in pts | x < mid}); pairs2 = stupid_closest_pairs({(x,y) in pts | x >= mid}); % Merge results with your merge % merged = merge_pairs(mid,pairs1,pairs2); in merged,mid $ % THIS ROUTINE IS A HELPER FUNCTION FOR TEST_MERGE % function test_merge_rec(do_all,win,box1,box2,tbox) = let % Print hold on message % ignore = w_clear_box(tbox); ignore = w_write_text_centered("HOLD ON",w_white,tbox); % Generate the random points % n = 400; rand_points = {(float(rand(i)),float(rand(i))) : i in dist(10^6,n)}; % Generate the correct closest pairs using the n^2 algorithm % correct = stupid_closest_pairs(rand_points); % Generate your closest pairs This will either do a single step or the whole thing The single step routine also returns the location of the split line % yours,mid = if do_all then closest_pairs(rand_points),0. else closest_pairs_single_step(rand_points); % Draw the correct answer, and highlight anything that appears in correct answer but not your answer. % ignore = w_clear_box(box1); line = [((mid,0.),(mid,1e6))]; % the split line % ignore = if not(do_all) then w_draw_segments(line,1,w_black,box1) else f; ignore = w_draw_segments(correct,1,w_black,box1); ignore = w_draw_segments(set_difference(correct,yours),3,w_red,box1); % Draw your answer, and highlight anything that appears in your answer but not the correct answer. % ignore = w_clear_box(box2); ignore = if not(do_all) then w_draw_segments(line,1,w_black,box2) else f; ignore = w_draw_segments(yours,1,w_black,box2); ignore = w_draw_segments(set_difference(yours,correct),3,w_red,box2); passed = (#intersection(correct,yours) == #union(correct,yours)); answer = if passed then "PASSED -- GOOD JOB!!!" else "FAILED: highlighted lines appear in one but not the other"; ignore = w_clear_box(tbox); ignore = w_write_text_centered(answer,w_white,tbox); % Get input from the buttons % button_name = w_get_button_input(win); in if eql(button_name,"quit") then w_kill_window(win) else if eql(button_name,"all") then test_merge_rec(t,win,box1,box2,tbox) else test_merge_rec(f,win,box1,box2,tbox) $ % THIS FUNCTION IS A WINDOW BASED INTERFACE FOR TESTING YOUR MERGE ROUTINE It allows you to either test a single step of the merge, or the whole divide-and-conquer algorithm based on your merge. % function test_merge(ignore) = let % Generate the window % win = w_make_window(((50,0),(775,475)),"Closest Pairs",w_black,display); % generate the two boxes for displaying answers % bounding_box = ((0.,0.),(1e6,1e6)); win,box1 = w_add_box(((25,50),(350,350)),bounding_box,"mesh",w_white,win); ignore = w_add_text((150,20),"CORRECT ANSWER",w_white,win); win,box2 = w_add_box(((400,50),(350,350)),bounding_box,"mesh",w_white,win); ignore = w_add_text((535,20),"YOUR ANSWER",w_white,win); % add the three buttons % win = w_add_button(((25,420),(70,35)),"single step",w_white,win); win = w_add_button(((125,420),(70,35)),"all",w_white,win); win = w_add_button(((225,420),(70,35)),"quit",w_white,win); win,tbox = w_add_text_box(((325,420),(400,35)),"response",w_black,win); % Call the routine that actually does the testing % in test_merge_rec(f,win,box1,box2,tbox) $