Haskellでpaiza「彼女をつくる」に挑戦

More than 3 years have passed since last update.

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