https://paiza.jp/poh/ando

にHaskellで挑戦してみた。

こういう書き方がある。

そんな書き方Haskellらしくないなど

コメント頂けるとうれしいです。

水着が完成してないです。

難しい。。。(´・ω・` )

2016/04/05 追記

問題（猫、 猫耳、 メイド服）が増えたので挑戦した

## 目

### つり目

```
ann :: String -> String
ann s = concat $ replicate (read s) "Ann"
main = getLine >>= putStrLn . ann
```

### 眼帯

```
import Data.List
type Owns = [Int]
type NonOwns = [Int]
type InputList = (Owns, NonOwns)
type BuyList = [Int]
select :: InputList-> BuyList
select (o, no) = no \\ o
createInputList :: String -> InputList
createInputList = ci . lines
where
ci :: [String] -> InputList
ci (_:_:owns:_:nonOwns:[]) = (convert owns,convert nonOwns)
convert :: String -> [Int]
convert = map read . nub . words
buy :: BuyList -> String
buy [] = "None"
buy xs = intercalate " " $ map show $ sort xs
gantai :: String -> String
gantai = buy . select . createInputList
main = getContents >>= putStrLn . gantai
```

### 猫耳

```
import qualified Data.Text as T
import Data.List
word = "cat"
wordCount :: String -> Int
wordCount xs = T.count (T.pack word) inputWord
where
inputWord = T.pack xs
--実装してみた
wordCount2 :: String -> Int
wordCount2 = wordCount' 0
where
wordLength = length word
dropWord = drop wordLength
wordCount' :: Int -> String -> Int
wordCount' n xs
| word `isPrefixOf` xs = wordCount' (succ n) $ dropWord xs
| wordLength < length xs = wordCount' n $ tail xs
| otherwise = n
main = getLine >>= print . wordCount
```

### 猫

```
import qualified Data.Text as T
data WordCounts = WordCounts {
cCount :: Int
,aCount :: Int
,tCount :: Int
} deriving (Show)
data Result = Result {
catWords :: Int -- 完全に作れる個数
,shortageC :: Int -- 必要な "c" の個数
,shortageA :: Int -- 必要な "a" の個数
,shortageT :: Int -- 必要な "t" の個数
}
instance Show Result where
show (Result w c a t) = show w ++ "\r\n"
++ show c ++ "\r\n"
++ show a ++ "\r\n"
++ show t ++ "\r\n"
createWordCounts :: String -> WordCounts
createWordCounts xs = WordCounts countC countA countT
where
countx x = T.count (T.pack x) $ T.pack xs
countC = countx "c"
countA = countx "a"
countT = countx "t"
aggregate :: WordCounts -> Result
aggregate wc = Result (minWordCount wc)
(maxCount - cCount wc)
(maxCount - aCount wc)
(maxCount - tCount wc)
where
maxCount = maxWordCount wc
maxWordCount, minWordCount :: WordCounts -> Int
maxWordCount wc = maximum [cCount wc, aCount wc, tCount wc]
minWordCount wc = minimum [cCount wc, aCount wc, tCount wc]
main = getLine >>= print . aggregate . createWordCounts
```

## 髪

### ショートヘア

```
lineAdd :: String -> Int
lineAdd = sum . map read . lines
main = getContents >>= print . lineAdd
```

### ロングヘア

```
import Control.Monad.State
data VoteResult = Yes Int | No Int deriving (Show)
type Vote = [String]
type VoteState = (VoteResult, VoteResult)
type Result = String
majorityRule :: Vote -> State VoteState Result
majorityRule [] = get >>= \((Yes m), (No n)) -> case compare m n of
EQ -> return ""
GT -> return "yes"
LT -> return "no"
majorityRule (x:xs) = do
(Yes m,No n) <- get
case x of
"yes" -> put (Yes (m+1), No n)
"no" -> put (Yes m, No (n+1))
majorityRule xs
vote :: Vote -> Result
vote xs = evalState (majorityRule xs) (Yes 0, No 0)
main = getContents >>= putStrLn . vote . lines
```

### ポニーテール

```
import Data.List
countDown :: Int -> [String]
countDown n = reverse . (:) "0!!" $ map show [1..n]
main = getLine >>= mapM_ putStrLn . countDown . read
```

### ツインテール

```
costperformance :: (Fractional a, Ord a) => [a] -> Int
costperformance (d1Caffeine:d1Price:
d2Caffeine:d2Price:[]) = select p1 p2
where
p1 = d1Caffeine / d1Price
p2 = d2Caffeine / d2Price
select a1 a2
| a1 > a2 = 1
| a1 < a2 = 2
main = getContents >>= print . costperformance . map read . words
```

## 服

### セーラー服

```
import Data.List
main = getContents >>= putStrLn . concat . intersperse "_" . tail . lines
```

### カーディガン

```
myProduct :: Int -> Int
myProduct n = product [1..n]
main = getLine >>= print . myProduct . read
```

### 縞ニーソ

```
stripedPattern :: [Int] -> String
stripedPattern (w:m:[]) = concat $ take m sp
where
widte = replicate w
sp = cycle (widte "R" ++ widte "W")
main = getContents >>= putStrLn . stripedPattern . map read . lines
```

### メイド服

```
--メイド服
module Main where
import Data.Time.Calendar
import Data.Time.Clock
import Data.Time.LocalTime
import Data.Time.Format
import System.Locale
-- 時間だけを操作する方法がわからないため UTCTime を操作している
referenceBedtime :: UTCTime
referenceBedtime = UTCTime
(fromGregorian 216 4 1)
(timeOfDayToTime $ TimeOfDay 1 0 0)
outputFormat :: UTCTime -> String
outputFormat = formatTime defaultTimeLocale "%H:%M"
differenceMinuteTime :: NominalDiffTime -> UTCTime -> UTCTime
differenceMinuteTime n = addUTCTime ((-60) * n)
bedtime :: String -> String
bedtime x = outputFormat
$ differenceMinuteTime minute referenceBedtime
where
minute = fromInteger (read x `div` 3) :: NominalDiffTime
main = getContents >>= putStrLn . unlines . map bedtime . tail . lines
```

## その他

### めがね

```
import Control.Monad
import Control.Applicative
import Data.List
type Filed = [[String]]
type X = Int -- x座標
type Y = Int -- y座標
extraction :: Int -> Filed -> [((Y, X), Filed)]
extraction n xs = concatMap (yExtraction n 0) $ xExtraction n 0 xs
xExtraction:: Int -> Int -> Filed -> [(X, Filed)]
xExtraction a b xs
| length xs < a + b = []
| otherwise = (b, ex) : xExtraction a (b+1) xs
where
ex = map (take a . drop b) xs
yExtraction :: Int -> Int -> (X, Filed) -> [((Y, X), Filed)]
yExtraction a b xs'@(x, xs)
| length xs < a + b = []
| otherwise = ((b, x), ex) : yExtraction a (b + 1) xs'
where
ex = take a $ drop b xs
main = do
q <- getFiled =<< readLn
n <- readLn
p <- getFiled n
putStrLn $ concatMap (format . fst) $ matchPattern p $ extraction n q
where
getFiled n = map words <$> replicateM n getLine
matchPattern p = filter (\t -> p == snd t)
format (y, x) = show y ++ " " ++ show x
```

### サンタ服

```
import Control.Applicative
import Control.Monad
import Data.List
data Block = Block {x1 :: Int, x2 :: Int,
y1 :: Int, y2 :: Int} deriving (Show)
instance Eq Block
where
a == b = diffX a + diffY a == diffX b + diffY b
instance Ord Block
where
compare a b = compare (diffX a + diffY a) (diffX b + diffY b)
diffX, diffY :: Block -> Int
diffX b = x2 b - x1 b
diffY b = y2 b - y1 b
main = do
[x, y, z, n] <- map read . words <$> getLine
cutPosition <- map words <$> replicateM n getLine
let b = minimum $ foldl cut [Block 0 x 0 y] cutPosition
print $ (diffX b) * (diffY b) * z
cut :: [Block] -> [String] -> [Block]
cut xs [a, b]
| a == "0" = concatMap (cutX $ read b) xs
| a == "1" = concatMap (cutY $ read b) xs
cutX, cutY :: Int -> Block -> [Block]
cutX a b = if isCut x1 x2 a b then [b {x2 = a}, b {x1 = a}] else [b]
cutY a b = if isCut y1 y2 a b then [b {y2 = a}, b {y1 = a}] else [b]
isCut p1 p2 a block = p1 block <= a && a <= p2 block
```

### 水着（できてない）

test case4以降で失敗

時間切れ

```
fact :: Integer -> Integer
fact n = product [1..n]
headTrim :: String -> String
headTrim = dropWhile (== '0')
tailTrim :: String -> String
tailTrim = twirl headTrim
extraction :: [a] -> [a]
extraction = twirl (take 9)
twirl f = reverse . f . reverse
main = do
n <- readLn
putStrLn $ headTrim . extraction . tailTrim . show $ fact n
```