-- St. Petersburg paradox game.
import System.Random
import Data.Unique

tooLong = 10000000

stPeter winLevel loseLevel startLevel = stPeter' 0.0 1.0e9 startLevel 0 where
 stPeter' winPrice losePrice amtWon numGoes = do
   thisGo  <- haveAGo
   amtWon  <- return $ amtWon  + thisGo
   numGoes <- return $ numGoes + 1
   -- Calculate the price below which I would have now won.
   newWinPrice  <- return $ (amtWon - winLevel ) / fromIntegral numGoes
   -- Calculate the price above which I would have now lost.
   newLosePrice <- return $ (amtWon - loseLevel) / fromIntegral numGoes
   -- We can't win at a level we'd have already lost at, etc.
   newWinPrice  <- return $ min losePrice newWinPrice
   newLosePrice <- return $ max winPrice  newLosePrice
   -- Generate new winPrice and losePrice
   winPrice  <- return $ max winPrice  newWinPrice
   losePrice <- return $ min losePrice newLosePrice
   -- Where are we?
   {--
   if numGoes `mod` 1000 == 0
    then putStrLn $ show numGoes ++ ", " ++ show (losePrice - winPrice)
    else return ()
   --}
   -- Start from the top if we haven't got anywhere after a while.
   if numGoes == tooLong
    then stPeter winLevel loseLevel startLevel
    else
     -- And recurse
     if winPrice == losePrice
      then do
             u <- newUnique
             putStrLn $ "Done! " ++ show (hashUnique u)
             return winPrice
      else stPeter' winPrice losePrice amtWon numGoes

haveAGo = haveAGo' 1 where
  haveAGo' x = do
    toss <- randomIO
    if toss then return x else haveAGo' $ x*2

-- Generate n numbers to a file
top fileName numEntries winLevel loseLevel startLevel = do
  results <- mapM (const $ stPeter winLevel loseLevel startLevel) [1..numEntries]
  writeFile fileName $ "; NumEntries: " ++ show numEntries ++
                        " WinLevel: "   ++ show winLevel   ++
                        " LoseLevel: "  ++ show loseLevel  ++
                        " StartLevel: " ++ show startLevel ++
                        "\n" ++ unlines (map show results)

-- main = stPeter 2000000 0 1000000

main = top "OneMillB.txt" 1000 2000000 0 1000000