Murmeln gruppieren

Angenommen man hat eine gelbe, zwei blaue, sieben grüne und neun rote Murmeln. Wie viele Zweiergruppen aus Murmeln mit unterschiedlicher Farbe kann man bilden?

Die 9 Zweiergruppen liefert die Prozedur marble-sets, wenn sie mit den Argumenten

(list
  (new color-count (quote rot) 9)
  (new color-count (quote gelb) 1)
  (new color-count (quote grün) 7)
  (new color-count (quote blau) 2))

und 2 aufgerufen wird. Die Zweiergruppen sind in diesem Fall

((grün rot) (grün rot) (grün rot)
 (grün rot) (grün rot) (blau rot)
 (grün rot) (gelb rot) (grün blau))

Die Prozedur marble-sets löst das Problem für einen beliebigen Vorrat an Murmeln und eine wählbare Gruppengröße.

Der Vorrat wird dabei durch eine Liste von Instanzen der Datenstruktur color-count beschrieben. Diese fasst eine Farbe und eine Anzahl zusammen.

(defstruct color-count
  (color count)
  (and (symbol? color) (integer? count) (> count 0)))

Die Prozedur take-one-marble liefert das Argument remaining zurück, wenn das Argument count den Wert 1 hat. Anderenfalls wird eine neue Instanz der Datenstruktur color-count erzeugt, mit der angegebenen Farbe und dem um 1 verminderten count.

(defproc take-one-marble (color count remaining)
  (cond
    ((< count 1)
      (throw (quote error) (concatenate "count for " color " is " count)))
    ((= count 1)
      remaining)
    (t
      (cons
        (new color-count color (- count 1))
        remaining))))

Die Prozedur take-marbles entnimmt aus den ersten size Elementen der Liste supply je eine Murmel. Diese wird der Liste marbles hinzugefügt. Die übrig gebliebenen Murmeln werden durch einen Aufruf von take-one-marble in die Liste remaining eingefügt. Sobald size den Wert 0 erreicht, liefert die Prozedur die entnommenen Murmeln und die verbleibenden Murmeln als Paar zurück.

(defproc take-marbles (supply size marbles remaining)
  (cond
    ((zero? size)
      (list marbles (append supply remaining)))
    ((null? supply)
      nil)
    (t
      (with-slots (color count) (first supply)
        (take-marbles
          (rest supply)
          (- size 1)
          (cons color marbles)
          (take-one-marble color count remaining))))))

Die Prozedur sort-bag sortiert die Murmeln so, dass die am häufigsten vorkommende Farbe am Anfang der Liste steht. Danach folgen die anderen Farben in absteigender Häufigkeit.

(defproc sort-bag (bag)
  (sort
    bag
    (lambda (c d) (> (. c count) (. d count)))))

Schließlich kombiniert die Prozedur marble-sets die anderen Prozeduren so, dass das oben beschriebene Problem gelöst wird.

(defproc marble-sets (supply size)
  (let
    ((taken (take-marbles (sort-bag supply) size nil nil)))
    (if
      (null? taken)
      nil
      (cons
        (first taken)
        (marble-sets (second taken) size)))))


Quelle
Sharon Curtis
"An Algorithm for Marble Mingling"
Department of Computing Science and Mathematics
University of Stirling Stirling, UK


marbles.sheet.xml