; 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))