Salsa helper invites

helpers.hs

import Control.Monad                                                                                                                                                                                                                                  
import Data.List                                                                                                                                                                                                                                      
import Data.Ord                                                                                                                                                                                                                                       
import Text.Printf                                                                                                                                                                                                                                    
                                                                                                                                                                                                                                                      
manRate = 0.9                                                                                                                                                                                                                                         
                                                                                                                                                                                                                                                      
womanRate = 0.7                                                                                                                                                                                                                                       
                                                                                                                                                                                                                                                      
factorial n = product [2 .. n]                                                                                                                                                                                                                        
                                                                                                                                                                                                                                                      
showupProb :: Double -> Double -> Double -> Double                                                                                                                                                                                                    
showupProb rate signups i =                                                                                                                                                                                                                           
  ( factorial i                                                                                                                                                                                                                                       
      * factorial (signups - i)                                                                                                                                                                                                                       
      / factorial signups                                                                                                                                                                                                                             
  )                                                                                                                                                                                                                                                   
    * (rate ** i)                                                                                                                                                                                                                                     
    * ((1 - rate) ** (signups - i))                                                                                                                                                                                                                   
                                                                                                                                                                                                                                                      
manProb :: Double -> Double -> Double                                                                                                                                                                                                                 
manProb = showupProb manRate                                                                                                                                                                                                                          
                                                                                                                                                                                                                                                      
womanProb :: Double -> Double -> Double                                                                                                                                                                                                               
womanProb = showupProb womanRate                                                                                                                                                                                                                      
                                                                                                                                                                                                                                                      
combinedProb :: (Double, Double) -> (Double, Double) -> Double                                                                                                                                                                                        
combinedProb (mSignups, wSignups) (m, w) = manProb mSignups m * womanProb wSignups w                                                                                                                                                                  
                                                                                                                                                                                                                                                      
trouble :: (Double, Double, Double) -> Double                                                                                                                                                                                                         
trouble (m, w, h) =                                                                                                                                                                                                                                   
  balanceTrouble (m - w + h) + helperTrouble (m, w, h)                                                                                                                                                                                                
                                                                                                                                                                                                                                                      
helperTrouble :: (Double, Double, Double) -> Double                                                                                                                                                                                                   
helperTrouble (m, w, h)                                                                                                                                                                                                                               
  | m + h > w + 2 && h > 0 = 10 * min (abs h) (m + h - w - 2)                                                                                                                                                                                         
  | m < w - h - 2 && h < 0 = 10 * min (abs h) (w - h - m - 2)                                                                                                                                                                                         
  | otherwise = 0                                                                                                                                                                                                                                     
                                                                                                                                                                                                                                                      
balanceTrouble :: Double -> Double                                                                                                                                                                                                                    
balanceTrouble x = (x ^^ 2) / 2                                                                                                                                                                                                                       
                                                                                                                                                                                                                                                      
evTrouble :: (Double, Double) -> Double -> Double                                                                                                                                                                                                     
evTrouble signups@(manSignups, womanSignups) h =                                                                                                                                                                                                      
  sum                                                                                                                                                                                                                                                 
    [ combinedProb signups (i, j) * trouble (i, j, h)                                                                                                                                                                                                 
      | i <- [0 .. manSignups],                                                                                                                                                                                                                       
        j <- [0 .. womanSignups]                                                                                                                                                                                                                      
    ]                                                                                                                                                                                                                                                 
                                                                                                                                                                                                                                                      
main :: IO ()                                                                                                                                                                                                                                         
main = do                                                                                                                                                                                                                                             
  let signups :: (Double, Double)                                                                                                                                                                                                                     
      signups@(manSignups, womanSignups) = (18, 22)                                                                                                                                                                                                   
  putStrLn $                                                                                                                                                                                                                                          
    unwords                                                                                                                                                                                                                                           
      [ "If",                                                                                                                                                                                                                                         
        printf "%.0f" manSignups,                                                                                                                                                                                                                     
        "men and",                                                                                                                                                                                                                                    
        printf "%.0f" womanSignups,                                                                                                                                                                                                                   
        "women have signed up"                                                                                                                                                                                                                        
      ]                                                                                                                                                                                                                                               
  let tups = [(h, evTrouble signups h) | h <- [-10 .. 10]]                                                                                                                                                                                            
  forM_ tups $ \(h, t) -> do                                                                                                                                                                                                                          
    putStrLn $                                                                                                                                                                                                                                        
      unwords                                                                                                                                                                                                                                         
        [ case compare h 0 of                                                                                                                                                                                                                         
            EQ -> "no helpers:     "                                                                                                                                                                                                                  
            GT -> "male helpers:   "                                                                                                                                                                                                                  
            LT -> "female helpers: ",                                                                                                                                                                                                                 
          show (abs h),                                                                                                                                                                                                                               
          printf "%.5f" t                                                                                                                                                                                                                             
        ]                                                                                                                                                                                                                                             
                                                                                                                                                                                                                                                      
  let (bestH, _) = minimumBy (comparing snd) tups                                                                                                                                                                                                     
                                                                                                                                                                                                                                                      
  putStrLn $                                                                                                                                                                                                                                          
    unwords                                                                                                                                                                                                                                           
      [ "\nThe optimale approach is to invite",                                                                                                                                                                                                       
        case compare bestH 0 of                                                                                                                                                                                                                       
          EQ -> "no helpers"                                                                                                                                                                                                                          
          GT -> printf "%.0f" bestH <> " men"                                                                                                                                                                                                         
          LT -> printf "%.0f" (abs bestH) <> " women"                                                                                                                                                                                                 
      ]