Pundori Kalan, 256-bit computing, Landmann & Eureka Sound

group-scheduling.rkt

@@ -1,39 +1,37 @@
-#lang racket
-
 (module group-scheduling racket
 
-(provide (all-defined-out))
+  (provide (all-defined-out))
   
-(require racklog
+  (require racklog
            control
            math)
   
-;;logics
+  ;;logics
-(define %has-met %empty-rel) ;; collection of meetings...
+  (define %has-met %empty-rel) ;; collection of meetings...
-(define %t0 %empty-rel)      ;; tentative collection...
+  (define %t0 %empty-rel)      ;; tentative collection...
 
-(define (meeting p1 p2)
+  (define (meeting p1 p2)
     (%assert! %has-met () ((p1 p2)))
     (%assert! %has-met () ((p2 p1))))
 
-;; various meetings...
+  ;; various meetings...
-;;   e.g. (combinations '(p1 p2 p3 p4 p5) 4)
+  ;;   e.g. (combinations '(p1 p2 p3 p4 p5) 4)
 
-(define (meeting-2 p1 p2)
+  (define (meeting-2 p1 p2)
     (meeting p1 p2))
   
-(define (meeting-3 p1 p2 p3)
+  (define (meeting-3 p1 p2 p3)
     (meeting p1 p2)
     (meeting p1 p3)
     (meeting p2 p3))
 
-(define (meeting-4 p1 p2 p3 p4)
+  (define (meeting-4 p1 p2 p3 p4)
     (meeting-3 p1 p2 p3)
     (meeting-3 p1 p2 p4)
     (meeting-3 p1 p3 p4)
     (meeting-3 p2 p3 p4))
 
-(define (meeting-5 p1 p2 p3 p4 p5)  
+  (define (meeting-5 p1 p2 p3 p4 p5)  
     (meeting-4 p1 p2 p3 p4)
     (meeting-4 p1 p2 p3 p5)
     (meeting-4 p1 p2 p4 p5)
@@ -41,25 +39,25 @@
     (meeting-4 p2 p3 p4 p5))
 
 
-;; assume everyone has "met" themselves
+  ;; assume everyone has "met" themselves
-(define (start-meetings group)
+  (define (start-meetings group)
     (map (lambda (x) (meeting x x)) group)
     (printf "starting with group: ~a~n~n" group))
 
-(define (reset-meetings group)
+  (define (reset-meetings group)
     (printf "resetting.~n")
     (set! %has-met %empty-rel)
     (start-meetings group))
 
 
-(define (have-they-met? x y)
+  (define (have-they-met? x y)
     (if (%which () (%has-met x y)) #t #f))
 
-(define (all-meetings x)
+  (define (all-meetings x)
     (%find-all (who) (%has-met x who)))
   
-;; make some pairs from a group
+  ;; make some pairs from a group
-(define (make-new-2 group)
+  (define (make-new-2 group)
     (cond
      ((empty? group) '())
      ((> 4 (length group)) (list group))
@@ -73,8 +71,8 @@
                          (make-new-2 (shuffle (remove* (list p1 p2) group)))))
             '())))))
 
-;; make some triples from a group
+  ;; make some triples from a group
-(define (make-new-3 group)
+  (define (make-new-3 group)
     (cond
      ((empty? group) '())
      ((> 4 (length group)) (list group))
@@ -91,8 +89,8 @@
                          (make-new-3 (shuffle (remove* (list p1 p2 p3) group)))))
             '())))))
 
-;; make some quads from a group
+  ;; make some quads from a group
-(define (make-new-4 group)
+  (define (make-new-4 group)
     (cond
      ((empty? group) '())
      ((> 4 (length group)) (list group))
@@ -114,8 +112,8 @@
             '())))))
 
 
-;; make some fivefiold from a group
+  ;; make some fivefiold from a group
-(define (make-new-5 group)
+  (define (make-new-5 group)
     (cond
      ((empty? group) '())
      ((> 5 (length group)) (list group))
@@ -142,19 +140,19 @@
             '())))))
 
 
-;; brute repetitor
+  ;; brute repetitor
-;;   keep trying until something "complete" is output
+  ;;   keep trying until something "complete" is output
-;;   determined by matching length as condition (TBC)
+  ;;   determined by matching length as condition (TBC)
 
-(define escape-counter 100)
+  (define escape-counter 100)
 
-(define (decrement-escape)
+  (define (decrement-escape)
     (set! escape-counter (- escape-counter 1)))
 
-(define (reset-escape)
+  (define (reset-escape)
     (set! escape-counter 100))
 
-(define (ensure-new-5 group)
+  (define (ensure-new-5 group)
     (decrement-escape)
     (if (eq? 0 escape-counter)
 	(begin
@@ -170,7 +168,7 @@
                   (ensure-new-5 group)))))))
 
 
-(define (ensure-new-4 group)
+  (define (ensure-new-4 group)
     (decrement-escape)
     (if (eq? 0 escape-counter)
 	(begin
@@ -185,16 +183,16 @@
                   (set! %has-met t0)
                   (ensure-new-4 group)))))))
 
-(define (check-group group)
+  (define (check-group group)
     (printf "group is ~s long. repeats? ~a~n~s~n"
             (length (flatten group))
             (check-duplicates (flatten group))
             (sort (flatten group) string<?)))
 
 
-;; etc etc+
+  ;; etc etc+
 
-(define (group-pairs l0)
+  (define (group-pairs l0)
     (let ((l (shuffle l0)))
       (when (> (remainder (length l) 2) 0)
 	(printf "there will be ~a leftover.\n" (remainder (length l) 2)))
@@ -202,7 +200,7 @@
           (if (= 1 (length l)) (cons l '())
               (cons (list (first l) (second l)) (group-pairs (list-tail l 2)))))))
 
-(define (group-threes l0)
+  (define (group-threes l0)
     (let ((l (shuffle l0)))
       (when (> (remainder (length l) 3) 0)
 	(printf "there will be ~a leftover.\n" (remainder (length l) 3)))
@@ -214,7 +212,7 @@
                     (group-threes (list-tail l 3)))))))
 
 
-(define (group-fours l0)
+  (define (group-fours l0)
     (let ((l (shuffle l0)))
       (when (> (remainder (length l) 4) 0)
 	(printf "there will be ~a leftover.\n" (remainder (length l) 4)))
@@ -228,7 +226,7 @@
 
 ;;; pairs
 
-(define (select-pairs-acc p1 p2 l)
+  (define (select-pairs-acc p1 p2 l)
     (if (empty? l) '()
 	(if (have-they-met? (list p1 p2))
             (select-pairs-acc p1 (car l) (remove p2 l))
@@ -237,7 +235,7 @@
               (meeting-2 p1 p2)
               (cons (list p1 p2) (select-pairs (remove* (list p1 p2) l)))))))
 
-(define (select-pairs l)
+  (define (select-pairs l)
     (if (< (length l) 1) '()
 	(let ((p1 (car l))
               (p2 (car (shuffle l))))
@@ -247,7 +245,7 @@
 
 ;;; triples
 
-(define (select-3fold-acc p1 p2 p3 l)
+  (define (select-3fold-acc p1 p2 p3 l)
     (if (empty? l) '()
 	(cond
          ((have-they-met? (list p1 p2))
@@ -262,7 +260,7 @@
                   (cons (list p1 p2 p3) (select-3fold (remove* (list p1 p2 p3) l))))))))
 
   
-(define (select-3fold l)
+  (define (select-3fold l)
     (if (< (length l) 1) '()
 	(let ((p1 (car l))
               (p2 (car (shuffle l)))   ;; maybe duplicate
@@ -272,7 +270,7 @@
 
 ;;; fours
 
-(define (select-4fold-acc p1 p2 p3 p4 l)
+  (define (select-4fold-acc p1 p2 p3 p4 l)
     (if (empty? l) '()
 	(cond
          ((have-they-met? (list p1 p2 p3 p4))
@@ -287,7 +285,7 @@
                   (cons (list p1 p2 p3 p4) (select-3fold (remove* (list p1 p2 p3) l))))))))
 
   
-(define (select-4fold l)
+  (define (select-4fold l)
     (if (< (length l) 1) '()
 	(let ((p1 (car l))
               (p2 (car (shuffle l)))   ;; maybe duplicate
@@ -297,23 +295,23 @@
           (select-4fold-acc p1 p2 p3 p4 l))))
 
 
-;; printing and/or output
+  ;; printing and/or output
 
-(define (print-combinations g n)
+  (define (print-combinations g n)
     (printf "There are ~a combinations of ~a. \n~a\n\n" 
             (binomial (length g) n)
             n
             (when (>= 120  (binomial (length g) n))
               (combinations g n))))
 
-(define (cross-chatter n r1 r2 r3) ;; n = group size, r = num of rounds (at n=2,3,4)
+  (define (cross-chatter n r1 r2 r3) ;; n = group size, r = num of rounds (at n=2,3,4)
     (let ((m0 (- n 1)))
       (printf "Each person needs to meet ~a other people, " m0)
       (if (<= m0 (+ r1 (* r2 2) (* r3 3)))
           (printf "which is possible.~n~n")
           (printf "which is impossible with this arrangement.~n~n"))))
 
-(define (print-test-rounds l n1 n2 n3)
+  (define (print-test-rounds l n1 n2 n3)
     (printf "There are ~a people (binomial ~a)\n" (length l) (binomial (length l) 2))
     (printf "in ~a rounds of 2, there can be ~s distinct groupings\n" n1 (* n1 (/ (length l) 2)))
     (printf "in ~a rounds of 3, there can be ~s distinct groupings\n" n2 (* n2 (/ (length l) 3)))
@@ -321,18 +319,18 @@
     (cross-chatter (length l) n1 n2 n3))
 
 
-(define (print-pairs l)
+  (define (print-pairs l)
     (printf "\nnext round, in pairs.\n")
     (for ((p0 (select-pairs l)))
       (printf "meeting: ~a and ~a\n" (car p0) (second p0))))
 
-(define (print-3fold l)
+  (define (print-3fold l)
     (printf "\nnext round, groups of 3.\n")
     (for ((p0 (select-3fold l)))
       (printf "meeting: ~a, ~a and ~a\n" (car p0) (second p0) (third p0))))
 
-;; print and/or ceate subgroups
+  ;; print and/or ceate subgroups
-(define (print-rounds-of-2 group n)
+  (define (print-rounds-of-2 group n)
     (dotimes (x n)
       (printf "next round [2:~a]~n" (+ x 1))
       (map (lambda (pair)
@@ -340,7 +338,7 @@
            (make-new-2 group))
       (printf "~n")))
 
-(define (print-rounds-of-3 group n)
+  (define (print-rounds-of-3 group n)
     (dotimes (x n)
       (printf "next round [3:~a]~n" (+ x 1))
       (for-each (lambda (g0)
@@ -351,7 +349,7 @@
                 (make-new-3 group))
       (printf "~n")))
 
-(define (print-rounds-of-4 group n)
+  (define (print-rounds-of-4 group n)
     (dotimes (x n)
       (printf "next round [4:~a]~n" (+ x 1))
       (for-each (lambda (g0)
@@ -365,7 +363,7 @@
       (printf "~n")))
 
 
-(define (print-all-meetings group)
+  (define (print-all-meetings group)
     (printf "Meetings so far:~n")
     (for-each (lambda (p0)
 		(printf "~a has met ~a~n"
@@ -374,4 +372,5 @@
               group)
     (printf "~n"))
 
-)
+  )
+