Added game of twenty one

1 files changed, 172 insertions, 0 deletions

diff --git a/game_of_21.scm b/game_of_21.scm
new file mode 100644
index 0000000..951dbea
--- /dev/null
+++ b/game_of_21.scm
@@ -0,0 +1,172 @@
+(use-modules (srfi srfi-1)
+             (srfi srfi-31))
+
+(set! *random-state* (random-state-from-platform))
+
+(define (make-hand up-card total)
+  (cons up-card total))
+
+(define (hand-up-card hand)
+  (car hand))
+
+(define (hand-total hand)
+  (cdr hand))
+
+(define (make-new-hand first-card)
+  (make-hand first-card first-card))
+
+(define (hand-add-card hand new-card)
+  (make-hand (hand-up-card hand)
+             (+ new-card (hand-total hand))))
+
+(define (deal) (+ 1 (random 10)))
+
+(define (stupid-strategy my-hand opponent-up-card)
+  (> opponent-up-card 5))
+
+(define (play-hand strategy my-hand opponent-up-card)
+  (cond ((> (hand-total my-hand) 21) my-hand) ; I lose...
+        ((strategy my-hand opponent-up-card) ; hit?
+         (play-hand strategy
+                    (hand-add-card my-hand (deal))
+                    opponent-up-card))
+        (else my-hand)))
+
+
+(define (twenty-one player-strategy house-strategy)
+  (let ((house-initial-hand (make-new-hand (deal)))) ; set up house hand
+    (let ((player-hand ; set up initial hand, and play out
+            (play-hand player-strategy ; strategy to use
+                       (make-new-hand (deal)) ; initial player hand
+                       (hand-up-card house-initial-hand)))) ; information about house hand available to player
+      (if (> (hand-total player-hand) 21)
+        0 ; bust: player loses
+        (let ((house-hand
+                (play-hand house-strategy
+                           house-initial-hand
+                           (hand-up-card player-hand))))
+          (cond ((> (hand-total house-hand) 21)
+                 1)
+                ((> (hand-total player-hand)
+                    (hand-total house-hand))
+                 1)
+                (else 0)))))))
+
+
+(define (user-says-y?) (eq? (read) 'y))
+
+(define (hit? your-hand opponent-up-card)
+  (newline)
+  (display "Opponent up card ")
+  (display opponent-up-card)
+  (newline)
+  (display "Your total: ")
+  (display (hand-total your-hand))
+  (newline)
+  (display "Hit? ")
+  (user-says-y?))
+
+;(display (twenty-one hit? hit?))
+;(display (twenty-one hit? stupid-strategy))
+;(display (twenty-one stupid-strategy hit?))
+
+; Problem 2
+(define (stop-at max-num)
+  (lambda (my-hand opponent-up-card)
+    (display "Should stop at ")
+    (display max-num)
+    (display "? ")
+    (if (< (hand-total my-hand) max-num)
+      (display "no")
+      (display "yes"))
+    (newline)
+    (< (hand-total my-hand) max-num)))
+
+;(display (if (eq? 1
+;(twenty-one hit? (stop-at 16)))
+;"player won"
+;"house won"))
+
+; Problem 3
+(define (test-strategy player-strategy
+                       house-strategy
+                       iterations)
+  (if (< iterations 1)
+    0
+    (+ (twenty-one player-strategy house-strategy)
+       (test-strategy player-strategy
+                      house-strategy
+                      (- iterations 1)))))
+
+;(display (test-strategy (stop-at 16) (stop-at 15) 1))
+
+; Problem 4
+(define (watch-player strategy)
+  (lambda (my-hand opponent-up-card)
+    (let ((hit? (strategy my-hand opponent-up-card)))
+      (display "Opponent up card ")
+      (display opponent-up-card)
+      (newline)
+      (display "Your total: ")
+      (display (hand-total my-hand))
+      (newline)
+      (display "Hit? ")
+      (display (if hit? "y" "n"))
+      (newline)
+      hit?)))
+
+;(display (test-strategy (watch-player (stop-at 16))
+;(watch-player (stop-at 15))
+;1))
+
+; Problem 5
+(define (louis my-hand opponent-up-card)
+  (cond ((< (hand-total my-hand) 12) #t)
+        ((> (hand-total my-hand) 16) #f)
+        ((eq? (hand-total my-hand) 12)
+         (< opponent-up-card 4))
+        ((eq? (hand-total my-hand) 16)
+         (< opponent-up-card 10))
+        (else (> opponent-up-card 6))))
+
+;(display (test-strategy louis (stop-at 15) 10))
+;(newline)
+;(display (test-strategy louis (stop-at 16) 10))
+;(newline)
+;(display (test-strategy louis (stop-at 17) 10))
+;(newline)
+
+; Problem 6
+(define (both first-strategy second-strategy)
+  (lambda (my-hand opponent-up-card)
+    (and (first-strategy my-hand opponent-up-card)
+         (second-strategy my-hand opponent-up-card))))
+
+(define (both . strategies)
+  ;(display strategies)
+  (lambda (my-hand opponent-up-card)
+    (if (null? strategies)
+      #t
+      (and ((car strategies) my-hand opponent-up-card)
+           (apply both (cdr strategies))))))
+
+(define (both . strategies)
+  (lambda (my-hand opponent-up-card)
+    (every identity
+           (map (lambda (s)
+                  (s my-hand opponent-up-card))
+                strategies))))
+
+(define (both . strategies)
+  (lambda (my-hand opponent-up-card)
+    ((rec (both strat)
+          (if (null? strat)
+            #t
+            (and ((car strat) my-hand opponent-up-card)
+                 (both (cdr strat)))))
+     strategies)))
+
+(display (twenty-one (both hit? (stop-at 21) (stop-at 19))
+                     louis))
+(newline)
+