Pundori Kalan, 256-bit computing, Landmann & Eureka Sound
This commit is contained in:
parent
1ca02681e5
commit
eca6832f5d
1 changed files with 264 additions and 265 deletions
|
|
@ -1,69 +1,67 @@
|
|||
#lang racket
|
||||
|
||||
(module group-scheduling racket
|
||||
|
||||
(provide (all-defined-out))
|
||||
|
||||
(provide (all-defined-out))
|
||||
(require racklog
|
||||
control
|
||||
math)
|
||||
|
||||
;;logics
|
||||
(define %has-met %empty-rel) ;; collection of meetings...
|
||||
(define %t0 %empty-rel) ;; tentative collection...
|
||||
|
||||
(require racklog
|
||||
control
|
||||
math)
|
||||
|
||||
;;logics
|
||||
(define %has-met %empty-rel) ;; collection of meetings...
|
||||
(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...
|
||||
;; e.g. (combinations '(p1 p2 p3 p4 p5) 4)
|
||||
;; various meetings...
|
||||
;; e.g. (combinations '(p1 p2 p3 p4 p5) 4)
|
||||
|
||||
(define (meeting-2 p1 p2)
|
||||
(meeting p1 p2))
|
||||
(define (meeting-2 p1 p2)
|
||||
(meeting p1 p2))
|
||||
|
||||
(define (meeting-3 p1 p2 p3)
|
||||
(meeting p1 p2)
|
||||
(meeting p1 p3)
|
||||
(meeting p2 p3))
|
||||
(define (meeting-3 p1 p2 p3)
|
||||
(meeting p1 p2)
|
||||
(meeting p1 p3)
|
||||
(meeting p2 p3))
|
||||
|
||||
(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-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)
|
||||
(meeting-4 p1 p2 p3 p4)
|
||||
(meeting-4 p1 p2 p3 p5)
|
||||
(meeting-4 p1 p2 p4 p5)
|
||||
(meeting-4 p1 p3 p4 p5)
|
||||
(meeting-4 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)
|
||||
(meeting-4 p1 p3 p4 p5)
|
||||
(meeting-4 p2 p3 p4 p5))
|
||||
|
||||
|
||||
;; assume everyone has "met" themselves
|
||||
(define (start-meetings group)
|
||||
(map (lambda (x) (meeting x x)) group)
|
||||
(printf "starting with group: ~a~n~n" group))
|
||||
;; assume everyone has "met" themselves
|
||||
(define (start-meetings group)
|
||||
(map (lambda (x) (meeting x x)) group)
|
||||
(printf "starting with group: ~a~n~n" group))
|
||||
|
||||
(define (reset-meetings group)
|
||||
(printf "resetting.~n")
|
||||
(set! %has-met %empty-rel)
|
||||
(start-meetings group))
|
||||
(define (reset-meetings group)
|
||||
(printf "resetting.~n")
|
||||
(set! %has-met %empty-rel)
|
||||
(start-meetings group))
|
||||
|
||||
|
||||
(define (have-they-met? x y)
|
||||
(if (%which () (%has-met x y)) #t #f))
|
||||
(define (have-they-met? x y)
|
||||
(if (%which () (%has-met x y)) #t #f))
|
||||
|
||||
(define (all-meetings x)
|
||||
(%find-all (who) (%has-met x who)))
|
||||
(define (all-meetings x)
|
||||
(%find-all (who) (%has-met x who)))
|
||||
|
||||
;; make some pairs from a group
|
||||
(define (make-new-2 group)
|
||||
(cond
|
||||
((empty? group) '())
|
||||
((> 4 (length group)) (list group))
|
||||
(else
|
||||
;; make some pairs from a group
|
||||
(define (make-new-2 group)
|
||||
(cond
|
||||
((empty? group) '())
|
||||
((> 4 (length group)) (list group))
|
||||
(else
|
||||
(let* ((p1 (car (shuffle group)))
|
||||
(p2 (findf (lambda (x)
|
||||
(not (have-they-met? p1 x))) (remove p1 group))))
|
||||
|
|
@ -73,36 +71,36 @@
|
|||
(make-new-2 (shuffle (remove* (list p1 p2) group)))))
|
||||
'())))))
|
||||
|
||||
;; make some triples from a group
|
||||
(define (make-new-3 group)
|
||||
(cond
|
||||
((empty? group) '())
|
||||
((> 4 (length group)) (list group))
|
||||
(else
|
||||
;; make some triples from a group
|
||||
(define (make-new-3 group)
|
||||
(cond
|
||||
((empty? group) '())
|
||||
((> 4 (length group)) (list group))
|
||||
(else
|
||||
(let* ((p1 (car (shuffle group)))
|
||||
(p2 (findf (lambda (x)
|
||||
(not (have-they-met? p1 x))) (remove p1 group)))
|
||||
(p3 (findf (lambda (x)
|
||||
(and (not (have-they-met? p1 x))
|
||||
(not (have-they-met? p2 x)))) (remove* (list p1 p2) group))))
|
||||
(and (not (have-they-met? p1 x))
|
||||
(not (have-they-met? p2 x)))) (remove* (list p1 p2) group))))
|
||||
(if (and p1 p2 p3)
|
||||
(begin (meeting-3 p1 p2 p3)
|
||||
(cons (list p1 p2 p3)
|
||||
(make-new-3 (shuffle (remove* (list p1 p2 p3) group)))))
|
||||
'())))))
|
||||
|
||||
;; make some quads from a group
|
||||
(define (make-new-4 group)
|
||||
(cond
|
||||
((empty? group) '())
|
||||
((> 4 (length group)) (list group))
|
||||
(else
|
||||
;; make some quads from a group
|
||||
(define (make-new-4 group)
|
||||
(cond
|
||||
((empty? group) '())
|
||||
((> 4 (length group)) (list group))
|
||||
(else
|
||||
(let* ((p1 (car (shuffle group)))
|
||||
(p2 (findf (lambda (x)
|
||||
(not (have-they-met? p1 x))) (remove p1 group)))
|
||||
(p3 (findf (lambda (x)
|
||||
(and (not (have-they-met? p1 x))
|
||||
(not (have-they-met? p2 x)))) (remove* (list p1 p2) group)))
|
||||
(and (not (have-they-met? p1 x))
|
||||
(not (have-they-met? p2 x)))) (remove* (list p1 p2) group)))
|
||||
(p4 (findf (lambda (x)
|
||||
(and (not (have-they-met? p1 x))
|
||||
(not (have-they-met? p2 x))
|
||||
|
|
@ -114,18 +112,18 @@
|
|||
'())))))
|
||||
|
||||
|
||||
;; make some fivefiold from a group
|
||||
(define (make-new-5 group)
|
||||
(cond
|
||||
((empty? group) '())
|
||||
((> 5 (length group)) (list group))
|
||||
(else
|
||||
;; make some fivefiold from a group
|
||||
(define (make-new-5 group)
|
||||
(cond
|
||||
((empty? group) '())
|
||||
((> 5 (length group)) (list group))
|
||||
(else
|
||||
(let* ((p1 (car (shuffle group)))
|
||||
(p2 (findf (lambda (x)
|
||||
(not (have-they-met? p1 x))) (remove p1 group)))
|
||||
(p3 (findf (lambda (x)
|
||||
(and (not (have-they-met? p1 x))
|
||||
(not (have-they-met? p2 x)))) (remove* (list p1 p2) group)))
|
||||
(and (not (have-they-met? p1 x))
|
||||
(not (have-they-met? p2 x)))) (remove* (list p1 p2) group)))
|
||||
(p4 (findf (lambda (x)
|
||||
(and (not (have-they-met? p1 x))
|
||||
(not (have-they-met? p2 x))
|
||||
|
|
@ -142,236 +140,237 @@
|
|||
'())))))
|
||||
|
||||
|
||||
;; brute repetitor
|
||||
;; keep trying until something "complete" is output
|
||||
;; determined by matching length as condition (TBC)
|
||||
;; brute repetitor
|
||||
;; keep trying until something "complete" is output
|
||||
;; determined by matching length as condition (TBC)
|
||||
|
||||
(define escape-counter 100)
|
||||
(define escape-counter 100)
|
||||
|
||||
(define (decrement-escape)
|
||||
(set! escape-counter (- escape-counter 1)))
|
||||
(define (decrement-escape)
|
||||
(set! escape-counter (- escape-counter 1)))
|
||||
|
||||
(define (reset-escape)
|
||||
(define (reset-escape)
|
||||
(set! escape-counter 100))
|
||||
|
||||
(define (ensure-new-5 group)
|
||||
(decrement-escape)
|
||||
(if (eq? 0 escape-counter)
|
||||
(begin
|
||||
(reset-escape)
|
||||
(printf "escaped from loopland...~n")
|
||||
'())
|
||||
(let ((t0 %has-met))
|
||||
(let ((c (make-new-5 group)))
|
||||
(if (eq? (length group) (length (flatten c)))
|
||||
c
|
||||
(begin
|
||||
(set! %has-met t0)
|
||||
(ensure-new-5 group)))))))
|
||||
(define (ensure-new-5 group)
|
||||
(decrement-escape)
|
||||
(if (eq? 0 escape-counter)
|
||||
(begin
|
||||
(reset-escape)
|
||||
(printf "escaped from loopland...~n")
|
||||
'())
|
||||
(let ((t0 %has-met))
|
||||
(let ((c (make-new-5 group)))
|
||||
(if (eq? (length group) (length (flatten c)))
|
||||
c
|
||||
(begin
|
||||
(set! %has-met t0)
|
||||
(ensure-new-5 group)))))))
|
||||
|
||||
|
||||
(define (ensure-new-4 group)
|
||||
(decrement-escape)
|
||||
(if (eq? 0 escape-counter)
|
||||
(begin
|
||||
(reset-escape)
|
||||
(printf "escaped from loopland...~n")
|
||||
'())
|
||||
(let ((t0 %has-met))
|
||||
(let ((c (make-new-4 group)))
|
||||
(if (eq? (length group) (length (flatten c)))
|
||||
c
|
||||
(begin
|
||||
(set! %has-met t0)
|
||||
(ensure-new-4 group)))))))
|
||||
(define (ensure-new-4 group)
|
||||
(decrement-escape)
|
||||
(if (eq? 0 escape-counter)
|
||||
(begin
|
||||
(reset-escape)
|
||||
(printf "escaped from loopland...~n")
|
||||
'())
|
||||
(let ((t0 %has-met))
|
||||
(let ((c (make-new-4 group)))
|
||||
(if (eq? (length group) (length (flatten c)))
|
||||
c
|
||||
(begin
|
||||
(set! %has-met t0)
|
||||
(ensure-new-4 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<?)))
|
||||
(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)
|
||||
(let ((l (shuffle l0)))
|
||||
(when (> (remainder (length l) 2) 0)
|
||||
(printf "there will be ~a leftover.\n" (remainder (length l) 2)))
|
||||
(if (empty? l) '()
|
||||
(if (= 1 (length l)) (cons l '())
|
||||
(cons (list (first l) (second l)) (group-pairs (list-tail l 2)))))))
|
||||
(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)))
|
||||
(if (empty? l) '()
|
||||
(if (= 1 (length l)) (cons l '())
|
||||
(cons (list (first l) (second l)) (group-pairs (list-tail l 2)))))))
|
||||
|
||||
(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)))
|
||||
(case (length l)
|
||||
((0) '())
|
||||
((1) (cons l '()))
|
||||
((2) (cons (list (first l) (second l)) '()))
|
||||
(else (cons (list (first l) (second l) (third l))
|
||||
(group-threes (list-tail l 3)))))))
|
||||
(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)))
|
||||
(case (length l)
|
||||
((0) '())
|
||||
((1) (cons l '()))
|
||||
((2) (cons (list (first l) (second l)) '()))
|
||||
(else (cons (list (first l) (second l) (third l))
|
||||
(group-threes (list-tail l 3)))))))
|
||||
|
||||
|
||||
(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)))
|
||||
(case (length l)
|
||||
((0) '())
|
||||
((1) (cons l '()))
|
||||
((2) (cons (list (first l) (second l)) '()))
|
||||
((3) (cons (list (first l) (second l) (third l)) '()))
|
||||
(else (cons (list (first l) (second l) (third l) (fourth l))
|
||||
(group-fours (list-tail l 4)))))))
|
||||
(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)))
|
||||
(case (length l)
|
||||
((0) '())
|
||||
((1) (cons l '()))
|
||||
((2) (cons (list (first l) (second l)) '()))
|
||||
((3) (cons (list (first l) (second l) (third l)) '()))
|
||||
(else (cons (list (first l) (second l) (third l) (fourth l))
|
||||
(group-fours (list-tail l 4)))))))
|
||||
|
||||
;;; pairs
|
||||
|
||||
(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))
|
||||
(begin
|
||||
;(printf "adding: ~a and ~a from ~a\n" p1 p2 l)
|
||||
(meeting-2 p1 p2)
|
||||
(cons (list p1 p2) (select-pairs (remove* (list 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))
|
||||
(begin
|
||||
;(printf "adding: ~a and ~a from ~a\n" p1 p2 l)
|
||||
(meeting-2 p1 p2)
|
||||
(cons (list p1 p2) (select-pairs (remove* (list p1 p2) l)))))))
|
||||
|
||||
(define (select-pairs l)
|
||||
(if (< (length l) 1) '()
|
||||
(let ((p1 (car l))
|
||||
(p2 (car (shuffle l))))
|
||||
;(printf "possibly: ~a and ~a from ~a\n" p1 p2 l)
|
||||
(select-pairs-acc p1 p2 l))))
|
||||
(define (select-pairs l)
|
||||
(if (< (length l) 1) '()
|
||||
(let ((p1 (car l))
|
||||
(p2 (car (shuffle l))))
|
||||
;(printf "possibly: ~a and ~a from ~a\n" p1 p2 l)
|
||||
(select-pairs-acc p1 p2 l))))
|
||||
|
||||
|
||||
;;; triples
|
||||
|
||||
(define (select-3fold-acc p1 p2 p3 l)
|
||||
(if (empty? l) '()
|
||||
(cond
|
||||
((have-they-met? (list p1 p2))
|
||||
(select-3fold-acc p1 (car l) p3 (remove p2 l)))
|
||||
((have-they-met? (list p1 p3))
|
||||
(select-3fold-acc p1 p2 (car l) (remove p3 l)))
|
||||
((have-they-met? (list p2 p3))
|
||||
(select-3fold-acc p1 p2 (car l) (remove p3 l)))
|
||||
(else (begin
|
||||
;(printf "adding: ~a, ~a and ~a from ~a\n" p1 p2 p3 l)
|
||||
(meeting-3 p1 p2 p3)
|
||||
(cons (list p1 p2 p3) (select-3fold (remove* (list p1 p2 p3) l))))))))
|
||||
(define (select-3fold-acc p1 p2 p3 l)
|
||||
(if (empty? l) '()
|
||||
(cond
|
||||
((have-they-met? (list p1 p2))
|
||||
(select-3fold-acc p1 (car l) p3 (remove p2 l)))
|
||||
((have-they-met? (list p1 p3))
|
||||
(select-3fold-acc p1 p2 (car l) (remove p3 l)))
|
||||
((have-they-met? (list p2 p3))
|
||||
(select-3fold-acc p1 p2 (car l) (remove p3 l)))
|
||||
(else (begin
|
||||
;(printf "adding: ~a, ~a and ~a from ~a\n" p1 p2 p3 l)
|
||||
(meeting-3 p1 p2 p3)
|
||||
(cons (list p1 p2 p3) (select-3fold (remove* (list p1 p2 p3) l))))))))
|
||||
|
||||
|
||||
(define (select-3fold l)
|
||||
(if (< (length l) 1) '()
|
||||
(let ((p1 (car l))
|
||||
(p2 (car (shuffle l))) ;; maybe duplicate
|
||||
(p3 (car (shuffle l)))) ;; maybe duplicate
|
||||
;(printf "possibly: ~a and ~a from ~a\n" p1 p2 l)
|
||||
(select-3fold-acc p1 p2 p3 l))))
|
||||
|
||||
(define (select-3fold l)
|
||||
(if (< (length l) 1) '()
|
||||
(let ((p1 (car l))
|
||||
(p2 (car (shuffle l))) ;; maybe duplicate
|
||||
(p3 (car (shuffle l)))) ;; maybe duplicate
|
||||
;(printf "possibly: ~a and ~a from ~a\n" p1 p2 l)
|
||||
(select-3fold-acc p1 p2 p3 l))))
|
||||
|
||||
;;; fours
|
||||
|
||||
(define (select-4fold-acc p1 p2 p3 p4 l)
|
||||
(if (empty? l) '()
|
||||
(cond
|
||||
((have-they-met? (list p1 p2 p3 p4))
|
||||
(select-4fold-acc p1 (car l) p2 p3 (remove p2 l)))
|
||||
((have-they-met? (list p1 p3))
|
||||
(select-4fold-acc p1 p2 (car l) (remove p3 l)))
|
||||
((have-they-met? (list p2 p3))
|
||||
(select-4fold-acc p1 p2 (car l) (remove p3 l)))
|
||||
(else (begin
|
||||
;(printf "adding: ~a, ~a and ~a from ~a\n" p1 p2 p3 l)
|
||||
(meeting-4 p1 p2 p3 p4)
|
||||
(cons (list p1 p2 p3 p4) (select-3fold (remove* (list p1 p2 p3) l))))))))
|
||||
(define (select-4fold-acc p1 p2 p3 p4 l)
|
||||
(if (empty? l) '()
|
||||
(cond
|
||||
((have-they-met? (list p1 p2 p3 p4))
|
||||
(select-4fold-acc p1 (car l) p2 p3 (remove p2 l)))
|
||||
((have-they-met? (list p1 p3))
|
||||
(select-4fold-acc p1 p2 (car l) (remove p3 l)))
|
||||
((have-they-met? (list p2 p3))
|
||||
(select-4fold-acc p1 p2 (car l) (remove p3 l)))
|
||||
(else (begin
|
||||
;(printf "adding: ~a, ~a and ~a from ~a\n" p1 p2 p3 l)
|
||||
(meeting-4 p1 p2 p3 p4)
|
||||
(cons (list p1 p2 p3 p4) (select-3fold (remove* (list p1 p2 p3) l))))))))
|
||||
|
||||
|
||||
(define (select-4fold l)
|
||||
(if (< (length l) 1) '()
|
||||
(let ((p1 (car l))
|
||||
(p2 (car (shuffle l))) ;; maybe duplicate
|
||||
(p3 (car (shuffle l))) ;; maybe duplicate
|
||||
(p4 (car (shuffle l)))) ;; maybe duplicate
|
||||
;(printf "possibly: ~a and ~a from ~a\n" p1 p2 l)
|
||||
(select-4fold-acc p1 p2 p3 p4 l))))
|
||||
|
||||
(define (select-4fold l)
|
||||
(if (< (length l) 1) '()
|
||||
(let ((p1 (car l))
|
||||
(p2 (car (shuffle l))) ;; maybe duplicate
|
||||
(p3 (car (shuffle l))) ;; maybe duplicate
|
||||
(p4 (car (shuffle l)))) ;; maybe duplicate
|
||||
;(printf "possibly: ~a and ~a from ~a\n" p1 p2 l)
|
||||
(select-4fold-acc p1 p2 p3 p4 l))))
|
||||
|
||||
|
||||
;; printing and/or output
|
||||
;; printing and/or output
|
||||
|
||||
(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 (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)
|
||||
(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 (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)
|
||||
(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)))
|
||||
(printf "in ~a rounds of 4, there can be ~s distinct groupings\n" n3 (* n3 (/ (length l) 4)))
|
||||
(cross-chatter (length 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)))
|
||||
(printf "in ~a rounds of 4, there can be ~s distinct groupings\n" n3 (* n3 (/ (length l) 4)))
|
||||
(cross-chatter (length l) n1 n2 n3))
|
||||
|
||||
|
||||
(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-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)
|
||||
(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))))
|
||||
(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
|
||||
(define (print-rounds-of-2 group n)
|
||||
(dotimes (x n)
|
||||
(printf "next round [2:~a]~n" (+ x 1))
|
||||
(map (lambda (pair)
|
||||
(printf "pair: ~a & ~a~n" (first pair) (second pair)))
|
||||
(make-new-2 group))
|
||||
(printf "~n")))
|
||||
;; print and/or ceate subgroups
|
||||
(define (print-rounds-of-2 group n)
|
||||
(dotimes (x n)
|
||||
(printf "next round [2:~a]~n" (+ x 1))
|
||||
(map (lambda (pair)
|
||||
(printf "pair: ~a & ~a~n" (first pair) (second pair)))
|
||||
(make-new-2 group))
|
||||
(printf "~n")))
|
||||
|
||||
(define (print-rounds-of-3 group n)
|
||||
(dotimes (x n)
|
||||
(printf "next round [3:~a]~n" (+ x 1))
|
||||
(for-each (lambda (g0)
|
||||
(printf "3fold: ~a, ~a & ~a~n"
|
||||
(if g0 (first g0) "?")
|
||||
(if (< 1 (length g0)) (second g0) "?")
|
||||
(if (< 2 (length g0)) (third g0) "?")))
|
||||
(make-new-3 group))
|
||||
(printf "~n")))
|
||||
(define (print-rounds-of-3 group n)
|
||||
(dotimes (x n)
|
||||
(printf "next round [3:~a]~n" (+ x 1))
|
||||
(for-each (lambda (g0)
|
||||
(printf "3fold: ~a, ~a & ~a~n"
|
||||
(if g0 (first g0) "?")
|
||||
(if (< 1 (length g0)) (second g0) "?")
|
||||
(if (< 2 (length g0)) (third g0) "?")))
|
||||
(make-new-3 group))
|
||||
(printf "~n")))
|
||||
|
||||
(define (print-rounds-of-4 group n)
|
||||
(dotimes (x n)
|
||||
(printf "next round [4:~a]~n" (+ x 1))
|
||||
(for-each (lambda (g0)
|
||||
(printf "4fold: ~a, ~a, ~a & ~a~n"
|
||||
(if g0 (first g0) "?")
|
||||
(if (< 1 (length g0)) (second g0) "?")
|
||||
(if (< 2 (length g0)) (third g0) "?")
|
||||
(if (< 3 (length g0)) (fourth g0) "?")
|
||||
))
|
||||
(make-new-4 group))
|
||||
(printf "~n")))
|
||||
(define (print-rounds-of-4 group n)
|
||||
(dotimes (x n)
|
||||
(printf "next round [4:~a]~n" (+ x 1))
|
||||
(for-each (lambda (g0)
|
||||
(printf "4fold: ~a, ~a, ~a & ~a~n"
|
||||
(if g0 (first g0) "?")
|
||||
(if (< 1 (length g0)) (second g0) "?")
|
||||
(if (< 2 (length g0)) (third g0) "?")
|
||||
(if (< 3 (length g0)) (fourth g0) "?")
|
||||
))
|
||||
(make-new-4 group))
|
||||
(printf "~n")))
|
||||
|
||||
|
||||
(define (print-all-meetings group)
|
||||
(printf "Meetings so far:~n")
|
||||
(for-each (lambda (p0)
|
||||
(printf "~a has met ~a~n"
|
||||
p0 (drop (map (lambda (p1) (cdar p1))
|
||||
(all-meetings p0)) 2)))
|
||||
group)
|
||||
(printf "~n"))
|
||||
(define (print-all-meetings group)
|
||||
(printf "Meetings so far:~n")
|
||||
(for-each (lambda (p0)
|
||||
(printf "~a has met ~a~n"
|
||||
p0 (drop (map (lambda (p1) (cdar p1))
|
||||
(all-meetings p0)) 2)))
|
||||
group)
|
||||
(printf "~n"))
|
||||
|
||||
)
|
||||
|
||||
)
|
||||
|
|
|
|||
Loading…
Reference in a new issue