langs a-z

Task/Closest-pair-problem/OCaml/closest-pair-problem.ocaml

@@ -0,0 +1,122 @@
+type point = { x : float; y : float }
+
+
+let cmpPointX (a : point) (b : point) = compare a.x b.x
+let cmpPointY (a : point) (b : point) = compare a.y b.y
+
+
+let distSqrd (seg : (point * point) option) =
+  match seg with
+  | None -> max_float
+  | Some(line) ->
+    let a = fst line in
+    let b = snd line in
+
+    let dx = a.x -. b.x in
+    let dy = a.y -. b.y in
+
+    dx*.dx +. dy*.dy
+
+
+let dist seg =
+  sqrt (distSqrd seg)
+
+
+let shortest l1 l2 =
+  if distSqrd l1 < distSqrd l2 then
+    l1
+  else
+    l2
+
+
+let halve l =
+  let n = List.length l in
+  BatList.split_at (n/2) l
+
+
+let rec closestBoundY from maxY (ptsByY : point list) =
+  match ptsByY with
+  | [] -> None
+  | hd :: tl ->
+    if hd.y > maxY then
+      None
+    else
+      let toHd = Some(from, hd) in
+      let bestToRest = closestBoundY from maxY tl in
+      shortest toHd bestToRest
+
+
+let rec closestInRange ptsByY maxDy =
+  match ptsByY with
+  | [] -> None
+  | hd :: tl ->
+    let fromHd = closestBoundY hd (hd.y +. maxDy) tl in
+    let fromRest = closestInRange tl maxDy in
+    shortest fromHd fromRest
+
+
+let rec closestPairByX (ptsByX : point list) =
+   if List.length ptsByX < 2 then
+       None
+   else
+       let (left, right) = halve ptsByX in
+       let leftResult = closestPairByX left in
+       let rightResult = closestPairByX right in
+
+       let bestInHalf = shortest  leftResult rightResult in
+       let bestLength = dist bestInHalf in
+
+       let divideX = (List.hd right).x in
+       let inBand = List.filter(fun(p) -> abs_float(p.x -. divideX) < bestLength) ptsByX in
+
+       let byY = List.sort cmpPointY inBand in
+       let bestCross = closestInRange byY bestLength in
+       shortest bestInHalf bestCross
+
+
+let closestPair pts =
+  let ptsByX = List.sort cmpPointX pts in
+  closestPairByX ptsByX
+
+
+let parsePoint str =
+  let sep = Str.regexp_string "," in
+  let tokens = Str.split sep str in
+  let xStr = List.nth tokens 0 in
+  let yStr = List.nth tokens 1 in
+
+  let xVal = (float_of_string xStr) in
+  let yVal = (float_of_string yStr) in
+
+  { x = xVal; y = yVal }
+
+
+let loadPoints filename =
+  let ic = open_in filename in
+  let result = ref [] in
+  try
+    while true do
+      let s = input_line ic in
+      if s <> "" then
+        let p = parsePoint s in
+        result := p :: !result;
+    done;
+    !result
+  with End_of_file ->
+    close_in ic;
+    !result
+;;
+
+let loaded = (loadPoints "Points.txt") in
+let start = Sys.time() in
+let c = closestPair loaded in
+let taken = Sys.time() -. start in
+Printf.printf "Took %f [s]\n" taken;
+
+match c with
+| None -> Printf.printf "No closest pair\n"
+| Some(seg) ->
+  let a = fst seg in
+  let b = snd seg in
+
+  Printf.printf "(%f, %f) (%f, %f) Dist %f\n" a.x a.y b.x b.y (dist c)

Task/Closest-pair-problem/Oz/closest-pair-problem.oz

@@ -0,0 +1,99 @@
+declare
+  fun {Distance X1#Y1 X2#Y2}
+     {Sqrt {Pow X2-X1 2.0} + {Pow Y2-Y1 2.0}}
+  end
+
+  %% brute force
+  fun {BFClosestPair Points=P1|P2|_}
+     Ps = {List.toTuple unit Points} %% for efficient random access
+     N = {Width Ps}
+     MinDist = {NewCell {Distance P1 P2}}
+     MinPoints = {NewCell P1#P2}
+  in
+     for I in 1..N-1 do
+        for J in I+1..N do
+           IJDist = {Distance Ps.I Ps.J}
+        in
+           if IJDist < @MinDist then
+              MinDist := IJDist
+              MinPoints := Ps.I#Ps.J
+           end
+        end
+     end
+     @MinPoints
+  end
+
+  %% divide and conquer
+  fun {ClosestPair Points}
+     case {ClosestPair2
+           {Sort Points {LessThanBy X}}
+           {Sort Points {LessThanBy Y}}}
+     of Distance#Pair then
+        Pair
+     end
+  end
+
+  %% XP: points sorted by X, YP: sorted by Y
+  %% returns a pair Distance#Pair
+  fun {ClosestPair2 XP YP}
+     N = {Length XP} = {Length YP}
+  in
+     if N =< 3 then
+        P = {BFClosestPair XP}
+     in
+        {Distance P.1 P.2}#P
+     else
+        XL XR
+        {List.takeDrop XP (N div 2) ?XL ?XR}
+        XM = {Nth XP (N div 2)}.X
+        YL YR
+        {List.partition YP fun {$ P} P.X =< XM end ?YL ?YR}
+        DL#PairL = {ClosestPair2 XL YL}
+        DR#PairR = {ClosestPair2 XR YR}
+        DMin#PairMin = if DL < DR then DL#PairL else DR#PairR end
+        YSList = {Filter YP fun {$ P} {Abs XM-P.X} < DMin end}
+        YS = {List.toTuple unit YSList} %% for efficient random access
+        NS = {Width YS}
+        Closest = {NewCell DMin}
+        ClosestPair = {NewCell PairMin}
+     in
+        for I in 1..NS-1 do
+           for K in I+1..NS while:YS.K.Y - YS.I.Y < DMin do
+              DistKI = {Distance YS.K YS.I}
+           in
+              if DistKI < @Closest then
+                 Closest := DistKI
+                 ClosestPair := YS.K#YS.I
+              end
+           end
+        end
+        @Closest#@ClosestPair
+     end
+  end
+
+  %% To access components when points are represented as pairs
+  X = 1
+  Y = 2
+
+  %% returns a less-than predicate that accesses feature F
+  fun {LessThanBy F}
+     fun {$ A B}
+        A.F < B.F
+     end
+  end
+
+  fun {Random Min Max}
+     Min +
+     {Int.toFloat {OS.rand}} * (Max-Min)
+     / {Int.toFloat {OS.randLimits _}}
+  end
+
+  fun {RandomPoint}
+     {Random 0.0 100.0}#{Random 0.0 100.0}
+  end
+
+  Points = {MakeList 5}
+in
+  {ForAll Points RandomPoint}
+  {Show Points}
+  {Show {ClosestPair Points}}

Task/Closest-pair-problem/PARI-GP/closest-pair-problem.pari

@@ -0,0 +1,12 @@
+closestPair(v)={
+  my(r=norml2(v[1]-v[2]),at=[1,2]);
+  for(a=1,#v-1,
+    for(b=a+1,#v,
+      if(norml2(v[a]-v[b])<r,
+        at=[a,b];
+        r=norml2(v[a]-v[b])
+      )
+    )
+  );
+  [v[at[1]],v[at[2]]]
+};

Task/Closest-pair-problem/PL-I/closest-pair-problem.pli

@@ -0,0 +1,32 @@
+/* Closest Pair Problem */
+closest: procedure options (main);
+   declare n fixed binary;
+
+   get list (n);
+   begin;
+      declare 1 P(n),
+               2 x float,
+               2 y float;
+      declare (i, ii, j, jj) fixed binary;
+      declare (distance, min_distance initial (0) ) float;
+
+      get list (P);
+      min_distance = sqrt( (P.x(1) - P.x(2))**2 + (P.y(1) - P.y(2))**2 );
+      ii = 1;  jj = 2;
+      do i = 1 to n;
+         do j = 1 to n;
+            distance = sqrt( (P.x(i) - P.x(j))**2 + (P.y(i) - P.y(j))**2 );
+            if distance > 0 then
+             if distance < min_distance  then
+               do;
+                  min_distance = distance;
+                  ii = i; jj = j;
+               end;
+         end;
+      end;
+      put skip edit ('The minimum distance ', min_distance,
+                     ' is between the points [', P.x(ii),
+                     ',', P.y(ii), '] and [', P.x(jj), ',', P.y(jj), ']' )
+                     (a, f(6,2));
+   end;
+end closest;

Task/Closest-pair-problem/Perl-6/closest-pair-problem.pl6

@@ -0,0 +1,77 @@
+sub MAIN ($N = 5000) {
+    my @points = (^$N).map: { [rand * 20 - 10, rand * 20 - 10] }
+
+    my ($af, $bf, $df) = closest_pair(@points);
+    say "fast $df at [$af], [$bf]";
+
+    my ($as, $bs, $ds) = closest_pair_simple(@points);
+    say "slow $ds at [$as], [$bs]";
+}
+
+sub dist-squared($a,$b) {
+    ($a[0] - $b[0]) ** 2 +
+    ($a[1] - $b[1]) ** 2;
+}
+
+sub closest_pair_simple(@arr is copy) {
+    return Inf if @arr < 2;
+    my ($a, $b, $d) = @arr[0,1], dist-squared(|@arr[0,1]);
+    while  @arr {
+        my $p = pop @arr;
+        for @arr -> $l {
+            my $t = dist-squared($p, $l);
+            ($a, $b, $d) = $p, $l, $t if $t < $d;
+        }
+    }
+    return $a, $b, sqrt $d;
+}
+
+sub closest_pair(@r) {
+    my @ax = @r.sort: { .[0] }
+    my @ay = @r.sort: { .[1] }
+    return closest_pair_real(@ax, @ay);
+}
+
+sub closest_pair_real(@rx, @ry) {
+    return closest_pair_simple(@rx) if @rx <= 3;
+
+    my @xP = @rx;
+    my @yP = @ry;
+    my $N = @xP;
+
+    my $midx = ceiling($N/2)-1;
+
+    my @PL = @xP[0 .. $midx];
+    my @PR = @xP[$midx+1 ..^ $N];
+
+    my $xm = @xP[$midx][0];
+
+    my @yR;
+    my @yL;
+    push ($_[0] <= $xm ?? @yR !! @yL), $_ for @yP;
+
+    my ($al, $bl, $dL) = closest_pair_real(@PL, @yR);
+    my ($ar, $br, $dR) = closest_pair_real(@PR, @yL);
+
+    my ($m1, $m2, $dmin) = $dR < $dL
+                               ?? ($ar, $br, $dR)
+                               !! ($al, $bl, $dL);
+
+    my @yS = @yP.grep: { abs($xm - .[0]) < $dmin }
+
+    if @yS {
+        my ($w1, $w2, $closest) = $m1, $m2, $dmin;
+        for 0 ..^ @yS.end -> $i {
+            for $i+1 ..^ @yS -> $k {
+                last unless @yS[$k][1] - @yS[$i][1] < $dmin;
+                my $d = sqrt dist-squared(@yS[$k], @yS[$i]);
+                ($w1, $w2, $closest) = @yS[$k], @yS[$i], $d if $d < $closest;
+            }
+
+        }
+        return $w1, $w2, $closest;
+
+    } else {
+        return $m1, $m2, $dmin;
+    }
+}

Task/Closest-pair-problem/PureBasic/closest-pair-problem-1.purebasic

@@ -0,0 +1,19 @@
+Procedure.d bruteForceClosestPair(Array P.coordinate(1))
+  Protected N=ArraySize(P()), i, j
+  Protected mindistance.f=Infinity(), t.d
+  Shared a, b
+  If N<2
+    a=0: b=0
+  Else
+    For i=0 To N-1
+      For j=i+1 To N
+        t=Pow(Pow(P(i)\x-P(j)\x,2)+Pow(P(i)\y-P(j)\y,2),0.5)
+        If mindistance>t
+          mindistance=t
+          a=i: b=j
+        EndIf
+      Next
+    Next
+  EndIf
+  ProcedureReturn mindistance
+EndProcedure

Task/Closest-pair-problem/PureBasic/closest-pair-problem-2.purebasic

@@ -0,0 +1,29 @@
+Structure coordinate
+  x.d
+  y.d
+EndStructure
+
+Dim DataSet.coordinate(9)
+Define i, x.d, y.d, a, b
+
+;- Load data from datasection
+Restore DataPoints
+For i=0 To 9
+  Read.d x: Read.d y
+  DataSet(i)\x=x
+  DataSet(i)\y=y
+Next i
+
+If OpenConsole()
+  PrintN("Mindistance= "+StrD(bruteForceClosestPair(DataSet()),6))
+  PrintN("Point 1= "+StrD(DataSet(a)\x,6)+": "+StrD(DataSet(a)\y,6))
+  PrintN("Point 2= "+StrD(DataSet(b)\x,6)+": "+StrD(DataSet(b)\y,6))
+  Print(#CRLF$+"Press ENTER to quit"): Input()
+EndIf
+
+DataSection
+  DataPoints:
+  Data.d  0.654682, 0.925557, 0.409382, 0.619391, 0.891663, 0.888594
+  Data.d  0.716629, 0.996200, 0.477721, 0.946355, 0.925092, 0.818220
+  Data.d  0.624291, 0.142924, 0.211332, 0.221507, 0.293786, 0.691701, 0.839186,  0.72826
+EndDataSection

Task/Closest-pair-problem/Run-BASIC/closest-pair-problem.run

@@ -0,0 +1,41 @@
+n =10                              ' 10 data points input
+dim x(n)
+dim y(n)
+
+pt1 = 0                            ' 1st point
+pt2 = 0                            ' 2nd point
+
+for i =1 to n                      ' read in data
+    read x(i)						
+    read y(i)
+next i
+
+minDist  = 1000000
+
+for i =1 to n -1
+    for j =i +1 to n
+      distXsq =(x(i) -x(j))^2
+      disYsq  =(y(i) -y(j))^2
+      d       =abs((dxSq +disYsq)^0.5)
+      if d <minDist then
+        minDist =d
+        pt1     =i
+        pt2     =j
+      end if
+    next j
+next i
+
+print "Distance ="; minDist; " between ("; x(pt1); ", "; y(pt1); ") and ("; x(pt2); ", "; y(pt2); ")"
+
+end
+
+data  0.654682, 0.925557
+data  0.409382, 0.619391
+data  0.891663, 0.888594
+data  0.716629, 0.996200
+data  0.477721, 0.946355
+data  0.925092, 0.818220
+data  0.624291, 0.142924
+data  0.211332, 0.221507
+data  0.293786, 0.691701
+data  0.839186,  0.72826

Task/Closest-pair-problem/Seed7/closest-pair-problem.seed7

@@ -0,0 +1,33 @@
+const type: point is new struct
+    var float: x is 0.0;
+    var float: y is 0.0;
+  end struct;
+
+const func float: distance (in point: p1, in point: p2) is
+  return sqrt((p1.x-p2.x)**2+(p1.y-p2.y)**2);
+
+const func array point: closest_pair (in array point: points) is func
+  result
+    var array point: result is 0 times point.value;
+  local
+    var float: dist is 0.0;
+    var float: minDistance is Infinity;
+    var integer: i is 0;
+    var integer: j is 0;
+    var integer: savei is 0;
+    var integer: savej is 0;
+  begin
+    for i range 1 to pred(length(points)) do
+      for j range succ(i) to length(points) do
+        dist := distance(points[i], points[j]);
+        if dist < minDistance then
+          minDistance := dist;
+          savei := i;
+          savej := j;
+        end if;
+      end for;
+    end for;
+    if minDistance <> Infinity then
+      result := [] (points[savei], points[savej]);
+    end if;
+  end func;

Task/Closest-pair-problem/Ursala/closest-pair-problem-1.ursala

@@ -0,0 +1,3 @@
+#import flo
+
+clop = @iiK0 fleq$-&l+ *EZF ^\~& plus+ sqr~~+ minus~~bbI

Task/Closest-pair-problem/Ursala/closest-pair-problem-2.ursala

@@ -0,0 +1,8 @@
+#import std
+#import flo
+
+clop =
+
+^(fleq-<&l,fleq-<&r); @blrNCCS ~&lrbhthPX2X+ ~&a^& fleq$-&l+ leql/8?al\^(eudist,~&)*altK33htDSL -+
+   ^C/~&rr ^(eudist,~&)*tK33htDSL+ @rlrlPXPlX ~| fleq^\~&lr abs+ minus@llPrhPX,
+   ^/~&ar @farlK30K31XPGbrlrjX3J ^/~&arlhh @W lesser fleq@bl+-

Task/Closest-pair-problem/Ursala/closest-pair-problem-3.ursala

@@ -0,0 +1,23 @@
+test_data =
+
+<
+   (1.547290e+00,3.313053e+00),
+   (5.250805e-01,-7.300260e+00),
+   (7.062114e-02,1.220251e-02),
+   (-4.473024e+00,-5.393712e+00),
+   (-2.563714e+00,-3.595341e+00),
+   (-2.132372e+00,2.358850e+00),
+   (2.366238e+00,-9.678425e+00),
+   (-1.745694e+00,3.276434e+00),
+   (8.066843e+00,-9.101268e+00),
+   (-8.256901e+00,-8.717900e+00),
+   (7.397744e+00,-5.366434e+00),
+   (2.060291e-01,2.840891e+00),
+   (-6.935319e+00,-5.192438e+00),
+   (9.690418e+00,-9.175753e+00),
+   (3.448993e+00,2.119052e+00),
+   (-7.769218e+00,4.647406e-01)>
+
+#cast %eeWWA
+
+example = clop test_data

Task/Closest-pair-problem/XPL0/closest-pair-problem.xpl0

@@ -0,0 +1,37 @@
+include c:\cxpl\codes;          \intrinsic 'code' declarations
+
+proc ClosestPair(P, N);         \Show closest pair of points in array P
+real P; int N;
+real Dist2, MinDist2;
+int I, J, SI, SJ;
+[MinDist2:= 1e300;
+for I:= 0 to N-2 do
+    [for J:= I+1 to N-1 do
+        [Dist2:= sq(P(I,0)-P(J,0)) + sq(P(I,1)-P(J,1));
+        if Dist2 < MinDist2 then \squared distances are sufficient for compares
+            [MinDist2:= Dist2;
+            SI:= I;  SJ:= J;
+            ];
+        ];
+    ];
+IntOut(0, SI);  Text(0, " -- ");  IntOut(0, SJ);  CrLf(0);
+RlOut(0, P(SI,0));  Text(0, ",");  RlOut(0, P(SI,1));
+Text(0, " -- ");
+RlOut(0, P(SJ,0));  Text(0, ",");  RlOut(0, P(SJ,1));
+CrLf(0);
+];
+
+real Data;
+[Format(1, 6);
+Data:= [[0.654682, 0.925557],   \0 test data from BASIC examples
+        [0.409382, 0.619391],   \1
+        [0.891663, 0.888594],   \2
+        [0.716629, 0.996200],   \3
+        [0.477721, 0.946355],   \4
+        [0.925092, 0.818220],   \5
+        [0.624291, 0.142924],   \6
+        [0.211332, 0.221507],   \7
+        [0.293786, 0.691701],   \8
+        [0.839186, 0.728260]];  \9
+ClosestPair(Data, 10);
+]