On 2024-02-26, HenHanna <HenHanna@gmail.com> wrote:
>           3 digit lock
>                        [682]: One number is correct and well-placed
>                        [614]: One number is correct but wrongly placed
>                        [206]: Two numbers are correct but wrongly placed
>                        [738]: Nothing is correct
>                        [780]: One number is correct but wrongly placed

$ txr lock.tl
(0 4 2)

Code in lock.tl:

(defmacro amb-scope (. forms)
  ^(block amb-scope ,*forms))

(defun amb (. args)
  (suspend amb-scope cont
    (each ((a args))
      (whenlet ((res (and a (call cont a))))
        (return-from amb-scope res)))))

(defsymacro all-ix #(0 1 2))

(defun well-placed (nc v1 v2 v3 n1 n2 n3)
  (let ((ixs (perm all-ix 3))
        (vv (vec v1 v2 v3))
        (vn (vec n1 n2 n3)))
    (some-true ((ix ixs))
      (and (each-true ((i 0..nc))
             (eql [vv [ix i]] [vn [ix i]]))
           (each-false ((i nc..3))
             (posql [vv [ix i]] vn))))))

(defun have-common (a b)
  (some-true ((x a) (y b)) (eq x y)))

(defun badly-placed (nc v1 v2 v3 n1 n2 n3)
  (let ((cixs (comb all-ix nc))
        (pixs (perm all-ix nc))
        (vv (vec v1 v2 v3))
        (vn (vec n1 n2 n3)))
    (some-true ((ix cixs))
      (let ((oixs (remove-if (op have-common ix) pixs))
            (nix (diff all-ix ix)))
        (some-true ((oix oixs))
          (and
            (each-true ((i ix)
                        (j oix))
              (eql [vv i] [vn j]))
            (each-false ((i nix))
              (posql [vv i] vn))))))))

(amb-scope
  (let ((n1 (amb 0 1 2 3 4 5 6 7 8 9))
        (n2 (amb 0 1 2 3 4 5 6 7 8 9))
        (n3 (amb 0 1 2 3 4 5 6 7 8 9)))
    (amb (well-placed 1 6 8 2 n1 n2 n3))
    (amb (badly-placed 1 6 1 4 n1 n2 n3))
    (amb (badly-placed 2 2 0 6 n1 n2 n3))
    (amb (well-placed 0 7 3 8 n1 n2 n3))
    (amb (badly-placed 1 7 8 0 n1 n2 n3))
    (prinl ^(,n1 ,n2 ,n3))
    nil))

> HINT -- A mark of a great puzzle,  this one contains a surprise or two.

Indeed; since it contains no surprise, it must contain two,
which it does.

-- 
TXR Programming Language: http://nongnu.org/txr
Cygnal: Cygwin Native Application Library: http://kylheku.com/cygnal
Mastodon: @Kazinator@mstdn.ca