; challenge2.scm -- Jens Axel Søgaard -- 20th oct 2004 ; This is a solution to the challenge set forth by Frank Buss ; at (require (lib "list.ss" "srfi" "1") ; list library (lib "42.ss" "srfi") ; eager comprehensions (lib "26.ss" "srfi") ; notation for currying (planet "set.scm" ("soegaard" "galore.plt" 1 0))) ; set library ; Lines and triangles are represented as sets of points. ; A point is represented as a symbol. (use-set (instantiate-set ordered-list-set@ symbols@)) ; two functions the author of Galore forgot to include (define (list->set sets) (fold union empty sets)) (define (union* . sets) (list->set sets)) ; notation for looping over all pairs of a list (define-syntax :pairs (syntax-rules () ((:pairs cc p l) (:do cc ((p l)) (not (null? p)) ((cdr p)))))) ; notation for looping over all combinations of two elements of a list (define-syntax :combinations (syntax-rules () ((:combinations cc c l) (:list cc c (list-ec (:pairs p l) (:list y (cdr p)) (list (car p) y)))))) ; We consider the triangle ; C ; ^ ; / \ ; / \ ; / \ ; A ------- B ; Call the line AB for bottom. The non-bottom lines emanating ; from A and B is called A-lines and B-lines respectively. ; define the lines (define A-lines (list (set 'A 'p5 'p8 'C) (set 'A 'p3 'p7 'p9) (set 'A 'p2 'p4 'p6))) (define B-lines (list (set 'B 'p2 'p3 'p5) (set 'B 'p4 'p7 'p8) (set 'B 'p6 'p9 'C))) (define all-points (union (list->set A-lines) (list->set B-lines))) ; As in the proof of the formula used in challenge.scm we ; consider three types of triangles: ; i) Triangles where bottom is a side ; ii) Triangles formed from two non-bottom lines from A and ; one non-bottom line from B. ; iii) Triangles formed from two non-bottom lines from B and ; one non-bottom line from A. ; return list of triangles whose sides consists of ; one line emanating from A, one side emanating from B ; and bottom (i.e. the line AB) (define (bottom-triangles) (map (cut insert (set 'A 'B) <>) (elements (difference all-points (set 'A 'B))))) ; return list of triangles whose sides consists ; of two lines from lines1 and one line from lines2 (define (non-bottom-triangles lines1 lines2) (list-ec (:combinations c lines1) (: l lines2) ; the three sides of the triangle is: (first c), (second c) and l (union* (intersection (first c) (second c)) (intersection (first c) l) (intersection (second c) l)))) ; return list of all triangles (append (non-bottom-triangles A-lines B-lines) (non-bottom-triangles B-lines A-lines) (bottom-triangles)) ; => ;((a p3 p5) ; (a p7 p8) ; (a c p9) ; (a p2 p5) ; (a p4 p8) ; (a c p6) ; (a p2 p3) ; (a p4 p7) ; (a p6 p9) ; (b p5 p8) ; (b p3 p7) ; (b p2 p4) ; (b c p5) ; (b p3 p9) ; (b p2 p6) ; (b c p8) ; (b p7 p9) ; (b p4 p6) ; (a b c) ; (a b p2) ; (a b p3) ; (a b p4) ; (a b p5) ; (a b p6) ; (a b p7) ; (a b p8) ; (a b p9))