Colors Pascal's triangle by the largest prime factor

pascal_primes.rkt

#lang racket
(require pict)
(require racket/draw)
(require racket/fixnum)

(define (slop f l)
  (cond
    ((null? l) '())
    (#t (cons (f l) (slop f (cdr l))))))

(define (repeat n times)
  (if (zero? times)
      '() 
      (cons n (repeat n (sub1 times)))))
(define (flip f) (lambda (x y) (f y x)))
(define (take-pad padding l n)
  (cond
    [(zero? n)
     '()]
    [(null? l)
     (repeat padding n)]
    [else 
     (cons (car l) (take-pad padding (cdr l) (- n 1)))]))

(define (moving-window l f w [e 0])
  (let ([embedding (repeat e (sub1 w))])
    (slop (compose f (curry (flip (curry take-pad e)) w)) (append embedding l))))

(define (triangle n)
  (define (helper l d)
    (cons l ((if (zero? d)
                 list
                 (lambda (x) (helper x (sub1 d))))
             (moving-window l (lambda (x) (+ (first x) (second x))) 2 0))))
  (helper '(1) n))
(define (gp n)
  (if (and (> n 3) (even? n))
      (gp (fxrshift n 1))
      (let loop ([n n]
                 [k 3]
                 [k2 9]
                 [delta 16])
        (if (> k2 n)
            n
            (if (zero? (remainder n k))
                (loop (quotient n k) k k2 delta)
                (if (< (+ k2 delta 2) delta)
                    n
                    (loop n (+ k 2) (+ k2 delta) (+ delta 8))))))))
(define (b l)
  (for/list ([x l])
    (for/list ([y x])
      (gp y))))
(define (iterate f i n)
  (let ((r (f i)))
    (cond
      ((zero? n) '())
      (#t (cons i (iterate f r (sub1 n)))))))
(define (tl n [radius 10])
  (if (zero? n)
      (blank)
      (hc-append (filled-ellipse radius radius) (tl (sub1 n) radius))))
(define (pyramid depth)
  (define (helper n)
    (if (eq? n depth)
        (blank)
        (vc-append (tl n 4) (helper (add1 n)))))
  (helper 0))
(define (tln n items)
  (foldr hc-append (blank) items))
(define (pyramidn items depth)
  (define (helper items n)
    (if (eq? n depth)
        (blank)
        (vc-append (tln n (take items n)) (helper (drop items n) (add1 n)))))
  (helper items 0))
(define h (make-hash))
;(define colors #("red" "blue" "green" "cyan" "magenta" "yellow" "orange" "CadetBlue" "Purple" "PaleGreen"))
(define colors (list->vector (iterate (curry scale-color 1.1) "black" 30)))
(define cindex 0)
(define (moo l picts)
  (if (null? l)
      '()
      (cons (begin (when (not (dict-has-key? h (first l)))
                 (begin (dict-set! h (first l) (vector-ref colors cindex))
                        (set! cindex (add1 cindex))))
             (colorize (first picts) (dict-ref h (first l))))
            (moo (rest l) (rest picts)))))
(define mynums (flatten (b (triangle 40))))
(define tool (moo mynums (build-list (length mynums) (lambda (x) (filled-rectangle 10 10)))))
(pyramidn tool 40)