Primal Ages or how to know when you and your girlfriend are a power couple

5:20PM CDT | N41°40'54" W92°58'54"

I mentioned to Jacob how this year the prime factors in my age are greater now than they were last year. I just celebrated my 2*13th birthday. Jacob then mentioned how he does these types of calculations all the time as well. Particularly that last year would be probably the only time when his ages would be a perfect cube and Molly's a perfect square. I graphed y=X^3-2 and y=X^2 on the laptop and they do indeed only intersect once.


Jacob then decided a more interesting question was when are his and Molly's ages both of the form X^Y and P^Q respectively where X,Y,P, and Q are integers and Y>1 and Q>1. I wrote a program to calculate this for all possible differences in ages so that our readers and their mates can know when to celebrate their own primeversaries.

(require
 (lib "list.ss")
 (lib "etc.ss"))

(define (factors n)
  (let loop ([fact 2])
    (cond
      [(> fact n) '()]
      [(zero? (modulo n fact))
       (cons fact (loop (add1 fact)))]
      [else (loop (add1 fact))])))

#|
(list 'factors
      (equal? (factors 2) '(2))
      (equal? (factors 10) '(2 5 10))
      (equal? (factors 27) '(3 9 27)))
|#

(define (filter-for-prime lon)
  (cond
    [(null? lon) '()]
    [else (cons (car lon)
                (filter (lambda (x) (not (zero? (modulo x (car lon)))))
                        lon))]))

(define (has-one-prime-factor n)
  (let ([prime-factors (filter-for-prime (factors n))])
    (and (= 1 (length prime-factors))
         (not (equal? n (car prime-factors))))))

#|
(list 'has-one-prime-factor
      (eq? (has-one-prime-factor 2) #t)
      (eq? (has-one-prime-factor 27) #t)
      (eq? (has-one-prime-factor 25) #t)
      (eq? (has-one-prime-factor 10) #f))
|#

(define *age-expectancy* 120)

(define ages-with-one-prime-factor
  (let loop ([n 0])
    (if (>= n *age-expectancy*)
        '()
        (if (has-one-prime-factor n)
            (cons n (loop (add1 n)))
            (loop (add1 n))))))

(define (find-differences lon)
  (cond
    [(empty? lon) '()]
    [else (append (map (lambda (x) (list (- x (car lon)) 'at (car lon) 'and x)) (cdr lon))
                  (find-differences (cdr lon)))]))

(quicksort
 (find-differences ages-with-one-prime-factor)
 (lambda (a b) (< (car a) (car b))))