#lang racket

;;
;; Racket-program to compute sequences A286594, A300227, A300228, A300234, A300237, A300238.
;; Written by Antti Karttunen, March 2 2018, using also older code. (E.g. for A000203).
;;
;; See also https://github.com/karttu/IntSeq/
;;
;; Works at least in Racket version 6.2.1. (You might need to set the memory limit to unlimited or at least larger than 128MB).
;;

;; First the machinery for memoization-macro definec:

;; Added this 10. July 2002 to avoid allocation catastrophes
;; caused by the careless use of cached integer functions:
(define *MAX-CACHE-SIZE-FOR-DEFINEC* 362881) ;; Was: 290512) ;; Was 131072



(define-syntax definec
  (syntax-rules ()
   ((definec (name arg) e0 ...)
      (define name
        (implement-cached-function *MAX-CACHE-SIZE-FOR-DEFINEC* (name arg) e0 ...)
      ) ;; (define name ...)
   )
  ) ;; syntax-rules
)

(define-syntax grow-cache
  (syntax-rules ()
   ((grow-cache cachename arg) ;; No maxsize specified.
      (vector-grow cachename (max (+ 1 arg) (* 2 (vector-length cachename))))
   )
   ((grow-cache cachename arg 0) ;; Or specified as zero.
      (vector-grow cachename (max (+ 1 arg) (* 2 (vector-length cachename))))
   )
   ((grow-cache cachename arg maxsize)
      (vector-grow cachename (min maxsize (max (+ 1 arg) (* 2 (vector-length cachename)))))
   )
  )
)

(define-syntax implement-cached-function
  (syntax-rules ()
   ((implement-cached-function maxcachesize (funname argname) e0 ...)
        (letrec
           ((_cache_ (vector #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f))
            (funname
             (lambda (argname)
               (cond ((null? argname) _cache_) ;; For debugging.
                     ((vector? argname) argname) ;; As well as this: Caches for caches!
                     ((and (not (= 0 maxcachesize)) (>= argname maxcachesize))
                          e0 ...
                     )
                     (else
                       (begin
                         (cond ((>= argname (vector-length _cache_))
                                  (set! _cache_ (grow-cache _cache_ argname maxcachesize))
                               )
                         )
                         (or (vector-ref _cache_ argname)
                             ((lambda (res)
                                (vector-set! _cache_ argname res)
                                res
                              )
                               (begin e0 ...)
                             )
                         )
                       )
                     )
               ) ; cond
             )
            )
           ) ; letrec-definitions
          funname
        ) ; letrec
   )
  )
)


;; MIT/GNU Scheme has a function vector-grow
;; For some other Schemes you need to implement it separately.
;; Here is one implementation from
;; https://github.com/karttu/IntSeq/blob/master/src/utils/vector-grow.scm
;; 
(define (vector-grow old-vec new-size)
   (let ((new-vec (make-vector new-size #f))
         (old-size (vector-length old-vec))
        )
     (let copyloop ((i 0))
          (cond ((= i old-size) new-vec)
                (else
                   (begin
                      (vector-set! new-vec i (vector-ref old-vec i))
                      (copyloop (+ 1 i))
                   )
                )
          )
     )
   )
)

(define (1+ n) (+ 1 n)) ;; Useful...

;; A000010 (Euler phi): Multiplicative with a(p^e) = (p-1)*p^(e-1). 

(definec (A000010 n)
    (if (= 1 n)
        n
        (let ((p (A020639 n)) (e (A067029 n)))
           (*  (- p 1) (expt p (- e 1)) (A000010 (A028234 n)))
        )
    )
)

;; The new recursive version that doesn't need any of the factorization machinery, thus no extra libraries:

(definec (A000203 n)
    (if (= 1 n)
        n
        (let ((p (A020639 n)) (e (A067029 n)))
           (* (/ (- (expt p (+ 1 e)) 1) (- p 1)) (A000203 (A028234 n)))
        )
    )
)


;; A020639 [David W. Wilson] Lpf(n): least prime dividing n (with a(1)=1).
;; This implementation might seem excessively naive, but actually, because of the memoization
;; it works fine when used repeatedly with not too large arguments.
;; It is the function that actually offers the "factorization service" for these implementations.

(definec (A020639 n)
  (if (< n 2)
      n
      (let loop ((k 2))
           (cond ((zero? (modulo n k)) k)
                 (else (loop (+ 1 k)))
           )
      )
  )
)


;; A028233 [Marc LeBrun] o=1: If n = p_1^e_1 * ... * p_k^e_k, p_1 < ... < p_k primes, then a(n) = p_1^e_1
(definec (A028233 n)
  (if (< n 2)
      n
      (let ((lpf (A020639 n)))
        (let loop ((m lpf) (n (/ n lpf)))
          (cond ((not (zero? (modulo n lpf))) m)
                (else (loop (* m lpf) (/ n lpf)))
          )
        )
      )
  )
)


;; A028234 [Marc LeBrun] o=1: If n = p_1^e_1 * ... * p_k^e_k, p_1 < ... < p_k primes, then a(n) = n/p_1^e_1. 
(define (A028234 n) (/ n (A028233 n)))

;; A032742 [Patrick De Geest] o=1: a(1) = 1; for n > 1, a(n) = largest proper divisor of n.
(define (A032742 n) (/ n (A020639 n))) ;; a(1) = 1; for n > 1, a(n) = largest proper divisor of n.


;; A067029 [Reinhard Zumkeller] o=1: Exponent of least prime factor in prime factorization of n, a(1)=0

(definec (A067029 n)
  (if (< n 2)
      0
      (let ((mp (A020639 n)))
        (let loop ((e 0) (n (/ n mp)))
          (cond ((integer? n) (loop (+ e 1) (/ n mp)))
                (else e)
          )
        )
      )
  )
)



;;
;; That's all for now folks! There are many, many other sequences that can be easily defined
;; by using just those A020639, A028233, A028234 and A067029. I might add them here one day.
;;

;; A285721(n,k) = if(n==k, 0, 1 + A285721(abs(n-k),min(n,k)));
;; A300227(n) = if(1==n,n,A285721(n,sigma(n)-1));

(define (A285721 n k) (if (= n k) 0 (+ 1 (A285721 (abs (- n k)) (min n k)))))

(define (A286594 n) (A285721 n (A000203 n)))

(define (A300227 n) (if (= 1 n) n (A285721 n (- (A000203 n) 1))))

(define (A300228 n) (A285721 n (+ 1 (A000010 n))))


(definec (A300234 n) (A285721 n (A000010 n)))

(define (A300237 n) (- n (A286594 n)))

(define (A300238 n) (- n (A300234 n)))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(require racket/format)

(define (Anum->str num) (~a num #:min-width 6 #:align 'right #:pad-string "0"))


(define (compute-b-file Afun outfile start upto-n)
   (call-with-output-file outfile
     (lambda (outport)
       (let loop ((n start) (z (Afun start)))
;;        (format "n=~A: ~A~%" n z)
          (display (format "~A ~A~%" n z) outport)
          (flush-output outport)
          (cond ((< n upto-n) (loop (1+ n) (Afun (+ 1 n)))))
       )
     )
   )
)

;; Create b-files:

(compute-b-file A286594 "seqs/b286594.txt" 1 65537)

(compute-b-file A300227 "seqs/b300227.txt" 1 65537)
(compute-b-file A300228 "seqs/b300228.txt" 1 65537)

(compute-b-file A300234 "seqs/b300234.txt" 1 65537)
(compute-b-file A300237 "seqs/b300237.txt" 1 65537)
(compute-b-file A300238 "seqs/b300238.txt" 1 65537)