{-# LANGUAGE BangPatterns #-}

module Main where

-- | Ïîäêëþ÷åíèå ìîäóëåé ðàáîòû ñî ñïèñêàìè (Data.List) è ñ ìîíàäàìè (Control.Monad).
--   Ìîäóëè ïîäêëþ÷àþòñÿ ïîä èìåíàìè L è M ñîîòâåòñòâåííî.
--   Èç ìîäóëÿ Control.Monad áåðåòñÿ òîëüêî ôóíêöèÿ guard.
import qualified Data.List as L
import qualified Control.Monad as M (guard)
import qualified Data.Map as Map

-- | Èñïîëüçóåìûå â ïðîãðàììå òèïû äàííûõ.
type DeviceData         = (Char, Float)   -- ^ Äàííûå ïî óñòðîéñòâó: ñèìâîë è âåðîÿòíîñòü âûõîäà èç ñòðîÿ.
type DevicesData        = [DeviceData]    -- ^ Ñïèñîê äàííûõ ïî óñòðîéñòâàì.
type FailureCostData    = [Float]         -- ^ Ñóììû óáûòêîâ êàæäîãî èç îòêàçîâ.
type ProblemData        = (DevicesData, FailureCostData) -- | Äàííûå çàäà÷è.
type VariantProbability = (String, Float)

-- | Òèïû ñëîâàðåé.
type ProbMapKey     = (Char, Int)              -- ^ Êëþ÷ ñëîâàðÿ "Òàáëèöà âåðîÿòíîñòåé".
type ProbabilityMap = Map.Map ProbMapKey Float -- ^ Òàáëèöà âåðîÿòíîñòåé äëÿ óñòðîéñòâ íà ïîçèöèÿõ.
type DeviceCostMap  = Map.Map Char       Float -- ^ Òàáëèöà ñòîèìîñòè óñòðîéñòâ.

-- | Ñîçäàþò ïóñòûå ñëîâàðè íóæíîãî òèïà.
emptyProbMap :: ProbabilityMap
emptyProbMap = Map.empty
emptyDeviceCostMap :: DeviceCostMap
emptyDeviceCostMap = Map.empty


-- | Äàííûå ïî óñòðîéñòâàì.
devices1, devices2 :: DevicesData
devices1 = [ ('A', 0.37)
           , ('B', 0.43)
           , ('C', 0.2) ]

devices2 = [ ('A', 0.17)
           , ('B', 0.13)
           , ('C', 0.20)
           , ('D', 0.09)
           , ('E', 0.40)
           , ('F', 0.01) ]

devices3 = [ ('A', 0.10)
           , ('B', 0.11)
           , ('C', 0.05)
           , ('D', 0.04)
           , ('E', 0.14)
           , ('F', 0.10)
           , ('G', 0.10)
           , ('H', 0.09)
           , ('I', 0.15)
           , ('J', 0.12) ]

-- | Ñóììû óáûòêîâ èç-çà îòêàçîâ.
failureCost1, failureCost2 :: FailureCostData
failureCost1 = [20, 20, 30, 30]
failureCost2 = [ 8, 12, 20, 60]
failureCost3 = [ 1,  3, 11, 34, 51]

-- | Ïîëíûå äàííûå ïî ïðèìåðàì 1, 2, 3.
problem1, problem2, problem3 :: ProblemData
problem1 = (devices1, failureCost1)
problem2 = (devices2, failureCost2)
problem3 = (devices3, failureCost3)

-- | Âîçâðàùàåò ñóììó âåðîÿòíîñòåé óñòðîéñòâ.
probabilitySum [] = 0
probabilitySum ((_,pa):aas) = pa + probabilitySum aas

-- | Âûñ÷èòûâàåò âåðîÿòíîñòü äëÿ âàðèàíòà ïåðåñòàíîâêè.
--   Íàïðèìåð, âåðîÿòíîñòü âàðèàíòà "BACD", åñëè åñòü âñåãî 4 óñòðîéñòâà.
--   Ïðèíèìàåò ñóììó âåðîÿòíîñòåé âñåõ óñòðîéñòâ (êîòîðàÿ âñåãäà îäíà è òà æå).
--   Ðåêóðñèâíî âû÷èñëÿåò ïðîèçâåäåíèå âåðîÿòíîñòåé êîíêðåòíîãî óñòðîéñòâà:
--   (Pa / (Pa + Pb + Pc + ...)) * (Pb / (Pb + Pc + ...)) * ... * Pn / Pn
--   Ïîñëåäíåå ÷àñòíîå âû÷èñëÿòü íå íóæíî, îíî âñåãäà 1.
--   Ñóììû â çíàìåíàòåëå êàæäûé ðàç âû÷èñëÿòü òîæå íå íóæíî. Ïðîùå ïåðåäàâàòü
--   íà ñëåäóþùèé øàã óìåíüøåííóþ ñóììó âåðîÿòíîñòåé.
variantProbability :: Float -> DevicesData -> VariantProbability
variantProbability _ []                 = ([],    1)
variantProbability _ ((dev,_):[])       = ([dev], 1)
variantProbability varSum devicesData = let
        ((dev, p):xs) = devicesData
        (devs, probs) = variantProbability (varSum - p) xs
        prob          = (p / varSum)
        in (dev : devs, prob * probs)

-- | Âûñ÷èòûâàåò âåðîÿòíîñòè âñåõ âàðèàíòîâ ïåðåñòàíîâîê.
--   Ñëîæíîñòü äàííîé ôóíêöèè ñîñòàâëÿåò íå ìåíåå n!.
variantProbabilities :: DevicesData -> [VariantProbability]
variantProbabilities devices = let
    varSum = probabilitySum devices
    perms  = L.permutations devices
    in map (variantProbability varSum) perms

-- | Âûñ÷èòûâàåò òàáëèöó âåðîÿòíîñòè äëÿ óñòðîéñòâ ïî ïîçèöèÿì.
--   Ïåðâàÿ ñâåðòêà ïðîáåãàåòñÿ ïî âåðîÿòíîñòÿì âàðèàíòîâ,
--   è íà êàæäîì øàãó ñ ïîìîùüþ âòîðîé ñâåðòêè çàíîñèò âåðîÿòíîñòü âàðèàíòà
--   â òàáëèöó íà ïîçèöèþ (óñòðîéñòâî, èíäåêñ).
--   Ïðèìåð.
--   let varProbs = [("ABC",0.2525397),("BAC",0.27912283),("CBA",0.10750001),("BCA",0.1508772),("CAB",9.25e-2),("ACB",0.117460325)]
--   Ïåðâàÿ ñâåðòêà ñîáèðàåò âåðîÿòíîñòè âàðèàíòîâ:
--   (varString, prob) <- varProbs
--   Âòîðàÿ ñâåðòêà ñîáèðàåò íàçâàíèÿ óñòðîéñòâ âàðèàíòà ñ îäíîâðåìåííîé àêêóìóëÿöèåé èíäåêñà:
--   dev <- varString
--   idx <- [0..]
--   Íà êàæäîé èòåðàöèè çíà÷åíèå ñîîòâåòñòâóþùåé ÿ÷åéêè òàáëèöû ñêëàäûâàåòñÿ ñ âåðîÿòíîñòüþ
--   òåêóùåãî âàðèàíòà: probabilityMap[dev, idx] += prob
probabilityTable :: [VariantProbability] -> ProbabilityMap
probabilityTable varProbs = L.foldl' f emptyProbMap varProbs
  where
    f  :: ProbabilityMap -> VariantProbability -> ProbabilityMap
    f' :: Float -> (Int, ProbabilityMap) -> Char -> (Int, ProbabilityMap)
    
    f  dataMap (varString, prob) = snd $ L.foldl' (f' prob) (0, dataMap) varString
    f' prob (idx, dataMap) dev   = let
        key = (dev, idx)
        in case Map.lookup key dataMap of
            Just x  -> (idx + 1, Map.insert key (prob + x) dataMap)
            Nothing -> (idx + 1, Map.insert key  prob      dataMap)

-- | Âûñ÷èòûâàåò ñòîèìîñòü ïîëîìêè óñòðîéñòâ.
--   Ñâîðà÷èâàåò òàáëèöó âåðîÿòíîñòè â òàáëèöó ñòîèìîñòè óñòðîéñòâ
--   ñ ïîìîùüþ ôóíêöèè f.
deviceCosts :: FailureCostData -> ProbabilityMap -> DeviceCostMap
deviceCosts failureCost dataMap = result
  where
    result      = Map.foldrWithKey (f infFailCost) emptyDeviceCostMap dataMap
    infFailCost = failureCost ++ repeat 0 -- Áåñêîíå÷íûé ñïèñîê äëÿ îõâàòà âñåõ èíäåêñîâ idx
    f :: FailureCostData -> ProbMapKey -> Float -> DeviceCostMap -> DeviceCostMap
    f fCost (ch, idx) prob m = let
        producted = prob * (fCost !! idx)
        in case Map.lookup ch m of
            Just p  -> Map.insert ch (p + producted) m
            Nothing -> Map.insert ch      producted  m

-- | Òî÷êà âõîäà â ïðîãðàììó.
main = do
    let (devices, failureCost) = problem2
    let !varProbs  = variantProbabilities devices
    let probTable  = probabilityTable varProbs
    let devCosts   = deviceCosts failureCost probTable

    putStrLn . show $ devCosts
    putStrLn "Ok."
