;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                                                                           ;;
;; Scheme-program for computing A293900, a variant of Leroy Quet's A163820.  ;;
;; See https://oeis.org/A293900                                              ;;
;;                                                                           ;;
;; A293900 Number of permutations of the divisors of n that are greater      ;;
;; than 1, in which consecutive elements are not coprime and no divisor d    ;;
;; may occur later than any divisor e if e < d and A007947(e) = A007947(d).  ;;
;; That is, any subset of divisors sharing the same squarefree part occur    ;;
;; always in ascending order inside the permutation.                         ;;
;;                                                                           ;;
;; The idea for this sequence came to me after reading an e-mail sent to me  ;;
;; by David Corneth Oct 22 2017, concerning how to optimize the computation  ;;
;; of A163820.                                                               ;;
;;                                                                           ;;
;; Written by Antti Karttunen, 2017-10-22.                                   ;;
;; (Note: this is just for demonstrating the definition. Code might be       ;;
;;  far from optimal in its current state!)                                  ;;
;;                                                                           ;;
;; The OEIS-sequence data (also defs & programs) has been submitted as per   ;;
;;   http://oeis.org/wiki/The_OEIS_Contributor's_License_Agreement           ;;
;; and it is made available with                                             ;;
;;   http://oeis.org/wiki/The_OEIS_End-User_License_Agreement                ;;
;; which uses the Creative Commons Attribution Non-Commercial 3.0 license    ;;
;;   http://creativecommons.org/licenses/by-nc/3.0/                          ;;
;;                                                                           ;;
;; Thus, this source file uses the same CC BY-NC 3.0 license.                ;;
;;                                                                           ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;
;; Because the values of sequence depends only on the prime-signature of n, it is enough
;; to actually compute it only for values of A025487 (least integer of each prime signature).
;; To do that, change the following definition of A293900 to use definec (instead of define)
;; (see http://oeis.org/wiki/Memoization#Scheme for its implementation)
;; and uncomment the lines beginning with ;; in it.
;; An implementation of A046523 can be found under https://github.com/karttu/IntSeq
;;

(define (A293900 n)
;;  (let ((fr (A046523 n)))
;;    (if (< fr n) ;; If the first representative of this prime signature is less < n,
;;        (A293900 fr) ;; then dig the result from the memoized cache.
          (let ((pds (proper-divisors n)))
            (fold-left
               (lambda (s d) (+ s (A293900apu d (delete d pds))))
               0
               (remove-nonleast-representatives pds)
            )
          )
;;    )
;;  )
)

;; Gives the number of possible ways to construct a list that begins with d
;; and which is then followed by some other divisor e found from rest-of-divs
;; such that gcd(d,e) > 1, and that gcd(e,f) > 1, gcd(f,g) > 1, etc. where
;; f, g, etc. are the rest of divisors in the arrangement, and FURTHERMORE,
;; that no g may occur later than any k = f, e or d if g < k and A007947(g) = A007947(k).
;; (That is, the divisors sharing the same squarefree part occur always in ascending order).

(define (A293900apu d rest-of-divs)
   (if (null? rest-of-divs) ;; If no more divisors, then we have found one way to arrange divisors.
       1
       (let ((pnos (possible-successors d rest-of-divs))) ;; pnos = possible next-ones (successors)
;;       (if (null? (cdr rest-of-divs))
;;           (length pnos) ;; An optimization for cases where only one divisor left.
             (let loop ((possible-next-ones pnos)
                        (s 0)
                       )
                 (cond ((null? possible-next-ones) s) ;; Finished the list of possible-next-ones, return the sum.
                       (else
                          (loop (cdr possible-next-ones)
                                (+ s (A293900apu (car possible-next-ones)
                                                 (delete (car possible-next-ones) rest-of-divs)
                                     )
                                )
                          )
                       )
                 )
             )
;;       )
       )
   )
)


;; (define (A293902 n) (if (= 1 n) n (/ (A163820 n) (A293900 n)))) ;; Should have a more straightforward definition.


(define (possible-successors d rest-of-divs)
   (remove-nonleast-representatives (divisors-noncoprime-with d rest-of-divs))
)


(define (divisors-noncoprime-with d rest-of-divs) (remove (lambda (e) (= 1 (gcd d e))) rest-of-divs))

;; In other words, append together all lists obtained by filtering divisors e >= d (with A007947(e) = A007947(d)
;; for each divisor d present in rest-of-divs:

;; Remove such divisors e for which the exists any other divisor f such that f < e and A007947(f) = A007947(e).
;; Note that (remove-nonleast-representatives (iota up_to_some_n)) gives A005117, squarefree numbers.

(define (remove-nonleast-representatives rest-of-divs)
   (remove (lambda (e)
             (let ((esfr (A007947 e)))
               (not (null? (filter (lambda (f) (and (< f e) (= (A007947 f) esfr))) rest-of-divs)))
             )
           )
           rest-of-divs
   )
)



(define (proper-divisors n)
  (let loop ((k n) (divs (list)))
     (cond ((= 1 k) divs)
           ((zero? (modulo n k)) (loop (- k 1) (cons k divs)))
           (else (loop (- k 1) divs))
     )
  )
)

(define (divisors n) (cons 1 (proper-divisors n)))


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


;; Use definec instead of define to make use of these bearable.

(define (A007947 n) (if (= 1 n) n (* (A020639 n) (A007947 (A028234 n)))))

(define (A020639 n) ;; Lpf(n): least prime dividing n (with a(1)=1).
  (if (= 1 n)
      1
      (let loop ((k 2))
           (cond ((zero? (modulo n k)) k)
                 (else (loop (+ 1 k)))
           )
      )
  )
)


(define (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)))
          )
        )
      )
  )
)

(define (A028234 n) (/ n (A028233 n)))