Skip to content

Commit

Permalink
Mastermind fixes (#328)
Browse files Browse the repository at this point in the history 
* Fix maybe-remove.

* Clarify player-to-guess at each turn.

---------

Co-authored-by: porcuquine <[email protected]>
  • Loading branch information
@porcuquine
porcuquine and porcuquine authored Oct 4, 2024
1 parent f1cc943 commit de4f6c7
Showing 1 changed file with 75 additions and 37 deletions.
112 changes: 75 additions & 37 deletions demo/mastermind.lurk
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,18 +2,29 @@
;;; Each player simultaneously takes on the role of codemaker and codebreaker.
;;;

!(defrec length (lambda (l) (if l (+ 1 (length (cdr l))) 0)))

;; Tries to remove the first instance of elt from list and returns (removed? . remaining).
;; removed? is true if elt was removed.
;; remaining is a list of the remaining elements (in reverse order) whether or not elt was removed.
;; If elt occurs one than once in list, only the first occurrence is removed.
!(def maybe-remove (lambda (elt list)
(letrec ((aux (lambda (removed? acc elt list)
(if list
(letrec ((aux (lambda (removed? acc elt list remaining)
(if (> remaining 0)
(if (eq elt (car list))
(aux t acc elt (if removed? list (cdr list)))
(aux removed? (cons (car list) acc) elt (cdr list)))
(aux t
(if removed? (cons (car list) acc) acc)
elt
(if removed? list (cdr list))
(- remaining 1))
(aux removed? (cons (car list) acc) elt (cdr list) (- remaining 1)))
(cons removed? acc)))))
(aux nil () elt list))))
(aux nil () elt list (length list)))))

!(assert-eq '(t 3 2) (maybe-remove 1 '(1 2 3)))
!(assert-eq '(t 3 2) (maybe-remove 1 '(2 1 3)))
!(assert-eq '(nil 3 2 1) (maybe-remove 4 '(1 2 3)))
!(assert-eq '(t 3) (maybe-remove 3 '(3 3)))

;; Returns (hits . partial-hits).
;; hits is the number of positions at which code and guess match.
Expand All @@ -39,6 +50,8 @@

!(assert (eq '(2 . 0) (score '(1 2 3 4) '(5 2 3 5))))

(score '(3 1 4 1) '(1 1 3 3))

!(defrec length (lambda (list)
(if list
(+ 1 (length (cdr list)))
Expand Down Expand Up @@ -91,38 +104,36 @@
(letrec ((play-one-round
(lambda (round guess2 guess1)
(let ((score (g2 guess2))) ; Player 1's guess scored on g2, player 2's game. Hence guess2.
(begin
(ensure-valid-code guess1)
(if (eq score :correct)
(cons :advantage-1
(lambda ()
(let ((score (g1 guess1))) ;; Player 2's guess scored on g1, player 1's game. Hence guess1.
(cons (if (eq score :correct) :draw :winner-1) nil))))
(cons score
(lambda (guess2)
(begin
(ensure-valid-code guess2)
(let ((score (g1 guess1))) ;; Player 2's guess scored on g1, player 1's game. Hence guess1.
(if (= round max-rounds)
(cons (if (eq score :correct)
:winner-2
;; This could just be :draw, if the enclosing protocol won't distinguish types of draw.
;; Doing so initially is useful for testing.
:draw-max)
nil)
(if (eq score :correct)
(cons :winner-2 nil)
;; On subsequent iterations, we have only player 1's guess (guess2).
;; The partial application yields a continuation function that will receive player 2's guess (guess1).
(cons score (play-one-round (+ 1 round) guess2))))))))))))))
(ensure-valid-code guess1)
(if (eq score :correct)
(cons :advantage-1
(lambda ()
(let ((score (g1 guess1))) ;; Player 2's guess scored on g1, player 1's game. Hence guess1.
(cons (if (eq score :correct) :draw :winner-1) nil))))
(cons (cons :player-1-to-guess score)
(lambda (guess2)
(ensure-valid-code guess2)
(let ((score (g1 guess1))) ;; Player 2's guess scored on g1, player 1's game. Hence guess1.
(if (= round max-rounds)
(cons (if (eq score :correct)
:winner-2
;; This could just be :draw, if the enclosing protocol won't distinguish types of draw.
;; Doing so initially is useful for testing.
:draw-max)
nil)
(if (eq score :correct)
(cons :winner-2 nil)
;; On subsequent iterations, we have only player 1's guess (guess2).
;; The partial application yields a continuation function that will receive player 2's guess (guess1).
(cons (cons :player-2-to-guess score) (play-one-round (+ 1 round) guess2))))))))))))
;; On first iteration, we have already received both guesses.
(play-one-round 1 guess2 guess1))))

!(def init-game
;; Game is initialized with commitments to codes from both players.
(lambda (code-comm1 code-comm2 expected-code-length num-choices max-rounds)
(let ((ensure-valid-code (make-code-validator expected-code-length num-choices)))
(cons :player-1-guess ; prompt
(cons :player-1-to-guess ; prompt
;; Somewhat confusingly, guess2 is player 1's first guess. See comment in play.
(lambda (guess2)
(begin
Expand All @@ -139,7 +150,7 @@
(cons :draw nil)
(cons :winner-2 nil))))
;; Player 2 provides guess1 (named that because it is input to game1).
(cons :player-2-guess ; prompt
(cons :player-2-to-guess ; prompt
(lambda (guess1)
;; game-2 is played by player 2.
;; Only player 2 will be able to prove this, due to make-scoring-fn's interface.
Expand All @@ -148,6 +159,29 @@
(cons :winner-1 nil)
(play ensure-valid-code game1 game2 guess2 guess1 max-rounds)))))))))))))

;; Debugging game with Arthur

;; Note commitment created with hide to avoid brute-force attack.
!(def regression (init-game (hide #0x99887766 '(4 2 2 3)) (hide #0x1234 '(3 1 4 1)) 4 6 20))
!(assert-eq :player-1-to-guess (car regression))

!(transition regression1 regression '(1 1 1 1))
!(assert-eq :player-2-to-guess (car regression1))

!(transition regression2 regression1 '(1 1 1 1))
!(assert-eq '(:player-1-to-guess 2 . 0) (car regression2))

!(transition regression3 regression2 '(1 1 2 2))
!(assert-eq '(:player-2-to-guess 0 . 0) (car regression3))

!(transition regression4 regression3 '(2 1 1 1))
!(assert-eq '(:player-1-to-guess 1 . 1) (car regression4))

!(transition regression5 regression4 '(1 1 3 3))
!(assert-eq '(:player-2-to-guess 0 . 1) (car regression5))

!(transition regression6 regression5 '(1 2 3 4))

;; Player 1 supplies a bad code. Player 2 supplies a good code.
!(def bad1 (init-game (commit '(1)) (commit '(6 6 6 5)) 4 6 7))

Expand All @@ -174,13 +208,13 @@

!(def m0 (init-game player-1-code player-2-code 4 6 3))
;(emit (cons :m0 (car m0)))
!(assert-eq :player-1-guess (car m0))
!(assert-eq :player-1-to-guess (car m0))

;; ;; Player 1 has the advantage and has already guessed correctly, so no next guess is needed.
;; ;; This transition is just to determine whether Player 2 already (previously) guessed correctly.
!(transition mA m0 '(6 6 6 5))
;(emit (cons :mA (car mA)))
!(assert-eq :player-2-guess (car mA))
!(assert-eq :player-2-to-guess (car mA))

!(transition mB mA '(1 1 1 1))
;(emit (cons :mB (car mB)))
Expand Down Expand Up @@ -208,20 +242,21 @@

;; Rewind and try a different ending.
!(transition m1 m0 '(5 5 5 5)) ; player 1 guess, round 1

;(emit (cons :m1 (car m1)))
!(assert-eq :player-2-guess (car m1))
!(assert-eq :player-2-to-guess (car m1))

!(transition m2 m1 '(1 2 4 3)) ; player 2 guess, round 1
;(emit (cons :m2 (car m2)))
!(assert-eq '(1 . 0) (car m2)) ; guess (5 5 5 5), code (6 6 6 5)
!(assert-eq '(:player-1-to-guess 1 . 0) (car m2)) ; guess (5 5 5 5), code (6 6 6 5)

!(transition m3 m2 '(5 5 5 5)) ; player 1 guess, round 2
;(emit (cons :m3 (car m3)))
!(assert-eq '(2 . 2) (car m3)) ; guess (1 2 4 3), code (1 2 3 4)
!(assert-eq '(:player-2-to-guess 2 . 2) (car m3)) ; guess (1 2 4 3), code (1 2 3 4)

!(transition m4 m3 '(1 2 3 4)) ; player 2 guess, round 2
;(emit (cons :m4 (car m4)))
!(assert-eq '(1 . 0) (car m4)) ; guess (1 2 3 4), code (1 2 3 4)
!(assert-eq '(:player-1-to-guess 1 . 0) (car m4)) ; guess (1 2 3 4), code (1 2 3 4)

!(transition m5 m4 '(6 6 6 5)) ; player 1 guess, round 3
;(emit (cons :m5 (car m5)))
Expand All @@ -245,3 +280,6 @@
!(assert-eq nil (cdr m7x))

:fin

;!(micro-chain-serve "127.0.0.1:1234" m0)
;!(micro-chain-serve "100.121.171.70:1234" m0)

0 comments on commit de4f6c7

Please sign in to comment.