Mon Aug 3 15:27:20 JST 2015

今日12時ごろに家を出て数秒歩いただけで頭痛が出てきた。今日は寝て過ごすことに決めた。

先日、7/28に夏コミの為の印刷を出した。 http://www.seichoku.com/。その時はコミケの為の特別な手配をしてくれるようなところに見えなかったけれど、今日見ると、夏コミの為の色々なことを、具体的にはコミケ会場への配達を無料でやってくれていたらしい。 8/6までに出せばよかったらしい。来年からの参考にしよう。

奥付というもののルールを甘く見ていた。印刷所のルールでもコミケットアピールでのルールでも、奥付としていくつかがルール付されていた。

今回はこれをガン無視していた。私のは上の4つは書いてたけれど、印刷所の名前はダサいので入れてなかった。調べるとYahoo知恵袋で、そんくらい無くても大丈夫だよ、という記述を見かけたが、不安だ。

Haskell 四則パズル 10パズル Make a ten

解いた: 数式 | Aizu Online Judge。使える演算が +-* の3つだけで、しかもよく見ると入力が 4 つの 0-9 なので、0以上の自然数の範囲だけでよかった。下のは整数 (Int) の範囲で解く。割り算が使えるようにするには有理数の使い方を調べなくっちゃいけない。

こういうの、絶対、大昔に書いてネットのどこかにあるのに見つけられないや。

example

src

{-
 - AOJ 0041: Expression (original in PCK 2004)
 - http://judge.u-aizu.ac.jp/onlinejudge/description.jsp?id=0041
 -}

import Data.Array.IO
import Data.Char
import System.IO
import Control.Monad
import Control.Applicative

{-
 - list から 1, 2 個選んで残りも一緒に返す
 - 2個選ぶときは順序付きのペアだとする (x,y) と (y,x) を一般に区別する
 - > one [1..6]
 - [(1,[2,3,4,5,6]),(2,[3,4,5,6,1]),(3,[4,5,6,2,1]),
    (4,[5,6,3,2,1]),(5,[6,4,3,2,1]),(6,[5,4,3,2,1])]
 - > two [1..6]
 - [(1,2,[3,4,5,6]),(1,3,[4,5,6,2]),(1,4,[5,6,3,2]),(1,5,[6,4,3,2]),(1,6,[5,4,3,2]),
    (2,3,[4,5,6,1]),(2,4,[5,6,1,3]),(2,5,[6,1,4,3]),(2,6,[1,5,4,3]),(2,1,[6,5,4,3]),
    (3,4,[5,6,2,1]),(3,5,[6,2,1,4]),(3,6,[2,1,5,4]),(3,2,[1,6,5,4]),(3,1,[2,6,5,4]),
    (4,5,[6,3,2,1]),(4,6,[3,2,1,5]),(4,3,[2,1,6,5]),(4,2,[1,3,6,5]),(4,1,[2,3,6,5]),
    (5,6,[4,3,2,1]),(5,4,[3,2,1,6]),(5,3,[2,1,4,6]),(5,2,[1,3,4,6]),(5,1,[2,3,4,6]),
    (6,5,[4,3,2,1]),(6,4,[3,2,1,5]),(6,3,[2,1,4,5]),(6,2,[1,3,4,5]),(6,1,[2,3,4,5])]
-}

one :: [a] -> [(a, [a])]
one xs = sub xs []
  where
    sub [] _ = []
    sub (x:xs) ac = (x, xs++ac) : (sub xs (x:ac))

two :: [a] -> [(a, a, [a])]
two [] = []
two [a] = []
two xs = do
  (x, rest) <- one xs
  do
    (y, rest) <- one rest
    return (x, y, rest)

data Expr = Val Int | Add Expr Expr | Sub Expr Expr | Mul Expr Expr
type Number = (Expr, Int)

eval :: Number -> Int
eval = snd

{-
 - n 個の Number に一回演算を適用して出来る (n-1) 個の Number を返す
 -}
apply :: [Number] -> [[Number]]
apply xs = concat $ do
  ((e, x), (f, y), rest) <- two xs
  return [
    (Add e f, x + y) : rest,
    (Sub e f, x - y) : rest,
    (Mul e f, x * y) : rest
    ]

{-
 - (bfs n xs) は xs に何度か apply を適用して
 - 評価結果が n になる Number を返す
 -}
bfs :: Int -> [[Number]] -> [Number]
bfs n [] = []
bfs n ([x] : rest) =
  (if (eval x) == n then [x] else []) ++ (bfs n rest)
bfs n (xs : rest) = bfs n (rest ++ (apply xs))

instance Show Expr where
  show (Val n) = show n
  show (Add e f) = "(" ++ show e ++ " + " ++ show f ++ ")"
  show (Sub e f) = "(" ++ show e ++ " - " ++ show f ++ ")"
  show (Mul e f) = "(" ++ show e ++ " * " ++ show f ++ ")"

toVal :: Int -> Number
toVal n = (Val n, n)

solve a b c d = do
  let anss = bfs 10 [[toVal a, toVal b, toVal c, toVal d]]
  if null anss
    then print 0
    else print $ fst $ head $ anss

main = do
  [a,b,c,d] <- (map read . words)<$>getLine :: IO [Int]
  if (minimum [a,b,c,d]) == 0
    then return ()
    else solve a b c d >> main

今日のこと

Haskell 四則パズル 10パズル Make a ten

example

src