⚠️ Warning: This is a draft ⚠️

This means it might contain formatting issues, incorrect code, conceptual problems, or other severe issues.

If you want to help to improve and eventually enable this page, please fork RosettaGit's repository and open a merge request on GitHub.

{{collection|Closest pair problem}}

{{works with|GNU Smalltalk}}

These class methods return a three elements array, where the first two items are the points, while the third is the distance between them (which having the two points, can be computed; but it was easier to keep it already computed in the third position of the array).

Object subclass: ClosestPair [
  ClosestPair class >> raiseInvalid: arg [
      SystemExceptions.InvalidArgument
        signalOn: arg
        reason: 'specify at least two points'
  ]

  ClosestPair class >> bruteForce: pointsList [ |dist from to points|
    (pointsList size < 2) ifTrue: [ ^ FloatD infinity ].
    points := pointsList asOrderedCollection.
    from := points at: 1. to := points at: 2.
    dist := from dist: to.
    [ points isEmpty ]
    whileFalse: [ |p0|
      p0 := points removeFirst.
      points do: [ :p |
        ((p0 dist: p) <= dist)
        ifTrue: [ from := p0. to := p. dist := p0 dist: p. ]
      ]
    ].
    ^ { from. to. from dist: to }
  ]

  ClosestPair class >> orderByX: points [
    ^ points asSortedCollection: [:a :b| (a x) < (b x) ]
  ]
  ClosestPair class >> orderByY: points [
    ^ points asSortedCollection: [:a :b| (a y) < (b y) ]
  ]

  ClosestPair class >> splitLeft: pointsList [
    ^ pointsList copyFrom: 1 to: ((pointsList size / 2) ceiling)
  ]
  ClosestPair class >> splitRight: pointsList [ |s|
    ^ pointsList copyFrom: (((pointsList size / 2) ceiling) + 1) to: (pointsList size).
  ]

  ClosestPair class >> minBetween: a and: b [
    (a at: 3) < (b at: 3)
      ifTrue: [ ^a ]
      ifFalse: [ ^b ]
  ]

  ClosestPair class >> recursiveDAndC: orderedByX and: orderedByY [
    |pR pL minL minR minDist middleVLine joiningStrip tDist nP yL yR|
    (orderedByX size <= 3)
      ifTrue: [ ^ self bruteForce: orderedByX ].

    pR := self splitRight: orderedByX.
    pL := self splitLeft: orderedByX.

    middleVLine := (pL last) x.

    yR := OrderedCollection new.
    yL := OrderedCollection new.

    orderedByY do: [ :e |
      (e x) <= middleVLine
      ifTrue: [ yL add: e ]
      ifFalse: [ yR add: e ]
    ].

    minR := self recursiveDAndC: pR and: yR.
    minL := self recursiveDAndC: pL and: yL.

    minDist := self minBetween: minR and: minL.

    joiningStrip := orderedByY
                      select: [ :p |
                                ((middleVLine - (p x)) abs) < (minDist at: 3) 
                              ].
                                 
    tDist := minDist.
    nP := joiningStrip size.

      1 to: (nP - 1) do: [ :i | |k|
        k := i + 1.
        [ (k <= nP) 
          & ( (((joiningStrip at: (k min: nP)) y) - ((joiningStrip at: i) y)) < (minDist at: 3) ) ]
        whileTrue: [ |d|
          d := (joiningStrip at: i) dist: (joiningStrip at: k).
          d < (tDist at: 3)
          ifTrue: [ tDist := { joiningStrip at: i. joiningStrip at: k. d } ].
          k := k + 1.
        ]
      ].

    ^ tDist
  ]

  ClosestPair class >> divideAndConquer: pointsList [
    ^ self recursiveDAndC: (self orderByX: pointsList)
           and: (self orderByY: pointsList)
  ]

].

'''Testing'''

|coll cp ran|

ran := Random seed: 1.

coll := (1 to: 10000 collect: [ :a |
          Point x: ((ran next)*20.0 - 10.0) y: ((ran next)*20.0 - 10.0) ]).

cp := ClosestPair bruteForce: coll.
((cp at: 3) asScaledDecimal: 7) displayNl.

"or"

cp := ClosestPair divideAndConquer: coll.
((cp at: 3) asScaledDecimal: 7) displayNl.

The brute-force approach with 10000 points, run with the time tool, gave

224.21user 1.31system 3:46.84elapsed 99%CPU

while the recursive divide&conquer algorithm gave

2.37user 0.01system 0:02.56elapsed 93%CPU

(Of course these results must be considered relative and taken ''cum grano salis''; time counts also the time taken to initialize the Smalltalk environment, and I've taken no special measures to avoid the system load falsifying the results)