; phone numbers and prime factors
(define rand
(let* ((a 6364136223846793005)
(c 1442695040888963407)
(m 18446744073709551616)
(seed (current-time)))
(lambda args
(when (pair? args) (set! seed (modulo (car args) m)))
(set! seed (modulo (+ (* a seed) c) m))
(/ seed m))))
(define randint
(case-lambda
((n) (floor (* (rand) n)))
((first past) (+ (floor (* (rand) (- past first))) first))))
(define (uniq-c eql? xs)
(if (null? xs) xs
(let loop ((xs (cdr xs)) (prev (car xs)) (k 1) (result '()))
(cond ((null? xs) (reverse (cons (cons prev k) result)))
((eql? (car xs) prev) (loop (cdr xs) prev (+ k 1) result))
(else (loop (cdr xs) (car xs) 1 (cons (cons prev k) result)))))))
(define (last xs)
(if (or (null? xs) (null? (cdr xs))) xs
(last (cdr xs))))
(define (cycle . xs) (set-cdr! (last xs) xs) xs)
(define wheel
(cons 1 (cons 2 (cons 2 (cycle 4 2 4 2 4 6 2 6)))))
(define (factors n)
(let loop ((n n) (f 2) (w wheel) (fs (list)))
(if (< n (* f f)) (reverse (cons n fs))
(if (zero? (modulo n f)) (loop (/ n f) f w (cons f fs))
(loop n (+ f (car w)) (cdr w) fs)))))
(define (omega n)
(let loop ((fs (factors n)) (prev 0) (count 0))
(if (null? fs) count
(if (= (car fs) prev)
(loop (cdr fs) prev count)
(loop (cdr fs) (car fs) (+ count 1))))))
(define (rand-phone) (randint #e1e9 #e1e10))
(define (phones n)
(do ((n n (- n 1))
(xs (list) (cons (omega (rand-phone)) xs)))
((zero? n) (uniq-c = (sort xs <)))))
(display (phones 100)) (newline)