#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)