-
Notifications
You must be signed in to change notification settings - Fork 0
/
p105.scm
154 lines (124 loc) · 3.71 KB
/
p105.scm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
;; 2010-08-20
;;
;; Yuri Arapov <[email protected]>
;;
;; Project Euler
;;
;; http://projecteuler.net/index.php?section=problems&id=105
;;
;; Problem 105
;; 23 September 2005
;;
;; Let S(A) represent the sum of elements in set A of size n. We shall call it
;; a special sum set if for any two non-empty disjoint subsets, B and C, the
;; following properties are true:
;;
;; 1. S(B) ≠ S(C); that is, sums of subsets cannot be equal.
;; 2. If B contains more elements than C then S(B) > S(C).
;;
;; For example, {81, 88, 75, 42, 87, 84, 86, 65} is not a special sum set
;; because 65 + 87 + 88 = 75 + 81 + 84, whereas {157, 150, 164, 119, 79, 159,
;; 161, 139, 158} satisfies both rules for all possible subset pair
;; combinations and S(A) = 1286.
;;
;; Using sets.txt (right click and "Save Link/Target As..."), a 4K text file
;; with one-hundred sets containing seven to twelve elements (the two examples
;; given above are the first two sets in the file), identify all the special
;; sum sets, A(1), A(2), ..., A(k), and find the value of
;; S(A(1)) + S(A(2)) + ... + S(A(k)).
;;
;; NOTE: This problem is related to problems 103 and 106.
;;
;; Answer: 73702
(load "combinations.scm")
(define (print s) (for-each (lambda (i) (format #t "~a\n" i)) s))
;; Return list of all possible subsets of set s.
;; (all-subsets '(1 2 3)) -> ((1) (2) (3) (1 2) (1 3) (2 3) (1 2 3))
;;
(define (all-subsets s)
(let loop ((n 1)
(res '()))
(let ((c (combinations s n)))
(if (null? c)
res
(loop (1+ n) (append res c))))))
;; Return list of all disjoint subsets pairs of given set s.
;;
(define (disjoint-subsets s)
(if (null? (cddr s))
(list (cons (list (car s)) (list (list (cadr s)))))
(let* ((first (car s))
(rest (cdr s))
(pairs (disjoint-subsets rest)))
(append
pairs
(map
(lambda (pair)
(list (cons first (car pair)) (cadr pair)))
pairs)
(map
(lambda (pair)
(list (car pair) (cons first (cadr pair))))
pairs)
(map
(lambda (subset)
(list (list first) subset))
(all-subsets rest))))))
;; Sum of set elements.
;;
(define (set-sum s) (apply + s))
;; Test set for being special sum set.
;;
(define (special-sum-set? s)
(every
(lambda (ss-pair)
(let* ((tmp (sort ss-pair (lambda (x y) (< (length x) (length y)))))
(ss1 (car tmp))
(ss2 (cadr tmp))
(ss1-sum (set-sum ss1))
(ss2-sum (set-sum ss2)))
(and
(not (= ss1-sum ss2-sum))
(or (= (length ss1) (length ss2)) (< ss1-sum ss2-sum)))))
(disjoint-subsets (sort s <))))
(define (test1)
(special-sum-set? '(81 88 75 42 87 84 86 65)))
(define (test2)
(special-sum-set? '(157 150 164 119 79 159 161 139 158)))
;; Problem 105, brute force.
;;
(define (p105)
(let ((sets
(read-file-with
"sets.txt"
(lambda (line)
(map string->number (string-split line #\,))))))
(let loop ((sets sets)
(index 0)
(sum 0))
(if (zero? (remainder index 5))
(format #t "~a\n" index))
(if (null? sets)
sum
(loop
(cdr sets)
(1+ index)
(if (special-sum-set? (car sets))
(+ sum (set-sum (car sets)))
sum))))))
(define (f1 s)
(filter
(lambda (x)
(and (< 1 (length (car x)))
(= (length (car x)) (length (cadr x)))))
(disjoint-subsets s)))
(define (f2 s1 s2)
(let ((f1 (first s1))
(l1 (last s1))
(f2 (first s2))
(l2 (last s2)))
(or
(< f1 f2 l2 l1)
(< f2 f1 l1 l2))))
;; end of file
;; vim: ts=4 sw=4