Advertisement
Guest User

Untitled

a guest
Jul 20th, 2017
51
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. module Kopapir where
  2.  
  3. type Sign = Int
  4.  
  5. {-
  6. validSigns f a b
  7.   | a `elem` signs && b `elem` signs = f a b
  8.     where signs = [1,2,3]
  9. validSigns _ a b = error $ "validSigns: invalid values: (" ++ show a ++ "," ++ show b ++ ")"
  10. -}
  11. validSigns :: (Sign -> Sign -> a) -> Sign -> Sign -> a
  12. validSigns f a b
  13.   | a >= 0 && a < 3 && b >= 0 && b < 3 = f a b
  14. validSigns _ a b = error $ "validSigns: invalid values: (" ++ show a ++ "," ++ show b ++ ")"
  15.  
  16. beats :: Sign -> Sign -> Bool
  17. 0 `beats` 2 = True
  18. 1 `beats` 0 = True
  19. 2 `beats` 1 = True
  20. a `beats` b = validSigns f a b
  21.    where f _ _ = False
  22.  
  23. isDraw :: Sign -> Sign -> Bool
  24. isDraw a b = validSigns f a b
  25.    where f x y = x == y
  26.  
  27. result :: Sign -> Sign -> Int
  28. result a b
  29.   | isDraw a b  = 0
  30.   | a `beats` b = 1
  31.   | otherwise   = -1
  32.  
  33. type Play = [Sign]
  34. type Rounds = (Play, Play)
  35.  
  36. tournament :: Rounds -> Int
  37. tournament (xs, ys)
  38.  | l < 0     = 2
  39.  | l > 0     = 1
  40.  | otherwise = 0
  41.    where
  42.      l = sum $ map (\(x,y) -> result x y) $ zip xs ys
  43.    
  44. partitionRounds :: Rounds -> ([Sign], [Sign], [Sign])
  45. partitionRounds (xs,ys) = ([ b | (a, b) <- r, a == 1], [ b | (a, b) <- r, a == 0], [ b | (a, b) <- r, a == -1])
  46.     where
  47.       r = map (\(x,y) -> (result x y, x)) $ zip xs ys
  48.  
  49. next :: Sign -> Sign
  50. next 0 = 1
  51. next 1 = 2
  52. next 2 = 0
  53.  
  54. frequency :: Eq a => a -> [a] -> Int
  55. frequency _ []   = 0
  56. frequency a (x:xs)
  57.   | x == a    = 1 + frequency a xs
  58.   | otherwise = frequency a xs
  59.  
  60. mostFrequent :: Ord a => [a] {-nem üres-} -> a
  61. mostFrequent x = snd $ maximum $ map (\a -> (frequency a x, a)) $ nub x
  62.  
  63. type Strategy = Rounds -> Sign -- (Play, Play) -> Sign
  64.  
  65. strategy1 :: Strategy
  66. strategy1 ([],[])    = 0
  67. strategy1 (x:_, y:_)
  68.   | result x y == 1 = y
  69.   | otherwise       = next y
  70.  
  71.  
  72. strategy2 :: Strategy
  73. strategy2 ([],[]) = 2
  74. strategy2 (_, ys) = next $ mostFrequent ys
  75.  
  76. strategy3 :: Strategy
  77. strategy3 ([],[]) = 1
  78. strategy3 rounds
  79.  | length (won r) == length (lost r) = next $ mostFrequent (tie r)
  80.  | length (won r) >  length (lost r) = mostFrequent (won r)
  81.  | otherwise                         = next $ mostFrequent (lost r)  
  82.    where
  83.       r = partitionRounds rounds
  84.       won  (a,_,_) = a
  85.       tie  (_,b,_) = b
  86.       lost (_,_,c) = c
  87.  
  88. applyStrategies :: Strategy -> Strategy -> Rounds -> Rounds
  89. applyStrategies s1 s2 r@(xs,ys) = (s1 r : xs, s2 (ys, xs) : ys)
  90.  
  91. play :: Int -> Strategy -> Strategy -> Rounds
  92. play n s1 s2
  93.   | n <= 0    = ([], [])
  94.   | otherwise = applyStrategies s1 s2 (play (n-1) s1 s2)
  95.  
  96. winningStrategy :: Strategy -> [Strategy] -> [Int]
  97. winningStrategy = winningStrategyN 1
  98.   where
  99.    winningStrategyN :: Int ->  Strategy -> [Strategy] -> [Int]
  100.    winningStrategyN _ _ [] = []
  101.    winningStrategyN n s (x:xs)
  102.      | (tournament $ play 10 s x) == 2 = n : winningStrategyN (n+1) s xs
  103.      | otherwise                       = winningStrategyN (n+1) s xs
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement