Haskellでcode jamに挑戦 2013予選C

予選C
実際調べてみたら、1e14までなら対象の数が数十個なので一旦数十個見つけ出してあとは入力範囲内にその数十個からあるだけ数えるでLarge input 1は解けました

が、Large input 2は対象の数が多すぎて1e100ってどうやって調べるかまったく見当もつかない状態でギブアップです



これも本番時はどうしてもIntとIntegerとFloatingの変換でうまく動かず
と言うか、動く以前にコンパイルすら通すことができず断念


予選Bといい、予選CといいHaskellってまったくいいところなしのクソクズ言語だなって思ってしまいましたが、翌日落ち着いて改めて取り組んでみたらサクサク進んだと言うかやっぱりいい言語なんじゃないかなと言ったところが最終的な結論でしょうか

1e100の入力はどうやってやるか不明のままです

--digitcp c = any (\i -> i == c) ['0'..'9']

pow base n = foldl (*) 1 (take n $ repeat base)

--rInt s = read (takeWhile digitcp s) :: Integer
rInt s = read s :: Integer

check lower upper = let lowersqrt = (ceiling . sqrt)
   uppersqrt = (truncate . sqrt)
   rr = [(lowersqrt (lower::Double))..(uppersqrt (upper::Double))]
   tostr = map show
   z arr = zip (tostr arr) ((map reverse . tostr) arr)
   filterpalindrome arr = (map (rInt . fst) . filter (\(a, b) -> a == b) . z) arr
   in
   (map (rInt . fst) . filter (\(a, b) -> a == b) . z) (map (\x -> x * x) $ filterpalindrome rr)
   --(length . filter (\(a, b) -> a == b) . z) (map (\x -> x * x) $ filterpalindrome rr)

start = check (pow 10 14) (pow 10 15)
st n = check (pow 10 n) (pow 10 (n + 1))
format n m = "Case #" ++ show n ++ ": " ++ show m

parserec _ [] = []
parserec n lines = let lower = (rInt . head . words . head) lines
         upper = (rInt . last . words . head) lines
         in
         (format (n + 1) (check (fromIntegral lower) (fromIntegral upper))) : (parserec (n + 1) . tail) lines

parserec_large1 _ _ [] = []
parserec_large1 n res lines = let lower = (rInt . head . words . head) lines
      upper = (rInt . last . words . head) lines
      in
      ((format (n + 1) . length . filter (\i -> and [(i >= lower), (i <= upper)])) res) : (parserec_large1 (n + 1) res . tail) lines

parse lines = let t = (rInt . head) lines
    in
    (parserec 0 . tail) lines

parse_large1 lines = let t = (rInt . head) lines
    res = check 1 (pow 10 14)
    in
    (parserec_large1 0 res . tail) lines

main = do cs <- getContents
   (putStr . unlines . parse_large1 . lines) cs

Haskellでcode jamに挑戦 2013予選B

予選B
とりあえず入力に近づくように刈れるだけ刈ってみる
縦横m*n回できるかぎり入力のように刈ってみて入力と比較して結局一緒になっているかどうかで可能かどうか判定

特に困るところはなくsmallもlargeも解けた




と言いたいところなんですけど、どっか間違えていてなぜかincorrect判定
で直せない、直す気力がなかったです
アルゴリズム的には絶対合っている自信があったので次の日再度プログラム組んでみたらやっぱり正解でした
と言うことで公式記録としては点数として残りませんでした

やっぱり本番だろうと動揺せずに冷静に取り組めるようになるためにも練習とか大事だなと思いましたね
って言うかこの時点では本当に入力データのパースに参っていて何やってるかさっぱり訳わかんない状態だったからね
自分で考えてHaskellのプログラムしたのは去年のcode jam以来だと思うので
って言うか去年も数問解けたのあるのですけど本当、自分でやっておいてまったく信じられないからね
よくHaskellで問題が解けたな去年の俺って感じですから

あと次の日落ち着いて練習のつもりで気楽にやってみたら入力文字のパースも簡単な方法がわかってなんか拍子抜けな感じ
takeとdropと再帰とwordsでこんなにも簡単にパースできるなんて昨日の苦労はなんだったんだろうかと感じております

org n = take n $ repeat 100

f rows cols ans = let size = rows * cols
        inrow n i = and [i >= n * cols, i < ((n + 1) * cols)]
        incol n i = (i `mod` cols) == n
        setrowval nth n = map (\i -> if inrow nth i then n else 0) [0..(size - 1)]
        setcolval nth n = map (\i -> if incol nth i then n else 0) [0..(size - 1)]
        mergeifnotzero = zipWith (\a  b -> if b /= 0 then (min a b) else a)
        rowvals nth = zipWith (\a b -> if inrow nth a then b else 0) [0..]
        colvals nth = zipWith (\a b -> if incol nth a then b else 0) [0..]
        computerow ans input nth = mergeifnotzero input $ setrowval nth ((maximum . rowvals nth) ans)
        computerows ans input = foldl (computerow ans) input [0..rows-1]
        computecol ans input nth = mergeifnotzero input $ setcolval nth ((maximum . colvals nth) ans)
        computecols ans input = foldl (computecol ans) input [0..cols-1]
        compute ans = (computerows ans . computecols ans . org) (rows * cols)
        in
        compute ans

rInt s = read s :: Int
resformat n b
  | b = "Case #" ++ show n ++ ": YES"
  | otherwise = "Case #" ++ show n ++ ": NO"

parseItem _ [] = []
parseItem n lines = let rows = (rInt . head . words . head) lines
   cols = (rInt . last . words . head) lines
   ls = (take rows . drop 1) lines
   ans = (map rInt . words . unlines) ls
   res = f rows cols ans
   in
   ((resformat (n + 1) . and) $ zipWith (==) ans res) : (parseItem (n + 1) . drop (rows + 1)) lines

parse lines = let t = (rInt . head) lines
    in
    (parseItem 0 . tail) lines

main = do cs <- getContents
   (putStr . unlines . parse . lines) cs

Haskellでcode jamに挑戦 2013予選A

2013年のcode jamに懲りずにまたまたHaskellで挑戦しました

Land of Lisp読んだばっかりだからやっぱりCommon Lispでやりたかったけど結局code jamみたいな数値計算系はHaskellの方が有利かなと思ってHaskellで挑戦しました
結局、入力のパースで散々な目にあいましたが

予選A
Xを+1、Oを-1、Tを2倍にするとして+3を上回るか-3を下回るものがあるか検索
+3を上回るか-3を下回るものが見つかったら終了
見つからなかったら「.」を検索してあったら途中、なかったら引き分けとして決着
注意点はTの2倍を最後に回すように気をつけてsmall、largeともにクリアできました

HaskellらしくX,O,Tの処理を関数の部分適応で対応したところがHaskellらしいのではないかなと思っております

しかし本題に取り組むよりも入力のパースで手間取りました
Haskellで入力をパースしてどうこうするってことをあまりやったことがないからテキストから整数に変換する方法やら入力を成形するところで大幅につまづきました
正直、途中で心が折れるところでした

import Data.List

x = (+1)
t = (*2)
o = (subtract 1)
d = (+0)

input = "xxxt....oo......"
predp 't' _ = GT
predp _ _ = LT

mapf = map f
     where f 'x' = x
    f 't' = t
    f 'o' = o
           f 'X' = x
    f 'T' = t
    f 'O' = o
    f '.' = d
    f _ = d

so = sortBy predp

r n = take 4 . drop (4 * n)
c n xs = foldr (\nn a -> (head $ drop (4 * nn + n) xs) : a) [] [0..3]
lurb xs = foldr f [] [0..3]
     where f 0 a = (head xs) : a
    f 1 a = (head $ drop 5 xs) : a
    f 2 a = (head $ drop 10 xs) : a
    f 3 a = (head $ drop 15 xs) : a
rulb xs = foldr f [] [0..3]
     where f 0 a = (head $ drop 3 xs) : a
    f 1 a = (head $ drop 6 xs) : a
    f 2 a = (head $ drop 9 xs) : a
    f 3 a = (head $ drop 12 xs) : a
app = foldl (\n x -> x n) 0

inputs = map (app . mapf . so) $ (map (\n -> r n input) [0..3]) ++ (map (\n -> c n input) [0..3]) ++ [(lurb input)] ++ [(rulb input)]
inlist i = map (app . mapf .so ) $ (map (\n -> r n i) [0..3]) ++ (map (\n -> c n i) [0..3]) ++ [(lurb i)] ++ [(rulb i)]

rInt s = read s :: Int

res [] s n
  | any (=='.') s = "Case #" ++ show n ++ ": Game has not completed"
  | otherwise = "Case #" ++ show n ++ ": Draw"
res (x:xs) s n
  | x > 3 = "Case #" ++ show n ++ ": X won"
  | x < -3 = "Case #" ++ show n ++ ": O won"
  | otherwise = res xs s n

main = do cs <- getContents
   putStr $ unlines $ map (\(s, m) -> res (inlist s) s (m + 1)) $ map (\n -> (foldl (++) "" $ take 4 $ drop ((n * 5) + 1) $ lines cs, n)) [0..((rInt $ head $ lines cs) - 1)]

ナチス式敬礼をしたサッカー選手

ナチス式敬礼をしたサッカー選手が騒ぎになっていましたけど、この人の写真見たときに富永一郎のマネしてるかと思いましたね

お笑いマンガ道場のエンディングで富永一郎がいつもやってるポーズと同じだなと

虚数の情緒

たまに趣味なんですかとか休みの日なにやってるんですかって聞かれるんですけど数学って答えるとびっくりされて鬱陶しいんですけどね
こんな本を休みに好んで読んでるってことはちょっとおかしいかもしれないなと思えるような本
今の時代らしいとにかく金を稼げと
とにかくお金で換算してどうこうって本とは全然違ってとにかく勉強しろと言う熱い本
時間がかかってもいいからとにかくやれと
資本主義の概念だとお金払って数学得意な人を雇えといわれそうなんですけどこの本では自分で身に付けろといってい

Code Jamの季節到来

今年こそ予選突破を目指す

最強プログラミング言語のCommon Lispを味方につけて予選突破をめざす
我ながらなんて低い目標なのかと悲しくなってきますが身の程をわきまえるとこの程度の実力しか有していないから仕方がないですね
大体、英語の問題の時点でかなり苦痛を強いられてしまうから悲しいです
出題文の英語がね
とりあえず問題の意味がわかるかどうかにかかっていますが
予選程度の問題だったら日本語で出題されたらわかるのかな？
いままでの実績だとsmallは解けるんだよな
でもlargeがダメなんだよね