Theater logic puzzle

Liste des GroupesRevenir à cl lisp 
Sujet : Theater logic puzzle
De : Nobody447095 (at) *nospam* here-nor-there.org (B. Pym)
Groupes : comp.lang.lisp
Date : 13. Aug 2024, 11:50:02
Autres entêtes
Organisation : A noiseless patient Spider
Message-ID : <v9fa84$3r4jo$1@dont-email.me>
User-Agent : XanaNews/1.18.1.6
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


Date Sujet#  Auteur
13 Aug 24 o Theater logic puzzle1B. Pym

Haut de la page

Les messages affichés proviennent d'usenet.

NewsPortal