#!r6rs
(import (rnrs base (6))
        (rnrs io simple (6))
        (IntSeq Utils list-extra-intlists) ;; for iota0 and iota1, e.g. say: (map A260643 (iota1 75))
        (IntSeq Memoize memoize-definec)
        (IntSeq Transforms transforms-core)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                                                                           ;;
;; Scheme-program for computing the terms of A260643-spiral of Peter Kagey.  ;;
;; See http://oeis.org/A260643                                               ;;
;; Now also the positions of records (A265414) and ones (A265415).           ;;
;;                                                                           ;;
;; Written by Antti Karttunen, December 09 2015.                             ;;
;; IntSeq-library is available at https://github.com/karttu/IntSeq           ;;
;;                                                                           ;;
;; So far this module is stand-alone in terms of OEIS-sequences,             ;;
;; but it still needs the memoizing definec-macro from                       ;;
;;                                                                           ;;
;; https://github.com/karttu/IntSeq/tree/master/src/Memoize                  ;;
;;                                                                           ;;
;; and LEFTINV-LEASTMONO and LEFTINV-LEASTMONO-NC2NC transforms from         ;;
;; (also RECORD-POS and ZERO-POS etc.)                                       ;;
;; https://github.com/karttu/IntSeq/tree/master/src/Transforms               ;;
;;                                                                           ;;
;; 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 module uses the same CC BY-NC 3.0 license.                     ;;
;;                                                                           ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;; (declare (usual-integrations)) ;; This was for MIT/GNU Scheme.


;; Note: The following functions should be eventually transferred to the following modules:
;;  IntSeq/Seqs/Squares/squares-core.ss
;;  IntSeq/Seqs/Squares/squares-quarter.ss
;;  IntSeq/Seqs/Squares/squares-spirals.ss

(define (A000290 n) (* n n)) ;; o=0: The squares: a(n) = n^2.

(define A000196 (LEFTINV-LEASTMONO-NC2NC 0 0 A000290)) ;; o=0: Integer part of square root of n. Or, number of squares <= n. Or, n appears 2n+1 times. 

(define (A016813 n) (+ (* 4 n) 1)) ;; o=0: a(n) = 4n + 1. /XFER: IntSeq/Seqs/???

(define (A000267 n) (A000196 (A016813 n))) ;; o=0: Integer part of square root of 4n+1.

;; The following three functions, A002265, A002620 and A033638 are not actually needed by this program,
;; thus commented out:

;;
;; (define (A002265 n) (floor->exact (/ n 4))) ;; o=0: Integers repeated 4 times. 
;;
;; (define (A002620 n) (A002265 (A000290 n))) ;; o=0: Quarter-squares: floor(n/2)*ceiling(n/2). Equivalently, floor(n^2/4).
;;
;; (define (A033638 n) (+ 1 (A002620 n))) ;; o=0: Quarter-squares plus 1 (that is, A002620 + 1).
;;

(define (A240025 n) (if (zero? n) 1 (- (A000267 n) (A000267 (- n 1))))) ;; o=0: Characteristic function of quarter squares, cf. A002620.

(define (A265411 n) (cond ((zero? n) 1) ((= 1 n) 7) ((= 1 (A240025 (- n 1))) 3) (else 1))) ;; o=0: a(0) = 1, a(1) = 7, otherwise, if A240025(n-1) = 1 [when n is in A033638] a(n) = 3, otherwise a(n) = 1. 

(definec (A265412 n) (if (zero? n) 1 (+ (A265411 n) (A265412 (- n 1))))) ;; o=0: Partial sums of A265411.

(define (A265413 n) (if (zero? n) 1 (+ 1 (A265412 (- n 1))))) ;; o=0: Positions of records in A265410: a(0) = 1; for n >= 1, a(n) = 1 + A265412(n-1).

(define A265410 (LEFTINV-LEASTMONO 1 0 A265413)) ;; o=1: a(n) = one-based index to the nearest horizontally or vertically adjacent inner neighbor in square-grid spirals, and to the nearest diagonally adjacent inner neighbor when n is one of the corner cases A033638. 

(define (A265400 n) (if (= 1 (A240025 (- n 1))) 0 (A265410 n))) ;; o=1: a(n) = one-based index to the nearest horizontally or vertically adjacent inner neighbor in square-grid spirals, or 0 if n is one of the corner cases A033638. 


;; An auxiliary function for A260643. If there are any zeros present, then return always #f,
;; because then some components of pairs have been fetched from the "nonexistent location"
;; with A260643(A265400(n)), i.e. from A260643(0), which is tacitly defined as 0 in this implementation.

(define (u-pairs-same-no-zeros? a0 a1 b0 b1)
  (and (not (zero? a0)) (not (zero? a1)) (not (zero? b0)) (not (zero? b1))
       (or (and (= a0 b0) (= a1 b1)) (and (= a0 b1) (= a1 b0)))
  )
)


;;
;; Here we tacitly assume that A260643(0) = 0, to avoid extra checks when A265400 returns zero.
;; Also, by using memoizing-macro definec, this is not so slow as otherwise one might think of.
;; But it's still quadratic (at least), or sort of ..., and yes, it is so slow.
;;
;; Yes, of course we should use a hash-table for storing all the pairs so far encountered,
;; however this works as a kind of reference-definition for A260643 and is a proof-of-concept
;; that I understood correctly how A260643 is computed. (At least the first 1025 terms match
;; with the start of the original 10000 term b-file provided by Peter Kagey).
;;

(definec (A260643 n)
  (if (<= n 1) n
     (let ((b0 (A260643 (- n 1))) (b1 (A260643 (A265400 n))))
;; Candidate k will be chosen if neither pair {k,b0} and {k,b1} occur anywhere in the spiral constructed so far.
        (let outerloop ((k 1))
          (if (or (= k b0) (= k b1))
              (outerloop (+ k 1)) ;; Would be equal to either neighbour, skip this k.
;; Otherwise start checking whether either {k,b0} or {k,b1} already occur somewhere:
              (let innerloop ((j (- n 1)))
                (let ((c0 (A260643 j))
                      (c1 (A260643 (- j 1)))
                      (c2 (A260643 (A265400 j)))
                     )
                   (cond ((= 1 j) k) ;; No conflicting pairs found, return the least conflict-free k found.
                         ((u-pairs-same-no-zeros? k b0 c0 c1) (outerloop (+ 1 k)))
                         ((u-pairs-same-no-zeros? k b0 c0 c2) (outerloop (+ 1 k)))
                         ((u-pairs-same-no-zeros? k b1 c0 c1) (outerloop (+ 1 k)))
                         ((u-pairs-same-no-zeros? k b1 c0 c2) (outerloop (+ 1 k)))
                         (else (innerloop (- j 1)))
                   )
                )
              )
          )
        )
     )
  )
)

(define A265414 (RECORD-POS 1 1 A260643)) ;; o=1: a(n) = point where A260643 for the first time obtains value n.

(define A265415 (ZERO-POS 1 1 (COMPOSE sub1 A260643))) ;; o=1: Positions of ones in A260643.