[ create a new paste ] login | about

Link: http://codepad.org/NEbLYA6y    [ raw code | output | fork ]

programmingpraxis - Scheme, pasted on May 22:
; aliquot sequences

(define (factors n)
  (define (last-pair xs) (if (null? (cdr xs)) xs (last-pair (cdr xs))))
  (define (cycle . xs) (set-cdr! (last-pair xs) xs) xs)
  (let ((wheel (cons 1 (cons 2 (cons 2 (cycle 4 2 4 2 4 6 2 6))))))
    (let loop ((n (abs n)) (f 2) (wheel wheel) (fs (list)))
      (cond ((< n (* f f)) (if (= n 1) fs (reverse (cons n fs))))
            ((zero? (modulo n f)) (loop (/ n f) f wheel (cons f fs)))
            (else (loop n (+ f (car wheel)) (cdr wheel) fs))))))

(define (sum-div n)
  (define (div f x) (/ (- (expt f (+ x 1)) 1) (- f 1)))
  (let ((fs (factors n)))
    (let loop ((f (car fs)) (fs (cdr fs)) (x 1) (s 1))
      (cond ((null? fs) (- (* s (div f x)) n))
            ((= (car fs) f) (loop f (cdr fs) (+ x 1) s))
            (else (loop (car fs) (cdr fs) 1 (* s (div f x))))))))

(define (aliquot n)
  (define (rotate xs)
    (if (= (car xs) (apply min xs)) xs
      (rotate (append (cdr xs) (list (car xs))))))
  (when verbose? (display n) (display ",0: ")
    (display n) (newline))
  (let loop ((s (sum-div n)) (ss (list n)) (k 1))
    (when verbose? (display n) (display ",")
      (display k) (display ": ") (display s) (newline))
    (cond ((= s 1) (car ss))
          ((member s ss) (rotate (member s (reverse ss))))
          (else (loop (sum-div s) (cons s ss) (+ k 1))))))

(define verbose? #t)

(display (aliquot 168)) (newline)
(display (aliquot 2856)) (newline)


Output:
168,0: 168
168,1: 312
168,2: 528
168,3: 960
168,4: 2088
168,5: 3762
168,6: 5598
168,7: 6570
168,8: 10746
168,9: 13254
168,10: 13830
168,11: 19434
168,12: 20886
168,13: 21606
168,14: 25098
168,15: 26742
168,16: 26754
168,17: 40446
168,18: 63234
168,19: 77406
168,20: 110754
168,21: 171486
168,22: 253458
168,23: 295740
168,24: 647748
168,25: 1077612
168,26: 1467588
168,27: 1956812
168,28: 2109796
168,29: 1889486
168,30: 953914
168,31: 668966
168,32: 353578
168,33: 176792
168,34: 254128
168,35: 308832
168,36: 502104
168,37: 753216
168,38: 1240176
168,39: 2422288
168,40: 2697920
168,41: 3727264
168,42: 3655076
168,43: 2760844
168,44: 2100740
168,45: 2310856
168,46: 2455544
168,47: 3212776
168,48: 3751064
168,49: 3282196
168,50: 2723020
168,51: 3035684
168,52: 2299240
168,53: 2988440
168,54: 5297320
168,55: 8325080
168,56: 11222920
168,57: 15359480
168,58: 19199440
168,59: 28875608
168,60: 25266172
168,61: 19406148
168,62: 26552604
168,63: 40541052
168,64: 54202884
168,65: 72270540
168,66: 147793668
168,67: 228408732
168,68: 348957876
168,69: 508132204
168,70: 404465636
168,71: 303708376
168,72: 290504024
168,73: 312058216
168,74: 294959384
168,75: 290622016
168,76: 286081174
168,77: 151737434
168,78: 75868720
168,79: 108199856
168,80: 101437396
168,81: 76247552
168,82: 76099654
168,83: 42387146
168,84: 21679318
168,85: 12752594
168,86: 7278382
168,87: 3660794
168,88: 1855066
168,89: 927536
168,90: 932464
168,91: 1013592
168,92: 1546008
168,93: 2425752
168,94: 5084088
168,95: 8436192
168,96: 13709064
168,97: 20563656
168,98: 33082104
168,99: 57142536
168,100: 99483384
168,101: 245978376
168,102: 487384824
168,103: 745600776
168,104: 1118401224
168,105: 1677601896
168,106: 2538372504
168,107: 4119772776
168,108: 8030724504
168,109: 14097017496
168,110: 21148436904
168,111: 40381357656
168,112: 60572036544
168,113: 100039354704
168,114: 179931895322
168,115: 94685963278
168,116: 51399021218
168,117: 28358080762
168,118: 18046051430
168,119: 17396081338
168,120: 8698040672
168,121: 8426226964
168,122: 6319670230
168,123: 5422685354
168,124: 3217383766
168,125: 1739126474
168,126: 996366646
168,127: 636221402
168,128: 318217798
168,129: 195756362
168,130: 101900794
168,131: 54202694
168,132: 49799866
168,133: 24930374
168,134: 17971642
168,135: 11130830
168,136: 8904682
168,137: 4913018
168,138: 3126502
168,139: 1574810
168,140: 1473382
168,141: 736694
168,142: 541162
168,143: 312470
168,144: 249994
168,145: 127286
168,146: 69898
168,147: 34952
168,148: 34708
168,149: 26038
168,150: 13994
168,151: 7000
168,152: 11720
168,153: 14740
168,154: 19532
168,155: 16588
168,156: 18692
168,157: 14026
168,158: 7016
168,159: 6154
168,160: 3674
168,161: 2374
168,162: 1190
168,163: 1402
168,164: 704
168,165: 820
168,166: 944
168,167: 916
168,168: 694
168,169: 350
168,170: 394
168,171: 200
168,172: 265
168,173: 59
168,174: 1
59
2856,0: 2856
2856,1: 5784
2856,2: 8736
2856,3: 19488
2856,4: 40992
2856,5: 84000
2856,6: 230496
2856,7: 475356
2856,8: 792484
2856,9: 1013852
2856,10: 1013908
2856,11: 1058092
2856,12: 1264340
2856,13: 2049964
2856,14: 2123576
2856,15: 2778664
2856,16: 3492536
2856,17: 3077104
2856,18: 2884816
2856,19: 3391568
2856,20: 3775384
2856,21: 3303476
2856,22: 3003244
2856,23: 2288756
2856,24: 1773484
2856,25: 1558964
2856,26: 1440718
2856,27: 720362
2856,28: 360184
2856,29: 376736
2856,30: 381028
2856,31: 285778
2856,32: 152990
2856,33: 122410
2856,34: 97946
2856,35: 48976
2856,36: 45946
2856,37: 22976
2856,38: 22744
2856,39: 19916
2856,40: 17716
2856,41: 14316
2856,42: 19116
2856,43: 31704
2856,44: 47616
2856,45: 83328
2856,46: 177792
2856,47: 295488
2856,48: 629072
2856,49: 589786
2856,50: 294896
2856,51: 358336
2856,52: 418904
2856,53: 366556
2856,54: 274924
2856,55: 275444
2856,56: 243760
2856,57: 376736
(14316 19116 31704 47616 83328 177792 295488 629072 589786 294896 358336 418904 366556 274924 275444 243760 376736 381028 285778 152990 122410 97946 48976 45946 22976 22744 19916 17716)


Create a new paste based on this one


Comments: