Haskell: Appending to a list from multiple locations in a program

Question

I would like to have a list that may be updated (appended to) from more than one location in the code. Since in haskell, calling a function once is the same as calling it twice and discarding the result of the first call, what is the best way for me to manage this list if side effects are not allowed? I've thought of passing the list through each time each time I need to append to it, but I don't know if that would be sufficient for what I want to accomplish. The algorithm that I'm implementing uses memoization [edit not dynamic programming] and stores a possible list of optimal winnings in a helper list. Would it be a good idea to simulate a global variable using monads and states or is there a better way to go about this?

Edit: This is how I implemented it in python:

def BJ(i):                                                                                                                                                                                                  
    if i in BJList:                                                                                                                                                                                         
        return BJList[i]                                                                                                                                                                                    
    else:                                                                                                                                                                                                   
        options = [0]                                   # if you walk away                                                                                                                                  
        if n-i < 4:                                     # not enough cards to play                                                                                                                          
            return 0                                                                                                                                                                                        
        for p in range(2,(n - i)):                      # number of cards taken                                                                                                                             
            player = c[i] + c[i+2] + sum(c[i+4:i+p+2])                                                                                                                                                      
            # when p is 2                                                                                                                                                                                   
            if player > 21:                                                                                                                                                                                 
                options.append(-1 + BJ(i + p + 2))                                                                                                                                                          
                break                                   # breaks out of for(p)                                                                                                                              
            dealer = 0                                                                                                                                                                                      
            d1 = 0                                                                                                                                                                                          
            for d in range(2,n-i-p+1): # python ranges are not inclusive                                                                                                                                    
                d1 = d                                                                                                                                                                                      
                dealer = c[i+1] + c[i+3] + sum(c[i+p+2:i+p+d])                                                                                                                                              
                if dealer >= 17:                                                                                                                                                                            
                    break                               # breaks out of for(d)                                                                                                                              
            if dealer < 17 and i + p + d >= n:          # doesn't change results, maybe                                                                                                                     
                dealer = 21                             # make it be more like haskell version                                                                                                              
            if dealer > 21:                                                                                                                                                                                 
                dealer = 0                                                                                                                                                                                  
            dealer += .5                                # dealer always wins in a tie                                                                                                                       
            options.append(cmp(player, dealer) + BJ(i + p + d1))                                                                                                                                            
        BJList[i] = (max(options))                                                                                                                                                                          
        return max(options)                                                                                                                                                                                 

c = [10,3,5,7,5,2,8,9,3,4,7,5,2,1,5,8,7,6,2,4,3,8,6,2,3,3,3,4,9,10,2,3,4,5]                                                                                                                                 
BJList = {}                                                                                                                                                                                                 
n = len(c)                                                                                                                                                                                                  
print "array:" +  str(c)                                                                                                                                                                                    
print BJ(0)  

My question refers to the options list. Is there a way to implement the options list that would allow me to manipulate it in both options.append locations?

Edit: This is my final implementation in Haskell (both programs concur):

import qualified Data.MemoCombinators as Memo                                                                                                                                                               

deck = [10,3,5,7,5,2,8,9,3,4,7,5,2,1,5,8,7,6,2,4,3,8,6,2,3,3,3,4,9,10,2,3,4,5]                                                                                                                              
dsize = length deck                                                                                                                                                                                         

getPlayerScore :: Int -> Int -> Int                                                                                                                                                                         
getPlayerScore i p                                                                                                                                                                                          
  | i + 2 + p <= dsize =                                                                                                                                                                                    
    deck !! i + deck !! (i + 2) + (sum $ take (p-2) $ drop (i + 4) deck)                                                                                                                                    
  | otherwise = 0                                                                                                                                                                                           

getDealerScoreAndHitCount :: Int -> Int -> (Int, Int)                                                                                                                                                       
getDealerScoreAndHitCount i p  -- gets first two cards                                                                                                                                                      
  | i + 2 + p <=                                                                                                                                                                                            
    dsize = getDSAHC' (deck !! (i + 1) + deck !! (i + 3)) (i+2+p)                                                                                                                                           
  | otherwise = (0,0)                                                                                                                                                                                       

getDSAHC' :: Int -> Int -> (Int, Int) -- gets the remaining cards dealer hits                                                                                                                               
getDSAHC' baseScore cardIndex                                                                                                                                                                               
  | baseScore >= 17 = (baseScore,0)                                                                                                                                                                         
  | cardIndex < dsize = (fst result, snd result  + 1)                                                                                                                                                       
  | otherwise = (0,0)                                                                                                                                                                                       
    where                                                                                                                                                                                                   
      result = getDSAHC' (baseScore + deck !! cardIndex) (cardIndex + 1)                                                                                                                                    

takeWhile' :: (a -> Bool) -> [a] -> [a]                                                                                                                                                                     
takeWhile' p (x:xs) =                                                                                                                                                                                       
  if p x                                                                                                                                                                                                    
    then x:takeWhile' p xs                                                                                                                                                                                  
                else [x]                                                                                                                                                                                    
takeWhile' p [] = []                                                                                                                                                                                        

getHandOutcome :: Int -> Int -> Int                                                                                                                                                                         
getHandOutcome pValue dValue                                                                                                                                                                                
        | pValue > 21 = -1                                                                                                                                                                                  
        | dValue == 0 = 0                                                                                                                                                                                   
        | pValue > dValue = 1                           -- player beats dealer                                                                                                                              
        | dValue > 21 = 1                               -- dealer busts                                                                                                                                     
        | otherwise = -1                                -- dealer wins ties                                                                                                                                 

blackjack :: Int -> Int                                                                                                                                                                                     
blackjack i                                                                                                                                                                                                 
  | dsize - i < 4 = 0                                                                                                                                                                                       
  | otherwise = maximum options                                                                                                                                                                             
    where                                                                                                                                                                                                   
      options =                                                                                                                                                                                             
        [0] ++ map score (takeWhile' (\(p,_,_) -> p <= 21) (map result [2 ..dsize-i-1]))                                                                                                                    
      score (pValue,dValue,mCards) =      -- mcards is total cards taken in current hand                                                                                                                    
        (getHandOutcome pValue dValue) + bjMemo (i + mCards)                                                                                                                                                
      result p = -- 'p' represents the num of cards player is going to receive                                                                                                                              
        (getPlayerScore i p, fst (getDealerScoreAndHitCount i p),                                                                                                                                           
           2 + p + snd (getDealerScoreAndHitCount i p))                                                                                                                                                     

bjMemo :: Int -> Int                                                                                                                                                                                        
bjMemo = Memo.integral blackjack 

main :: IO()                                                                                                                                                                                                
main =                                                                                                                                                                                                      
  do                                                                                                                                                                                                        
    print $ blackjack 0 

Answer 1

In general I see 3 solutions, with decreasing 'appealing' to Haskellers:

1. Write the algorithm in a purely functional way

   • Pros: No side effects, beautiful
   • Cons: You might have to rewrite the algorithm if it is given in imperative style (which is the case here)

2. Use the State monad to emulate state, because it essentially just 'hides' additional arguments to your function.

   • Pro: Imperative feeling
   • Cons: Monadic code, which is in general harder to reason about and not as easy reusable

   • Example:

     workerState :: State [Int] ()
     workerState = do
       modify (++ [21])
       {- lots of stuff happening -}
       modify (++ [21])
     
     -- E.g. in repl
     > runState workerState []
     

3. Use side effects. This means use either the ST monad or some sort of mutable references like IORef.

   • Pro: Real mutability, minimal changes to original algorithm due to monadic style
   • Cons: All from State + the ultimate evil: side effects

   • Example:

     workerST :: STRef s [Int] -> ST s ()
     workerST ref = do
       modifySTRef ref (++ [21])
       {- lots of stuff happening -}
       modifySTRef ref (++ [21])
     
     -- E.g. in repl:
     > runST $ do
         r <- newSTRef []
         workerST r
     

Note that in general appending to a list in haskell is slow because the standard list type is a single linked list, where only prepend is O(1).

Having said that, if you use variant 1 (purely functional), you also have the benefit of using libraries like memo-combinators, giving you memoization almost for free: Given a function bj that calculates the best score, we can memoize it like that:

bj :: Int -> Score
bj i = 
  undefined -- purely functional algorithm, replace recursive calls with bjMemo

bjMemo :: Int -> Score
bjMemo = Memo.integral bj

Answer 2

Here is how to think about the BJ procedure in a more functional manner:

Each value of p adds one element to the options list, so you can think of options as having the following definition:

options = map f [2..n-i-1]

where f is a function yet to be determined.

For each value of p we need to determine the following:

• the player's count
• the dealers count
• the number of cards taken

so this suggests that we should write a function like:

result :: Int -> (Int,Int,Int) -- player's count, dealers count, cards taken
result p = ...

and now we can express options like this:

options = map score (map result [2..n-i-1])

where score will take a triple (pcount,dcount,ncards) and compute the value to the player of the result.

To implement the loop terminating condition (the break out of the main for loop), we just stop taking results once the player's count is > 21. This can be accomplished by inserting a takeWhile after the map result ...:

options = map score $ takeWhile (\(p,_,_) -> p <= 21) $ map result [2..n-i-1]

The function score will look something like this:

score :: (Int,Int,Int) -> Int
score (pcount,dcount,ncards) =
  (if pcount > 21
    then -1
    else if pcount > dcount then 1 else -1) + BJ (i+ncards)

Now here is where you have to implement your dynamic programming / memoization.

So, putting it all together, you have the following pseudo-code for the BJ function:

BJ[i] = 0 if n-i < 4
BJ[i] = maximum options
  where options = map score $ takeWhile ... $ map result [2..n-i-1]
        score (p,d,n) = (if ...p > d...) + BJ[i+n]
        result p = ...

Update:

Now that you have a recursive definition of blackjack, you can easily memoize it with an array:

import Data.Array

mblackjack = array (1,n) [ (i,v) | i <- [1..n], let v = blackjack i ]

blackjack' :: Int -> Int -- the memoized function
blackjack' i = mblackjack ! i

blackjack :: Int -> Int
blackjack i = ... (replace any recursive calls to: blackjack k
                   with: blackjack' k)...

So the code flow is:

• the memoized version just indexes into the array
• the array is defined in terms of the original function
• the original function calls the memoized function for any recursive calls

Answer 3

If I understand the problem correctly, you're dealing with relatively short lists because there are only 52 cards. So I'd keep it simple, and write functions that take a list as input, and return the updated list as output.

I only skimmed your python code, so the example I've provided below might not be exactly what you need, but at least it will give you an idea. Suppose you wanted to replace the third card in a hand with a new card. You might use something like this. replaceElement xs n x returns a copy of xs in which the nth element has been replaced with x.

replaceElement :: [a] -> Int -> a -> [a]
replaceElement xs i x = 
  if 0 <= i && i < length xs then fore ++ (x : aft) else xs
  where fore = take i xs
        aft = drop (i+1) xs

However, that causes an exception if xs has fewer than n+1 elements. So we can write a safer version:

safeReplaceElement :: [a] -> Int -> a -> [a]
safeReplaceElement xs i x =
  if i >= 0 && i < length xs
    then replaceElement xs i x
    else xs

If you were dealing with large lists, I would suggest you look at mutable lists, and maybe the State monad, etc. But when I was a Haskell beginner, the mistake I made most often was to overcomplicate things. I created too many classes and types, used monads to excess, and so on.