fork download
copy 
  1. ; highly composite numbers, revisited
  2.  
  3. (define (add1 n) (+ n 1))
  4.  
  5. ; priority queue -- pairing heaps
  6.  
  7. (define pq-empty (list))
  8.  
  9. (define pq-empty? null?)
  10.  
  11. (define (pq-first pq)
  12.   (if (null? pq)
  13.       (error 'pq-first "can't extract minimum from null queue")
  14.       (car pq)))
  15.  
  16. (define (pq-merge lt? p1 p2)
  17.   (cond ((null? p1) p2)
  18.         ((null? p2) p1)
  19.         ((lt? (car p2) (car p1))
  20.           (cons (car p2) (cons p1 (cdr p2))))
  21.         (else (cons (car p1) (cons p2 (cdr p1))))))
  22.  
  23. (define (pq-insert lt? x pq)
  24.   (pq-merge lt? (list x) pq))
  25.  
  26. (define (pq-merge-pairs lt? ps)
  27.   (cond ((null? ps) '())
  28.         ((null? (cdr ps)) (car ps))
  29.         (else (pq-merge lt? (pq-merge lt? (car ps) (cadr ps))
  30.                             (pq-merge-pairs lt? (cddr ps))))))
  31.  
  32. (define (pq-rest lt? pq)
  33.   (if (null? pq)
  34.       (error 'pq-rest "can't delete minimum from null queue")
  35.       (pq-merge-pairs lt? (cdr pq))))
  36.  
  37. (define (list->pq lt? xs)
  38.   (let loop ((xs xs) (pq pq-empty))
  39.     (if (null? xs) pq
  40.       (loop (cdr xs) (pq-insert lt? (car xs) pq)))))
  41.  
  42. (define (pq->list lt? pq)
  43.   (let loop ((pq pq) (xs '()))
  44.     (if (pq-empty? pq) (reverse xs)
  45.       (loop (pq-rest lt? pq) (cons (pq-first pq) xs)))))
  46.  
  47. ; binary search tree
  48.  
  49. (define bst-empty (list))
  50.  
  51. (define bst-empty? null?)
  52.  
  53. (define (bst-member? lt? item bst)
  54.   (cond ((bst-empty? bst) #f)
  55.         ((lt? item (car bst))
  56.           (bst-member? lt? item (cadr bst)))
  57.         ((lt? (car bst) item)
  58.           (bst-member? lt? item (caddr bst)))
  59.         (else #t)))
  60.  
  61. (define (bst-insert lt? item bst)
  62.   (cond ((bst-empty? bst)
  63.           (list item (list) (list)))
  64.         ((lt? item (car bst))
  65.           (list (car bst)
  66.                 (bst-insert lt? item (cadr bst))
  67.                 (caddr bst)))
  68.         ((lt? (car bst) item)
  69.           (list (car bst)
  70.                 (cadr bst)
  71.                 (bst-insert lt? item (caddr bst))))
  72.         (else bst)))
  73.  
  74. (define (bst-successor bst)
  75.   (cond ((bst-empty? bst) bst-empty)
  76.         ((bst-empty? (cadr bst)) bst)
  77.         (else (bst-successor (cadr bst)))))
  78.  
  79. (define (bst-delete-root lt? bst)
  80.   (cond ((and (bst-empty? (cadr bst))
  81.           (bst-empty? (caddr bst))) bst-empty)
  82.         ((bst-empty? (cadr bst)) (caddr bst))
  83.         ((bst-empty? (caddr bst)) (cadr bst))
  84.         (else (let ((new-root (car (bst-successor (caddr bst)))))
  85.                 (list new-root (cadr bst)
  86.                       (bst-delete lt? new-root (caddr bst)))))))
  87.  
  88. (define (bst-delete lt? item bst)
  89.   (cond ((bst-empty? bst) bst)
  90.         ((lt? item (car bst))
  91.           (list (car bst)
  92.                 (bst-delete lt? item (cadr bst))
  93.                 (caddr bst)))
  94.         ((lt? (car bst) item)
  95.           (list (car bst)
  96.                 (cadr bst)
  97.                 (bst-delete lt? item (caddr bst))))
  98.         (else (bst-delete-root lt? bst))))
  99.  
  100. ; distinct priority queue
  101.  
  102. (define (make-dpq lt?) (list lt? pq-empty bst-empty))
  103.  
  104. (define (dpq-empty? dpq) (pq-empty? (cadr dpq)))
  105.  
  106. (define (dpq-first dpq)
  107.   (if (dpq-empty? dpq)
  108.       (error 'dpq-first "can't extract minimum from null queue")
  109.       (pq-first (cadr dpq))))
  110.  
  111. (define (dpq-insert item dpq)
  112.   (if (bst-member? (car dpq) item (caddr dpq))
  113.       dpq
  114.       (list (car dpq)
  115.             (pq-insert (car dpq) item (cadr dpq))
  116.             (bst-insert (car dpq) item (caddr dpq)))))
  117.  
  118. (define (dpq-rest dpq)
  119.   (if (dpq-empty? dpq)
  120.       (error 'dpq-rest "can't delete minimum from null queue")
  121.       (list (car dpq)
  122.             (pq-rest (car dpq) (cadr dpq))
  123.             (bst-delete (car dpq) (dpq-first dpq) (caddr dpq)))))
  124.  
  125. (define (dpq-enlist dpq) (pq->list (car dpq) (cadr dpq)))
  126.  
  127. ; prime numbers
  128.  
  129. (define (primes n) ; list of primes not exceeding n
  130.   (let* ((len (quotient (- n 1) 2)) (bits (make-vector len #t)))
  131.     (let loop ((i 0) (p 3) (ps (list 2)))
  132.       (cond ((< n (* p p))
  133.               (do ((i i (+ i 1)) (p p (+ p 2))
  134.                    (ps ps (if (vector-ref bits i) (cons p ps) ps)))
  135.                   ((= i len) (reverse ps))))
  136.             ((vector-ref bits i)
  137.               (do ((j (+ (* 2 i i) (* 6 i) 3) (+ j p)))
  138.                   ((<= len j) (loop (+ i 1) (+ p 2) (cons p ps)))
  139.                 (vector-set! bits j #f)))
  140.             (else (loop (+ i 1) (+ p 2) ps))))))
  141.  
  142. (define ps (primes 10000))
  143.  
  144. (define (next ndxs)
  145.   (let loop ((front (list)) (back (cddr ndxs)) (xs (list)))
  146.     (cond ((null? back)
  147.             (map (lambda (x)
  148.                    (cons (do ((x x (cdr x))
  149.                               (ps ps (cdr ps))
  150.                               (p 1 (* p (expt (car ps) (car x)))))
  151.                              ((null? x) p))
  152.                          (cons (apply * (map add1 x))
  153.                                x)))
  154.                  (cons (reverse (cons 1 front)) xs)))
  155.           ((null? front)
  156.             (loop (cons (car back) front) (cdr back)
  157.                   (cons (cons (+ (car back) 1) (cdr back)) xs)))
  158.           ((< (car back) (car front))
  159.             (loop (cons (car back) front) (cdr back)
  160.                   (cons (append (reverse (cons (+ (car back) 1) front))
  161.                                 (cdr back))
  162.                         xs)))
  163.           (else (loop (cons (car back) front) (cdr back) xs)))))
  164.  
  165. (define (hcn)
  166.   (let ((dpq (make-dpq (lambda (xs ys) (< (car xs) (car ys)))))
  167.         (ctr 0) (record 0))
  168.     (let loop1 ((dpq (dpq-insert (list 1 1) dpq)))
  169.       (let* ((candidate (dpq-first dpq)) (dpq (dpq-rest dpq)))
  170.         (when (< record (cadr candidate))
  171.           (set! ctr (+ ctr 1)) (set! record (cadr candidate))
  172.           (display ctr) (display " ") (display candidate) (newline))
  173.         (let loop2 ((xs (next candidate)) (dpq dpq))
  174.           (cond ((null? xs) (loop1 dpq))
  175.                 ((< record (cadar xs))
  176.                   (loop2 (cdr xs) (dpq-insert (car xs) dpq)))
  177.                 (else (loop2 (cdr xs) dpq))))))))
  178.  
  179. (hcn)
Time limit exceeded #stdin #stdout 15s 10152KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
1 (1 1)
2 (2 2 1)
3 (4 3 2)
4 (6 4 1 1)
5 (12 6 2 1)
6 (24 8 3 1)
7 (36 9 2 2)
8 (48 10 4 1)
9 (60 12 2 1 1)
10 (120 16 3 1 1)
11 (180 18 2 2 1)
12 (240 20 4 1 1)
13 (360 24 3 2 1)
14 (720 30 4 2 1)
15 (840 32 3 1 1 1)
16 (1260 36 2 2 1 1)
17 (1680 40 4 1 1 1)
18 (2520 48 3 2 1 1)
19 (5040 60 4 2 1 1)
20 (7560 64 3 3 1 1)
21 (10080 72 5 2 1 1)
22 (15120 80 4 3 1 1)
23 (20160 84 6 2 1 1)
24 (25200 90 4 2 2 1)
25 (27720 96 3 2 1 1 1)
26 (45360 100 4 4 1 1)
27 (50400 108 5 2 2 1)
28 (55440 120 4 2 1 1 1)
29 (83160 128 3 3 1 1 1)
30 (110880 144 5 2 1 1 1)
31 (166320 160 4 3 1 1 1)
32 (221760 168 6 2 1 1 1)
33 (277200 180 4 2 2 1 1)
34 (332640 192 5 3 1 1 1)
35 (498960 200 4 4 1 1 1)
36 (554400 216 5 2 2 1 1)
37 (665280 224 6 3 1 1 1)
38 (720720 240 4 2 1 1 1 1)
39 (1081080 256 3 3 1 1 1 1)
40 (1441440 288 5 2 1 1 1 1)
41 (2162160 320 4 3 1 1 1 1)
42 (2882880 336 6 2 1 1 1 1)
43 (3603600 360 4 2 2 1 1 1)
44 (4324320 384 5 3 1 1 1 1)
45 (6486480 400 4 4 1 1 1 1)
46 (7207200 432 5 2 2 1 1 1)
47 (8648640 448 6 3 1 1 1 1)
48 (10810800 480 4 3 2 1 1 1)
49 (14414400 504 6 2 2 1 1 1)
50 (17297280 512 7 3 1 1 1 1)
51 (21621600 576 5 3 2 1 1 1)
52 (32432400 600 4 4 2 1 1 1)
53 (36756720 640 4 3 1 1 1 1 1)
54 (43243200 672 6 3 2 1 1 1)
55 (61261200 720 4 2 2 1 1 1 1)
56 (73513440 768 5 3 1 1 1 1 1)
57 (110270160 800 4 4 1 1 1 1 1)
58 (122522400 864 5 2 2 1 1 1 1)
59 (147026880 896 6 3 1 1 1 1 1)
60 (183783600 960 4 3 2 1 1 1 1)
61 (245044800 1008 6 2 2 1 1 1 1)
62 (294053760 1024 7 3 1 1 1 1 1)
63 (367567200 1152 5 3 2 1 1 1 1)
64 (551350800 1200 4 4 2 1 1 1 1)
65 (698377680 1280 4 3 1 1 1 1 1 1)
66 (735134400 1344 6 3 2 1 1 1 1)
67 (1102701600 1440 5 4 2 1 1 1 1)
68 (1396755360 1536 5 3 1 1 1 1 1 1)
69 (2095133040 1600 4 4 1 1 1 1 1 1)
70 (2205403200 1680 6 4 2 1 1 1 1)
71 (2327925600 1728 5 2 2 1 1 1 1 1)
72 (2793510720 1792 6 3 1 1 1 1 1 1)
73 (3491888400 1920 4 3 2 1 1 1 1 1)
74 (4655851200 2016 6 2 2 1 1 1 1 1)
75 (5587021440 2048 7 3 1 1 1 1 1 1)
76 (6983776800 2304 5 3 2 1 1 1 1 1)
77 (10475665200 2400 4 4 2 1 1 1 1 1)
78 (13967553600 2688 6 3 2 1 1 1 1 1)
79 (20951330400 2880 5 4 2 1 1 1 1 1)
80 (27935107200 3072 7 3 2 1 1 1 1 1)
81 (41902660800 3360 6 4 2 1 1 1 1 1)
82 (48886437600 3456 5 3 2 2 1 1 1 1)
83 (64250746560 3584 6 3 1 1 1 1 1 1 1)
84 (73329656400 3600 4 4 2 2 1 1 1 1)
85 (80313433200 3840 4 3 2 1 1 1 1 1 1)
86 (97772875200 4032 6 3 2 2 1 1 1 1)
87 (128501493120 4096 7 3 1 1 1 1 1 1 1)
88 (146659312800 4320 5 4 2 2 1 1 1 1)
89 (160626866400 4608 5 3 2 1 1 1 1 1 1)
90 (240940299600 4800 4 4 2 1 1 1 1 1 1)
91 (293318625600 5040 6 4 2 2 1 1 1 1)
92 (321253732800 5376 6 3 2 1 1 1 1 1 1)
93 (481880599200 5760 5 4 2 1 1 1 1 1 1)
94 (642507465600 6144 7 3 2 1 1 1 1 1 1)
95 (963761198400 6720 6 4 2 1 1 1 1 1 1)
96 (1124388064800 6912 5 3 2 2 1 1 1 1 1)
97 (1606268664000 7168 6 3 3 1 1 1 1 1 1)
98 (1686582097200 7200 4 4 2 2 1 1 1 1 1)
99 (1927522396800 7680 7 4 2 1 1 1 1 1 1)
100 (2248776129600 8064 6 3 2 2 1 1 1 1 1)
101 (3212537328000 8192 7 3 3 1 1 1 1 1 1)
102 (3373164194400 8640 5 4 2 2 1 1 1 1 1)
103 (4497552259200 9216 7 3 2 2 1 1 1 1 1)
104 (6746328388800 10080 6 4 2 2 1 1 1 1 1)
105 (8995104518400 10368 8 3 2 2 1 1 1 1 1)
106 (9316358251200 10752 6 3 2 1 1 1 1 1 1 1)
107 (13492656777600 11520 7 4 2 2 1 1 1 1 1)
108 (18632716502400 12288 7 3 2 1 1 1 1 1 1 1)
109 (26985313555200 12960 8 4 2 2 1 1 1 1 1)
110 (27949074753600 13440 6 4 2 1 1 1 1 1 1 1)
111 (32607253879200 13824 5 3 2 2 1 1 1 1 1 1)
112 (46581791256000 14336 6 3 3 1 1 1 1 1 1 1)
113 (48910880818800 14400 4 4 2 2 1 1 1 1 1 1)
114 (55898149507200 15360 7 4 2 1 1 1 1 1 1 1)
115 (65214507758400 16128 6 3 2 2 1 1 1 1 1 1)
116 (93163582512000 16384 7 3 3 1 1 1 1 1 1 1)
117 (97821761637600 17280 5 4 2 2 1 1 1 1 1 1)
118 (130429015516800 18432 7 3 2 2 1 1 1 1 1 1)
119 (195643523275200 20160 6 4 2 2 1 1 1 1 1 1)
120 (260858031033600 20736 8 3 2 2 1 1 1 1 1 1)
121 (288807105787200 21504 6 3 2 1 1 1 1 1 1 1 1)
122 (391287046550400 23040 7 4 2 2 1 1 1 1 1 1)
123 (577614211574400 24576 7 3 2 1 1 1 1 1 1 1 1)
124 (782574093100800 25920 8 4 2 2 1 1 1 1 1 1)
125 (866421317361600 26880 6 4 2 1 1 1 1 1 1 1 1)
126 (1010824870255200 27648 5 3 2 2 1 1 1 1 1 1 1)
127 (1444035528936000 28672 6 3 3 1 1 1 1 1 1 1 1)
128 (1516237305382800 28800 4 4 2 2 1 1 1 1 1 1 1)
129 (1732842634723200 30720 7 4 2 1 1 1 1 1 1 1 1)
130 (2021649740510400 32256 6 3 2 2 1 1 1 1 1 1 1)
131 (2888071057872000 32768 7 3 3 1 1 1 1 1 1 1 1)
132 (3032474610765600 34560 5 4 2 2 1 1 1 1 1 1 1)
133 (4043299481020800 36864 7 3 2 2 1 1 1 1 1 1 1)
134 (6064949221531200 40320 6 4 2 2 1 1 1 1 1 1 1)
135 (8086598962041600 41472 8 3 2 2 1 1 1 1 1 1 1)
136 (10108248702552000 43008 6 3 3 2 1 1 1 1 1 1 1)
137 (12129898443062400 46080 7 4 2 2 1 1 1 1 1 1 1)
138 (18194847664593600 48384 6 5 2 2 1 1 1 1 1 1 1)
139 (20216497405104000 49152 7 3 3 2 1 1 1 1 1 1 1)
140 (24259796886124800 51840 8 4 2 2 1 1 1 1 1 1 1)
141 (30324746107656000 53760 6 4 3 2 1 1 1 1 1 1 1)
142 (36389695329187200 55296 7 5 2 2 1 1 1 1 1 1 1)
143 (48519593772249600 57600 9 4 2 2 1 1 1 1 1 1 1)
144 (60649492215312000 61440 7 4 3 2 1 1 1 1 1 1 1)
145 (72779390658374400 62208 8 5 2 2 1 1 1 1 1 1 1)
146 (74801040398884800 64512 6 3 2 2 1 1 1 1 1 1 1 1)
147 (106858629141264000 65536 7 3 3 1 1 1 1 1 1 1 1 1)
148 (112201560598327200 69120 5 4 2 2 1 1 1 1 1 1 1 1)
149 (149602080797769600 73728 7 3 2 2 1 1 1 1 1 1 1 1)
150 (224403121196654400 80640 6 4 2 2 1 1 1 1 1 1 1 1)
151 (299204161595539200 82944 8 3 2 2 1 1 1 1 1 1 1 1)
152 (374005201994424000 86016 6 3 3 2 1 1 1 1 1 1 1 1)
153 (448806242393308800 92160 7 4 2 2 1 1 1 1 1 1 1 1)
154 (673209363589963200 96768 6 5 2 2 1 1 1 1 1 1 1 1)
155 (748010403988848000 98304 7 3 3 2 1 1 1 1 1 1 1 1)
156 (897612484786617600 103680 8 4 2 2 1 1 1 1 1 1 1 1)
157 (1122015605983272000 107520 6 4 3 2 1 1 1 1 1 1 1 1)
158 (1346418727179926400 110592 7 5 2 2 1 1 1 1 1 1 1 1)
159 (1795224969573235200 115200 9 4 2 2 1 1 1 1 1 1 1 1)
160 (2244031211966544000 122880 7 4 3 2 1 1 1 1 1 1 1 1)
161 (2692837454359852800 124416 8 5 2 2 1 1 1 1 1 1 1 1)
162 (3066842656354276800 129024 6 3 2 2 1 1 1 1 1 1 1 1 1)
163 (4381203794791824000 131072 7 3 3 1 1 1 1 1 1 1 1 1 1)
164 (4488062423933088000 138240 8 4 3 2 1 1 1 1 1 1 1 1)
165 (6133685312708553600 147456 7 3 2 2 1 1 1 1 1 1 1 1 1)
166 (8976124847866176000 153600 9 4 3 2 1 1 1 1 1 1 1 1)
167 (9200527969062830400 161280 6 4 2 2 1 1 1 1 1 1 1 1 1)
168 (12267370625417107200 165888 8 3 2 2 1 1 1 1 1 1 1 1 1)
169 (15334213281771384000 172032 6 3 3 2 1 1 1 1 1 1 1 1 1)
170 (18401055938125660800 184320 7 4 2 2 1 1 1 1 1 1 1 1 1)
171 (27601583907188491200 193536 6 5 2 2 1 1 1 1 1 1 1 1 1)
172 (30668426563542768000 196608 7 3 3 2 1 1 1 1 1 1 1 1 1)
173 (36802111876251321600 207360 8 4 2 2 1 1 1 1 1 1 1 1 1)
174 (46002639845314152000 215040 6 4 3 2 1 1 1 1 1 1 1 1 1)
175 (55203167814376982400 221184 7 5 2 2 1 1 1 1 1 1 1 1 1)
176 (73604223752502643200 230400 9 4 2 2 1 1 1 1 1 1 1 1 1)
177 (92005279690628304000 245760 7 4 3 2 1 1 1 1 1 1 1 1 1)
178 (110406335628753964800 248832 8 5 2 2 1 1 1 1 1 1 1 1 1)
179 (131874234223233902400 258048 6 3 2 2 1 1 1 1 1 1 1 1 1 1)
180 (184010559381256608000 276480 8 4 3 2 1 1 1 1 1 1 1 1 1)
181 (263748468446467804800 294912 7 3 2 2 1 1 1 1 1 1 1 1 1 1)
182 (368021118762513216000 307200 9 4 3 2 1 1 1 1 1 1 1 1 1)
183 (395622702669701707200 322560 6 4 2 2 1 1 1 1 1 1 1 1 1 1)
184 (527496936892935609600 331776 8 3 2 2 1 1 1 1 1 1 1 1 1 1)
185 (659371171116169512000 344064 6 3 3 2 1 1 1 1 1 1 1 1 1 1)
186 (791245405339403414400 368640 7 4 2 2 1 1 1 1 1 1 1 1 1 1)
187 (1186868108009105121600 387072 6 5 2 2 1 1 1 1 1 1 1 1 1 1)
188 (1318742342232339024000 393216 7 3 3 2 1 1 1 1 1 1 1 1 1 1)
189 (1582490810678806828800 414720 8 4 2 2 1 1 1 1 1 1 1 1 1 1)
190 (1978113513348508536000 430080 6 4 3 2 1 1 1 1 1 1 1 1 1 1)
191 (2373736216018210243200 442368 7 5 2 2 1 1 1 1 1 1 1 1 1 1)
192 (3164981621357613657600 460800 9 4 2 2 1 1 1 1 1 1 1 1 1 1)
193 (3956227026697017072000 491520 7 4 3 2 1 1 1 1 1 1 1 1 1 1)
194 (4747472432036420486400 497664 8 5 2 2 1 1 1 1 1 1 1 1 1 1)
195 (5934340540045525608000 516096 6 5 3 2 1 1 1 1 1 1 1 1 1 1)
196 (7912454053394034144000 552960 8 4 3 2 1 1 1 1
https://ideone.com/s1vq5T
language:
Scheme (guile 2.2.4)
created:
7 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!