;;; bj.lsp -- blackjack game probabilities.
;;; @author Eric Laroche
;;; @version @(#)$Id: bj.lsp,v 1.1 1998/03/04 17:41:46 laroche Exp $
;;;
;; bj.lsp -- blackjack game probabilities.
;; Copyright (C) 1994,1996,1997,1998 Eric Laroche.
;;
;; This program is free software;
;; you can redistribute it and/or modify it.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
;;
;;; The calculated probabilities are based on infinite large decks.
;;; Surrender and side bets are not considered.
;;; Rules used are s17/doa/das.
;;;


;; card part

;;; distinct cards of a deck (colors not considered).
(defvar cards
	'(ace king queen jack
		ten nine eight seven six five four three two)
	"cards: cards of a blackjack deck.
		Card colors are not considered.")
;;; card predicate.
(defun cardq (card)
	"cardq card: returns t if 'card' is a card."
	(not (null
		(member card cards))))

;;; blackjack values of the cards.
(defun cardvalue (card)
	"cardvalue card: list of blackjack values of a card.
		E.g. (cardvalue 'ace) = (11 1), (cardvalue 'king) = (10)."
	(case card
		('ace '(11 1))
		('king '(10))
		('queen '(10))
		('jack '(10))
		('ten '(10))
		('nine '(9))
		('eight '(8))
		('seven '(7))
		('six '(6))
		('five '(5))
		('four '(4))
		('three '(3))
		('two '(2))))
;;; cardvalue predicate.
(defun cardvalueq (value)
	"cardvalueq value: returns t if 'value' is a card value."
	(and
		(listp value)
		(every #'integerp value)
		(> (length value) 0)))
;;; cardvalue compare function.
(defun cardvalue-compare (valueone valuetwo)
	"cardvalue-compare valueone valuetwo: returns t if the card values are ordered."
	(if (/= (length valueone) (length valuetwo))
		(< (length valueone) (length valuetwo))
		(do ((i 0 (1+ i))) ((= i (length valueone)) t)
			(if (/= (elt valueone i) (elt valuetwo i))
				(return (< (elt valueone i) (elt valuetwo i)))))))

;;; cards with unique values.
(defun uniquevaluecards ()
	"uniquevaluecards: cards with unique values."
	(remove-if-not #'(lambda (card)
		(equal card
			;; find first with that value
			(find-if #'(lambda (cardtwo)
				(equal (cardvalue cardtwo) (cardvalue card)))
				cards)))
		cards))

;;; minimal single card value.
(defvar mincardvalue
	(apply #'min
		(mapcar #'(lambda (card)
			(apply #'max (cardvalue card)))
			cards))
	"mincardvalue: minimal single card value.")

;;; maximal single card value.
(defvar maxcardvalue
	(apply #'max
		(mapcar #'(lambda (card)
			(apply #'max (cardvalue card)))
			cards))
	"maxcardvalue: maximal single card value.")

;;; list of possible sums.
(defun cardsum (x y)
	"cardsum x y: list of all possible sums of 'x', 'y'.
		The list will be sorted and duplicates will be removed.
		'x' and 'y' must be lists of integers."
	(if (and (cardvalueq x) (cardvalueq y))
		(remove-duplicates
			(sort (copy-list
				(apply #'append (mapcar #'(lambda (xx)
					(mapcar #'(lambda (yy)
						(+ xx yy))
						y))
					x)))
				#'<)
			:test #'equal)))

;;; draw probability of a card.
(defun cardprobability (card)
	"cardprobability card: probability that 'card' is drawn.
		1/13."
	(if (cardq card)
		(/ (length cards))))


;; rules part

;;; blackjack value.
(defvar blackjackvalue
	21
	"blackjackvalue: 21.")

;;; blackjack favor.
(defvar blackjackfavor
	3/2
	"blackjackfavor: 3/2 (pays 2:1).")

;;; favor if (late) surrendering.
(defvar surrenderfavor
	-1/2
	"surrenderfavor: -1/2 (loses half of the bet).")

;;; busted rule.
(defun bustedq (value)
	"bustedq value: returns t if 'value' is busted.
		'value' must be a list of integers."
	(if (cardvalueq value)
		;; busted is: all hand values are above 21
		(> (apply #'min value) blackjackvalue)))

;;; comparision.
(defun bjcompare (value to)
	"bjcompare value to: returns 1 if 'value' is greater than
		'to', -1 if it's less and 0 if they're equal.
		bjcompare considers values that are busted.
		Note that 0 is returned if 'value' and 'to' are busted."
	(if (and (cardvalueq value) (cardvalueq to))
		;;busted is handled as -1, 0 is returned if both are busted
		(signum
			(-
				(if (bustedq value) -1 (apply #'max value))
				(if (bustedq to) -1 (apply #'max to))))))

;;; sums with busted values removed.
(defun bjcardsum (x y)
	"bjcardsum x y: list of all possible sums of 'x', 'y'.
		The list will be sorted and duplicates will be removed.
		Busted values will be removed if there are non-busted values
		present.
		'x' and 'y' must be lists of integers."
	(if (and (cardvalueq x) (cardvalueq y))
		(let*
			((csum (cardsum x y))
			;; strip busted values (leave one value)
			(bjsum
				(remove-if-not #'(lambda (n)
					(not (bustedq (list n))))
					csum)))
			;; leave one value
			(if (/= (length bjsum) 0)
				bjsum
				;; minimal busted value
				(list (apply #'min csum))))))

;;; blackjack probability.
(defun bjcardprobability (card)
	(declare (special bjcardprobability-h))
	"bjcardprobability card: returns the probability of reaching
		blackjack from 'card' with one card."
	(if (not (boundp 'bjcardprobability-h))
		(setf bjcardprobability-h (make-hash-table :test #'equal)))
	(if (cardq card)
		;; cache it to increase performance
		(values (or
			(values (gethash card bjcardprobability-h))
			(setf (gethash card bjcardprobability-h)
				(apply #'+ (mapcar #'(lambda (cardtwo)
					(if (=
						(apply #'max (bjcardsum (cardvalue card) (cardvalue cardtwo)))
						blackjackvalue)
						(cardprobability cardtwo)
						0))
					cards)))))))


;; dealer part

;;; stand value.
(defvar dealerstandvalue
	17
	"dealerstandvalue: value at which dealer must stand.")

;;; indicate whether to hit or stand.
(defun dealerhitstandstrategy (from)
	"dealerhitstandstrategy from: returns either 'hit or 'stand,
		depending on the dealer rules."
	(if (cardvalueq from)
		;; stand on all 17 or above
		(if (>= (apply #'max from) dealerstandvalue)
			'stand
			'hit)))

;;; get all possible results.
;;; recursive
(defun dealerresults (&optional from)
	(declare (special dealerresults-h))
	"dealerresults from: returns a list of possible dealer
		results based on dealerhitstandstrategy.
		dealerresults: returns a list of possible dealer results."
	(if (not (boundp 'dealerresults-h))
		(setf dealerresults-h (make-hash-table :test #'equal)))
	(cond
		((and (not (null from)) (cardvalueq from))
			;; cache it because it's recursive
			(values (or
				(values (gethash from dealerresults-h))
				(setf (gethash from dealerresults-h)
					(if (eql (dealerhitstandstrategy from) 'stand)
						;; stand if dealerhitstandstrategy says so
						(list from)
						;; once more: unique
						(remove-duplicates (sort (copy-list
							;; go on with the recursion
							(apply #'append (mapcar #'dealerresults
								;; unique
								(remove-duplicates (sort (copy-list
									;; all sums from 'from'
									(mapcar #'(lambda (card)
										(bjcardsum from (cardvalue card)))
										cards))
									#'cardvalue-compare)
									:test #'equal))))
							#'cardvalue-compare)
							:test #'equal))))))
		((null from)
			(dealerresults (list 0)))))

;;; get probabilities for all possible results.
;;; recursive
(defun dealerhitstandprobability (from to)
	(declare (special dealerhitstandprobability-h))
	"dealerhitstandprobability from to: returns the probability
		of reaching 'to' from 'from'.
		If 'to' is an integer, the sum of probabilities with the
		highest value equal to 'to' is returned."
	(if (not (boundp 'dealerhitstandprobability-h))
		(setf dealerhitstandprobability-h (make-hash-table :test #'equal)))
	(cond
		((and (cardvalueq from) (cardvalueq to))
			;; cache it because it's recursive
			(values (or
				(values (gethash (list from to) dealerhitstandprobability-h))
				(setf (gethash (list from to) dealerhitstandprobability-h)
					(if (equal (dealerhitstandstrategy from) 'stand)
						;; if dealer doesn't hit,
						;; it's either unity or none
						(if (equal from to)
							1
							0)
						;; else weighted sum
						(apply #'+ (mapcar #'(lambda (card)
							(*
								;; weight
								(cardprobability card)
								;; go on with the recursion
								(dealerhitstandprobability
									;; new sum
									(bjcardsum from (cardvalue card))
									to)))
							;; for each card
							cards)))))))
		((and (cardvalueq from) (integerp to))
			;; cache it to increase performance
			(values (or
				(values (gethash (list from to) dealerhitstandprobability-h))
				(setf (gethash (list from to) dealerhitstandprobability-h)
					(apply #'+ (mapcar #'(lambda (totwo)
						(dealerhitstandprobability from totwo))
						;; all possible to-values
						(remove-if-not #'(lambda (result)
							(= (apply #'max result) to))
							(dealerresults))))))))))

;;; get initial probabilities.
(defun dealerinitialprobability (from to)
	(declare (special dealerinitialprobability-h))
	"dealerinitialprobability from to: returns the
		probability of reaching 'to' from 'from' where 'from' is the
		initial card.
		If 'to' is an integer, the sum of probabilities with the
		highest value equal to 'to' is returned."
	(if (not (boundp 'dealerinitialprobability-h))
		(setf dealerinitialprobability-h (make-hash-table :test #'equal)))
	(cond
		((and (cardq from) (cardvalueq to))
			;; cache it to increase performance
			(values (or
				(values (gethash (list from to) dealerinitialprobability-h))
				(setf (gethash (list from to) dealerinitialprobability-h)
					;; dealer must initially hit
					;; weighted sum
					(apply #'+ (mapcar #'(lambda (card)
						;; new sum
						(let ((newfrom (bjcardsum (cardvalue from) (cardvalue card))))
							;; weight
							(if (= (apply #'max newfrom) blackjackvalue)
								;; blackjack not possible at this stage
								0
								(*
									(/
										(cardprobability card)
										;; correct the probability
										(- 1 (bjcardprobability from)))
									(dealerhitstandprobability newfrom to)))))
						;; for each card
						cards))))))
		((and (cardq from) (integerp to))
			;; cache it to increase performance
			(values (or
				(values (gethash (list from to) dealerinitialprobability-h))
				(setf (gethash (list from to) dealerinitialprobability-h)
					(apply #'+ (mapcar #'(lambda (value)
						(dealerinitialprobability from value))
						;; all possible to-values
						(remove-if-not #'(lambda (value)
							(= (apply #'max value) to))
							(dealerresults))))))))))


;; player part

;;; favor if standing.
(defun playerstandfavor (from dealer)
	(declare (special playerstandfavor-h))
	"playerstandfavor from dealer: returns the favor against the
		dealer if standing."
	(if (not (boundp 'playerstandfavor-h))
		(setf playerstandfavor-h (make-hash-table :test #'equal)))
	(cond
		((and (cardvalueq from) (cardq dealer))
			;; cache it to increase performance
			(values (or
				(values (gethash (list from dealer) playerstandfavor-h))
				(setf (gethash (list from dealer) playerstandfavor-h)
					;; busted is -1 since player loses on bust
					(if (bustedq from)
						-1
						(apply #'+ (mapcar #'(lambda (to)
							(*
								;; weight
								(dealerinitialprobability dealer to)
								;; favor
								(bjcompare from to)))
							(dealerresults (cardvalue dealer)))))))))))

;;; favor if hitting.
;;; indirect recursive
(defun playerhitfavor (from dealer)
	(declare (special playerhitfavor-h))
	"playerhitfavor from dealer: returns the favor against the
		dealer if hitting."
	(if (not (boundp 'playerhitfavor-h))
		(setf playerhitfavor-h (make-hash-table :test #'equal)))
	(cond
		((and (cardvalueq from) (cardq dealer))
			;; cache it because it's indirect recursive
			(values (or
				(values (gethash (list from dealer) playerhitfavor-h))
				(setf (gethash (list from dealer) playerhitfavor-h)
					(apply #'+ (mapcar #'(lambda (card)
						(*
							;; weight
							(cardprobability card)
							;; sub-favor, indirect recursion
							(playerhitstandfavor
								;; new sum
								(bjcardsum from (cardvalue card))
								dealer)))
						cards))))))))

;;; favor against dealer.
;; maximum favor of hitting or standing is chosen.
;; indirect recursive
(defun playerhitstandfavor (from dealer)
	(declare (special playerhitstandfavor-h))
	"playerhitstandfavor from dealer: returns the favor against
		the dealer if hitting or standing."
	(if (not (boundp 'playerhitstandfavor-h))
		(setf playerhitstandfavor-h (make-hash-table :test #'equal)))
	(cond
		((and (cardvalueq from) (cardq dealer))
			;; cache it because it's indirect recursive
			(values (or
				(values (gethash (list from dealer) playerhitstandfavor-h))
				(setf (gethash (list from dealer) playerhitstandfavor-h)
					;; recursion termination
					(if (bustedq from)
						-1
						;; favor the maximum
						(max
							(playerhitfavor from dealer)
							(playerstandfavor from dealer)))))))))

;;; favor factor if doubling down.
(defvar doubledownfavor
	2
	"doubledownfavor: 2.")

;;; favor if doubling down.
(defun playerdoubledownfavor (from dealer)
	(declare (special playerdoubledownfavor-h))
	"playerdoubledownfavor from dealer: returns the favor
		against the dealer if doubling down."
	(if (not (boundp 'playerdoubledownfavor-h))
		(setf playerdoubledownfavor-h (make-hash-table :test #'equal)))
	(cond
		((and (cardvalueq from) (cardq dealer))
			;; cache it to increase performance
			(values (or
				(values (gethash (list from dealer) playerdoubledownfavor-h))
				(setf (gethash (list from dealer) playerdoubledownfavor-h)
					(*
						;; we may or may not consider doubling the favor
						;; on doubling the wager, for overall favor
						doubledownfavor
						(apply #'+ (mapcar #'(lambda (card)
							(*
								;; weight
								(cardprobability card)
								;; sub-favor, not allowed to hit anymore
								(playerstandfavor
									;; new sum
									(bjcardsum from (cardvalue card))
									dealer)))
							cards)))))))))

;;; favor factor if splitting.
(defvar pairfavor
	2
	"pairfavor: 2.")

;;; favor if splitting.
;;; indirect recursive.
;;; re-splitting is not considered.
(defun playerpairfavor (card dealer)
	(declare (special playerpairfavor-h))
	"playerpairfavor card dealer: returns the favor against the
		dealer if splitting."
	(if (not (boundp 'playerpairfavor-h))
		(setf playerpairfavor-h (make-hash-table :test #'equal)))
	(cond
		((and (cardq card) (cardq dealer))
			;; cache it to increase performance
			(values (or
				(values (gethash (list card dealer) playerpairfavor-h))
				(setf (gethash (list card dealer) playerpairfavor-h)
					(*
						;; we may or may not consider doubling the favor
						;; on doubling the wager, for overall favor
						pairfavor
						(apply #'+ (mapcar #'(lambda (cardtwo)
							(*
								;; weight
								(cardprobability cardtwo)
								;; don't consider pairing anymore
								(playerinitialfavor
									(bjcardsum (cardvalue card) (cardvalue cardtwo))
									dealer)))
							cards)))))))))

;;; favor against dealer from the two initial cards.
;;; indirect recursive (depending on playerpairfavor implementation, due to splitting).
;;; dealer blackjack probability is not considered (would be needed for overall probability)
(defun playerinitialfavor (&rest args)
	(declare (special playerinitialfavor-h))
	"playerinitialfavor from dealer: returns the favor against
		the dealer without considering pairing (splitting).
		playerinitialfavor cardone cardtwo dealer: returns the favor
		against the dealer, splitting considered."
	(if (not (boundp 'playerinitialfavor-h))
		(setf playerinitialfavor-h (make-hash-table :test #'equal)))
	(cond
		((and (= (length args) 2)
			(cardvalueq (elt args 0)) (cardq (elt args 1)))
			(let ((from (elt args 0)) (dealer (elt args 1)))
				;; cache it to increase performance
				(values (or
					(values (gethash (list from dealer) playerinitialfavor-h))
					(setf (gethash (list from dealer) playerinitialfavor-h)
						;; we could consider doubling down only if favorable
						(max
							(playerdoubledownfavor from dealer)
							(playerhitstandfavor from dealer)))))))
		((and (= (length args) 3)
			(cardq (elt args 0)) (cardq (elt args 1)) (cardq (elt args 2)))
			(let ((cardone (elt args 0)) (cardtwo (elt args 1)) (dealer (elt args 2)))
				;; cardone, cardtwo are symmetric
				(if (> (position cardone cards) (position cardtwo cards))
					;; use symmetric result
					(playerinitialfavor cardtwo cardone dealer)
					;; cache it because it could be indirect recursive
					;; (depending on playerpairfavor implementation)
					(values (or
						(values (gethash (list cardone cardtwo dealer) playerinitialfavor-h))
						(setf (gethash (list cardone cardtwo dealer) playerinitialfavor-h)
							(let ((favor (playerinitialfavor
								(bjcardsum (cardvalue cardone) (cardvalue cardtwo))
								dealer)))
								;; check for pair that can be split
								(if (equal cardone cardtwo)
									;; (not considering dealer blackjack)
									;; we could consider splitting only if favorable
									(max
										(playerpairfavor cardone dealer)
										favor)
									favor))))))))))

;;; initial strategy.
;;; dealer blackjack probability is not considered (would be needed for overall probability).
(defun playerinitialstrategy (&rest args)
	"playerinitialstrategy cardone cardtwo dealer: returns
		either 'hit, 'stand, 'doubledown or 'pair (split), depending
		on the favor of the weighted possible results against the
		dealer.
		playerinitialstrategy from dealer : returns either 'hit,
		'stand or 'doubledown."
	(cond
		((and (= (length args) 3)
			(cardvalueq (elt args 0)) (cardq (elt args 1)) (numberp (elt args 2)))
			(let ((from (elt args 0)) (dealer (elt args 1)) (favor (elt args 2)))
				;; (not considering dealer blackjack, as in playerinitialfavor)
				(cond
					;; check for blackjack
					((= (apply #'max from) blackjackvalue)
						'stand)
					;; favor standing over doubling down over hitting
					((= favor (playerstandfavor from dealer))
						'stand)
					;; consider doubling down (before hitting) only if favorable
					((and (>= favor 0) (= favor (playerdoubledownfavor from dealer)))
						'doubledown)
					((= favor (playerhitfavor from dealer))
						'hit)
					;; else must be splitting.
					;; (we don't have the information about what cards here)
					(t
						'pair))))
		((and (= (length args) 2)
			(cardvalueq (elt args 0)) (cardq (elt args 1)))
			(let ((from (elt args 0)) (dealer (elt args 1)))
				(playerinitialstrategy
					from
					dealer
					(playerinitialfavor from dealer))))
		((and (= (length args) 3)
			(cardq (elt args 0)) (cardq (elt args 1)) (cardq (elt args 2)))
			(let ((cardone (elt args 0)) (cardtwo (elt args 1)) (dealer (elt args 2)))
				(playerinitialstrategy
					(bjcardsum (cardvalue cardone) (cardvalue cardtwo))
					dealer
					(playerinitialfavor cardone cardtwo dealer))))))

;;; overall blackjack favor.
(defun playeroverallfavor ()
	"playeroverallfavor: returns the oveall blackjack favor."
	(apply #'+ (mapcar #'(lambda (cardone)
		(*
			(cardprobability cardone)
			(apply #'+ (mapcar #'(lambda (cardtwo)
				(*
					(cardprobability cardtwo)
					(apply #'+ (mapcar #'(lambda (dealer)
						(*
							(cardprobability dealer)
							;; check for blackjack
							(if (= (apply #'max (bjcardsum
								(cardvalue cardone)
								(cardvalue cardtwo)))
								blackjackvalue)
								;; count off pushs
								(*
									(- 1 (bjcardprobability dealer))
									;; player blackjack pays 2:1, so weight 3/2
									blackjackfavor)
								(-
									(*
										(- 1 (bjcardprobability dealer))
										(playerinitialfavor cardone cardtwo dealer))
									;; count off dealer blackjacks
									(bjcardprobability dealer)))))
						(reverse cards)))))
				cards))))
		cards)))


;;; strategy code.
(defun strategycode (strategy favor)
	"strategycode strategy favor: returns upper case strategy
		initial if favor is positive, else lower case initial."
	(cond
		((and (symbolp strategy) (numberp favor))
			;; remain symbolic
			;; (values (read-from-string ...))
			(funcall
				;; upper or lower case
				(cond
					;; player favor
					((>= favor 0)
						#'string-upcase)
					;; dealer favor
					((>= favor surrenderfavor)
						#'string-downcase)
					;; dealer favor, surrender if < -1/2
					(t
						#'string-downcase))
				;; initial only
				(string (char (symbol-name strategy) 0))))))

;;; print in matrix format.
(defun output-matrix (matrix)
	"output-matrix: print in matrix format."
	(mapc #'(lambda (row)
		(format t "~&(")
		(mapc #'(lambda (field)
			(format t " ~a" field))
			row)
		(format t " )"))
		matrix)
	nil)

;;; hard strategy table.
(defun playerhardstrategytable ()
	"playerhardstrategytable: returns a hit or stand table for
		hard hands.
		H: hit, player's favor; h: hit, dealer's favor;
		S: stand, player's favor; s: stand, dealer's favor;
		D: double down, player's favor (if permitted, else hit).
		Splitting is not considered."
	(mapcar #'(lambda (from)
		(mapcar #'(lambda (dealer)
			(strategycode
				(playerinitialstrategy (list from) dealer)
				(playerinitialfavor (list from) dealer)))
			;; unique-valued initial dealer cards
			(reverse (uniquevaluecards))))
		(do ((list nil (append list (list n)))
			(n
				;; maximal value that's not busted
				blackjackvalue
				;; from higher value to lower value
				(1- n)))
			((< n
				;; minimal value for two cards
				(* 2 mincardvalue))
			list))))

;;; soft strategy table.
(defun playersoftstrategytable ()
	"playersoftstrategytable: returns a hit or stand table for
		soft hands.
		H: hit, player's favor; h: hit, dealer's favor;
		S: stand, player's favor; s: stand, dealer's favor;
		D: double down, player's favor (if permitted, else hit).
		Splitting is not considered."
	(mapcar #'(lambda (from)
		(mapcar #'(lambda (dealer)
			(let ((value (bjcardsum (cardvalue 'ace) (list from))))
				(strategycode
					(playerinitialstrategy value dealer)
					(playerinitialfavor value dealer))))
			;; unique-valued initial dealer cards
			(reverse (uniquevaluecards))))
		(do ((list nil (append list (list n)))
			(n
				(-
					;; maximal value that's not busted
					blackjackvalue
					;; soft hands include an ace
					(apply #'max (cardvalue 'ace)))
				;; from higher value to lower value
				(1- n)))
			((< n
				1)
			list))))

;;; pair (split) strategy table.
(defun playerpairstrategytable ()
	"playerpairstrategytable: returns a hit or stand table for
		a pair of cards.
		H: hit, player's favor; h: hit, dealer's favor;
		S: stand, player's favor; s: stand, dealer's favor;
		D: double down, player's favor (if permitted, else hit);
		P: pair (split), player's favor; p: pair, dealer's favor."
	(mapcar #'(lambda (card)
		(mapcar #'(lambda (dealer)
			(strategycode
				(playerinitialstrategy card card dealer)
				(playerinitialfavor card card dealer)))
			;; unique-valued initial dealer cards
			(reverse (uniquevaluecards))))
		;; cards with an unique value
		(uniquevaluecards)))


;;; output the results.
(defun bjresults ()
	"bjresults: display blackjack game strategy tables."
	(progn
		(format t "~&~%hard strategy:")
		(output-matrix (playerhardstrategytable))
		(format t "~&~%soft strategy:")
		(output-matrix (playersoftstrategytable))
		(format t "~&~%pair strategy:")
		(output-matrix (playerpairstrategytable))
		nil))