Path: ...!3.eu.feeder.erje.net!feeder.erje.net!weretis.net!feeder8.news.weretis.net!eternal-september.org!feeder3.eternal-september.org!news.eternal-september.org!.POSTED!not-for-mail
From: "B. Pym" <Nobody447095@here-nor-there.org>
Newsgroups: comp.lang.lisp
Subject: Theater logic puzzle
Date: Tue, 13 Aug 2024 09:50:02 -0000 (UTC)
Organization: A noiseless patient Spider
Lines: 102
Message-ID: <v9fa84$3r4jo$1@dont-email.me>
MIME-Version: 1.0
Content-Type: text/plain; charset=iso-8859-1
Injection-Date: Tue, 13 Aug 2024 11:50:02 +0200 (CEST)
Injection-Info: dont-email.me; posting-host="a9f1b005a69e13fcf3adec886899440d";
	logging-data="4035192"; mail-complaints-to="abuse@eternal-september.org";	posting-account="U2FsdGVkX18atcW+GAFFTN1+0YAqrc7O"
User-Agent: XanaNews/1.18.1.6
Cancel-Lock: sha1:TLeGLwvNupnT8+mhba1BTfF0aGQ=
Bytes: 4810

stackoverflow.com/questions/78401940/prolog-code-wont-complete-due-to-computational-bug

newLISP

;;
;; Before the permutation is completely formed,
;; check for validity.
;;
;; n at a time.
(define (permute n__permute seq__permute func__permute
          (chk__permute or) (built__permute '()))
  (when (or (null? built__permute) (chk__permute built__permute))
    (if (or (zero? n__permute) (null? seq__permute))
      (func__permute built__permute)
      (dotimes (i__permute (length seq__permute))
        (unless (zero? i__permute) (rotate seq__permute -1))
        (permute (- n__permute 1)
          (rest seq__permute)
          func__permute
          chk__permute
          (append built__permute (0 1 seq__permute)))))))

(define (subtract lst0 lst1)  (difference lst0 lst1))

(define (in-this-order adjacent?)
  (let (screens
          (map
            (lambda(pair) (apply find pair))
            $args))
    (if (not (for-all true? screens)) 
      ;; If an item wasn't found, return true.
      true
      (let (test (if adjacent? (fn (n) (= 1 n)) (fn (n) (> n 0))))
        (for-all (lambda (xs) (test (apply - xs)))
          (map list
            (rest screens)
            (0 -1 screens)))))))

(define (in-sequence) (apply in-this-order (cons true $args)))
(define (in-order)    (apply in-this-order (cons nil $args)))

(define (do-titles genres)
  (letn ((title-names '(Brisbane Ellipsis Frostfire JetSet LongShot
            Pigeon Newton Gentleman Tower Vulture)))
    (permute -1 title-names
      (fn (titles)
        (println genres)
        (println titles)
        (++ cnt))  ;; Dynamic scope!
      (fn (titles  , a b c d) ;; Local variables: a b c d
        (and
          (or (< (length titles) 3) (member 'Tower (0 3 titles)))
          (in-sequence (list 'doc genres) (list 'Vulture titles))
          (in-sequence (list 'Newton titles) (list 'horror genres))
          ;; Not at same theater.
          (or (in-order (list 'Gentleman titles) (list 'scifi genres))
              (in-order (list 'scifi genres) (list 'Gentleman titles)))
          (in-sequence (list 'hist genres)
                                 (list 'Brisbane titles)
                                 (list 'LongShot titles))
          (in-sequence (list 'Gentleman titles)
                                 (list 'comedy genres)
                                 (list 'Frostfire titles))
          (in-sequence (list 'action genres)
                                 (list 'Ellipsis titles)
                                 (list 'scifi genres))
          (in-order (list 'Pigeon titles)
                              (list 'JetSet titles)
                              (list 'western genres))
          (begin
            (setq a (find 'Newton titles))
            (setq b (find 'Vulture titles))
            (setq c (find 'Gentleman titles))
            (setq d (find 'Tower titles))
            (if (for-all true? (list a b c d))
              (= (abs (- a b)) (abs (- c d)))
              true)))))))

(define (foo)
  (letn ((genre-names '(action comedy doc hist horror musical
                        romance spy scifi western))
         (genres1--3 '(action hist romance)) ;; In some order.
         (cnt 0))
    (permute -1 genre-names
      (fn (genres)
        (do-titles genres))
      (fn (genres)
        (and
          (or (< (length genres) 3) (= 3 (length (union (0 3 genres) genres1--3))))
          ;; The musical is playing on screen 4.
          (or (< (length genres) 4) (= 3 (find 'musical genres)))
          (in-order (list 'comedy genres) (list 'doc genres)))))
    (println "\nNumber of solutions: " cnt)))

(foo)

(hist romance action musical scifi horror comedy spy doc western)
(Tower Brisbane LongShot Ellipsis Newton Gentleman Pigeon
  Frostfire JetSet Vulture)

Number of solutions: 1