(load "mk.scm")
(load "mkextraforms.scm")
(load "mkprelude.scm")

#|
A Sequence Program

Arrange three 1s, three 2s, ..., three 9s in sequence so that for all
i in [1, 9] there are exactly i numbers between successive occurrences
of i. An example of such a sequence is 1, 9, 1, 2, 1, 8, 2, 4, 6, 2,
7, 9, 4, 5, 8, 6, 3, 4, 7, 5, 3, 9, 6, 8, 3, 5, 7.

The problem is taken from
K.R. Apt, "The Logic Programming Paradigm and Prolog".
(Chapter 15 in Concepts in Programming Languages , J. Mitchell,
Cambridge University Press (2002).
available online at http://homepages.cwi.nl/~apt/ps/lp00.ps

|#

;; make a fresh sequence of length n
(define (make-sequence n out)
  (if (= n 0)
      (== '() out)
      (fresh (x res)
        (make-sequence (- n 1) res)
        (conso x res out))))
#|
(run* (out) (make-sequence 10 out))
; ((_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9))
|#

(define (list-refo lst index out)
  (if (= index 0) 
      (caro lst out)
      (fresh (d)
        (cdro lst d)
        (list-refo d (- index 1) out))))
#|
(run* (q) (list-refo '(a b c) 2 q))
; (c)

(run* (q) (list-refo '(a b c) 3 q))
; ()
|#

;; whether the item a appears in seq at 0, next, 2*next, ...,
;; times*next
;; also fails if the seq is too short
(define (is-starting-here? a seq next times)
  (let loop ((index 0) (times times))
    (if (= times 0)
        succeed
        (all
         (list-refo seq index a)
         (loop (+ index next) (- times 1))))))
#|
(run* (q) (is-starting-here? 'a '(a b c a b c) 3 2))
;(_.0)

(run* (q) (is-starting-here? 'a '(a b c a b c) 3 3))
;()

(run* (q) (is-starting-here? 'a '(x a b c a b c) 3 2))
;()
|#

;; whether the item a appears in seq at i+0, i+next, i+2*next, ...,
;; i+times*next for some i
(define (is-anywhere? a seq next times)
  (let loop ((seq seq))
    (condi ((nullo seq) fail)
           ((is-starting-here? a seq next times) succeed)
           (else (fresh (d)
                   (cdro seq d)
                   (loop d))))))
#|
(run* (q) (is-anywhere? 'a '(a b c a b c) 3 2))
;(_.0)

(run* (q) (is-anywhere? 'a '(a b c a b c) 3 3))
;()

(run* (q) (is-anywhere? 'a '(x a b c a b c a b c) 3 2))
;(_.0 _.0)
|#

;; whether the sequence contains a sublist which contains
;; times n's, the n's being separated by n other items each
(define (number-sublist? n times seq)
  (is-anywhere? n seq (+ n 1) times))
#|
(run* (q) (number-sublist? 1 3 '(1 x 1 x 1)))
;(_.0)

(run* (q) (number-sublist? 1 4 '(1 x 1 x 1)))
;()

(run* (q) (number-sublist? 2 3 '(2 x y 2 a b 2)))
;(_.0)
|#

;; checks (number-sublist? n times seq) for all n, from<=n<to
(define (all-numbers-sublist? from to times seq)
  (if (= from to)
      succeed
      (all
       (number-sublist? from times seq)
       (all-numbers-sublist? (+ from 1) to times seq))))
#|
(run* (q) (all-numbers-sublist? 1 3 2 '(1 2 1 x 2)))
;(_.0)

(run* (q) (all-numbers-sublist? 1 4 2 '(1 2 1 3 2)))
;()
|#

;; generate a sequence program of length times*(to-from) where each
;; number n, from<=n<to appears the given number of times according to
;; the program rule
(define (sequence-program from to times out)
  (all
   (make-sequence (* times (- to from)) out)
   (all-numbers-sublist? from to times out)))
#|
(run 1 (out) (sequence-program 1 10 3 out))
; ((1 9 1 2 1 8 2 4 6 2 7 9 4 5 8 6 3 4 7 5 3 9 6 8 3 5 7))

(run* (out) (sequence-program 1 4 2 out))
; ((3 1 2 1 3 2) (2 3 1 2 1 3))
|#

;; generates the sequence program posed in the problem
;; all digits, three times each
(define (canonical-sequence-program out)
  (sequence-program 1 10 3 out))

#|
(run 1 (out) (canonical-sequence-program out))
; ((1 9 1 2 1 8 2 4 6 2 7 9 4 5 8 6 3 4 7 5 3 9 6 8 3 5 7))

(run* (out) (canonical-sequence-program out))
;((1 9 1 2 1 8 2 4 6 2 7 9 4 5 8 6 3 4 7 5 3 9 6 8 3 5 7)
; (1 8 1 9 1 5 2 6 7 2 8 5 2 9 6 4 7 5 3 8 4 6 3 9 7 4 3)
; (1 9 1 6 1 8 2 5 7 2 6 9 2 5 8 4 7 6 3 5 4 9 3 8 7 4 3)
; (3 4 7 8 3 9 4 5 3 6 7 4 8 5 2 9 6 2 7 5 2 8 1 6 1 9 1)
; (3 4 7 9 3 6 4 8 3 5 7 4 6 9 2 5 8 2 7 6 2 5 1 9 1 8 1)
; (7 5 3 8 6 9 3 5 7 4 3 6 8 5 4 9 7 2 6 4 2 8 1 2 1 9 1))
|#

;; alternative definition of number-sublist?
;; closer to the Prolog example
;; uses helpers defined below
#|
(define (number-sublist? n times seq)
  (fresh (sub)
    (generate-number-list n times sub)
    (sublist? sub seq)))
|#

;; whether xs is a sublist of ys
(define (sublist? xs ys)
  (fresh (zs a b)
    (appendo a zs ys)
    (appendo xs b zs)))
#|
(run* (q) (sublist? '(b) '(a b c)))
; (_.0)

(run* (q) (sublist? '(b d) '(a b c)))
; ()
|#

;; generate a list where number is at positions
;; 0, (number+1), ..., times*(number+1)
;; and the other items are fresh
(define (generate-number-list number times out)
  (let ((interval (+ number 1)))
    (let loop ((index 0) (times times) (out out))
      (if (= times 0)
          (== '() out)
          (fresh (res x)
            (if (= index 0)
                (== x number)
                succeed)
            (loop (remainder (+ index 1) interval)
                  (- times (if (= index 0) 1 0))
                  res)
            (conso x res out))))))
#|
(run* (out) (generate-number-list 1 3 out))
; ((1 _.0 1 _.1 1))

(run* (out) (generate-number-list 4 3 out))
; ((4 _.0 _.1 _.2 _.3 4 _.4 _.5 _.6 _.7 4))
|#