Hatena::ブログ(Diary)

みずぴー日記

2010-08-30(月)

漢数字への変換

| 漢数字への変換 - みずぴー日記 を含むブックマーク

30分プログラム、その798。数字から漢数字への変換をやってみました。

1以上1億未満の数字にのみ対応してます。

使い方

*Main> kanji 10
十
*Main> kanji 42
四十二
*Main> kanji 12345
一万二千三百四十五

ソースコード

import qualified System.IO.UTF8 as U

right  = ["", "一", "二","三","四","五","六","七","八","九"]
left = ["", "二","三","四","五","六","七","八","九"]
sep p xs ys  = ys ++ [ x ++ p ++ y | x <- xs, y <- ys]

xs = sep "万" (tail ys) ys
    where ys = foldl (\x p -> sep p left x) right ["十","百","千"]

kanji n = U.putStrLn (xs !! n)

参考

clairvyclairvy 2010/08/30 18:44 ごぬんなさい.
間違いなく仕事です.
一応行ってみようと思いますが,
普通の時間には行けそうにないです.自分がヤバス

2010-08-11(水)

単語の削除

| 単語の削除 - みずぴー日記 を含むブックマーク

30分プログラム、その792。anarchy golf - delete wordsインスパイアされました。

使い方

*Main> deleteWord "golf" "flogwaiurhgm"
"    waiurh m"

ソースコード

replace :: Eq a => a -> a -> [a] -> [a]

replace _ _ [] = []
replace old new (x:xs) =
    if old == x then
        new : replace old new xs
    else
        x : replace old new xs

deleteWord :: String -> String -> String
deleteWord xs ys =
    foldr (\x str -> replace x ' ' str) ys xs

参考

2010-07-11(日)

魔方陣を作ってみる

| 魔方陣を作ってみる - みずぴー日記 を含むブックマーク

30分プログラム、その784。魔方陣を作ってみた。

最初はリストモナドでベタ書きしようかと思ったけど

magicSquare = do a <- [1..9]
	         b <- delete a [1..9]
		 c <- delete b $ delete a [1..9]
		 ....
		 guard ...
		 return ...

みたいなひどいことになりそうだったのでやめました、まる。

使い方

*Main> magicSquare
[[[2,7,6],[9,5,1],[4,3,8]],[[2,9,4],[7,5,3],[6,1,8]],
 [[4,3,8],[9,5,1],[2,7,6]],[[4,9,2],[3,5,7],[8,1,6]],
 [[6,1,8],[7,5,3],[2,9,4]],[[6,7,2],[1,5,9],[8,3,4]],
 [[8,1,6],[3,5,7],[4,9,2]],[[8,3,4],[1,5,9],[6,7,2]]]

ソースコード

import Data.List
import Control.Monad.List
shuffle :: [Int] -> [[Int]]

shuffle [] = [[]]
shuffle xs = do y <- xs
                ys <- shuffle (delete y xs)
                return (y:ys)

same :: Eq a => [a] -> Bool
same [] = True
same (x:xs) = all (==x) xs

magicSquare = do [a,b,c,d,e,f,g,h,i] <- shuffle [1..9]
                 guard $ same [
                            a + b + c, d + e + f, g + h + i,
                            a + d + g, b + e + h, c + f + i,
                            a + e + i, c + e + g
                           ]
                 return [[a, b, c],
                         [d, e, f],
                         [g, h, i]]

参考

2010-06-27(日)

-3進数への変換

| -3進数への変換 - みずぴー日記 を含むブックマーク

30分プログラム、その776。anarchy golf - Negatenaryインスパイアされて、-3進数への変換をやってみました。

基数が負の変換はやったことがなかったので、わりと苦戦しました。各桁が必ず正の数になるようにするのがむずい!

使い方

*Main> negatenary (-60)
"2020"

ソースコード

negatenary :: Integral a =>  a ->  String

negQuotRem x y =
    let (q,r) = x `quotRem`  y
    in if r < 0 then
           (q+1, r-y)
       else
           (q,r)

negatenary 0 = ""
negatenary n = negatenary q ++ show r
    where (q,r) = n `negQuotRem` (-3)

main = mapM_ (putStrLn.negatenary)  [-60..182]

参考

2010-06-10(木)

整数を英語に変換

| 整数を英語に変換 - みずぴー日記 を含むブックマーク

30分プログラム、その771。anarchy golf - 100インスパイアされて、整数を英語(one,two,three,...)に変換してみました。

今日のポイントは、

alphaNum n = msum [ lookup n table,
                    do let (x, y) = split n
                       x' <- lookup x table
                       y' <- lookup y table
                       return $ printf "%s %s" x' y'
                  ]

のあたり。 Int -> Maybe Stringをいくつか試してみて、最初にJust _を返してきたやつを採用するためにmsumを使ってます。MonadPlusすごい!

使い方

*Main Data.List> alphaNum 1
Just "one"
*Main Data.List> alphaNum 21
Just "twenty one"

ソースコード

import Control.Monad
import Text.Printf
alphaNum :: Int -> Maybe String

table = [(0, "zero"),
         (1, "one"),
         (2, "two"),
         (3, "three"),
         (4, "four"),
         (5, "five"),
         (6, "six"),
         (7, "seven"),
         (8, "eight"),
         (9, "nine"),
         (10, "ten"),
         (11, "eleven"),
         (12, "twelve"),
         (13, "thirteen"),
         (14, "fourteen"),
         (15, "fifteen"),
         (16, "sixteen"),
         (17, "seventeen"),
         (18, "eighteen"),
         (19, "nineteen"),
         (20, "twenty")
        ]

split :: Int -> (Int, Int)
split n = let m = n `div` 10 * 10 in
          (m, n - m)

alphaNum n = msum [ lookup n table,
                    do let (x, y) = split n
                       x' <- lookup x table
                       y' <- lookup y table
                       return $ printf "%s %s" x' y'
                  ]

参考

2010-04-19(月)

真理値表

| 真理値表 - みずぴー日記 を含むブックマーク

30分プログラム、その759。真理値表を作ってみよう。

[mixi]初心者です。 - Javaの課題丸投げ | mixiコミュニティインスパイアされました。要するに、適当な論理式を与えると真理値表を出力するプログラムです。

出力の整形は、けっこう適当です。

使い方

*Main Data.List> example
(Var "x" `And` Not (Var "y")) `Or` (Not (Var "x") `And` Var "y")
*Main Data.List>

*Main Data.List> mapM_ print $ table example
([False,False],False)
([False,True],True)
([True,False],True)
([True,True],False)

ソースコード

import Data.List
import Data.Maybe
import Control.Monad.List

data Expr = Var String
          | Expr `And` Expr
          | Expr `Or`  Expr
          | Not Expr deriving Show

vars    :: Expr -> [ String ]
pattern :: [ String ] -> [ [(String, Bool)] ]
assign  :: Expr -> [(String,Bool)] -> Bool
table   :: Expr -> [([Bool], Bool)]
format  :: ([Bool], Bool) -> String

vars (Var x)         = [ x ]
vars (lhs `And` rhs) = vars lhs ++ vars rhs
vars (lhs `Or` rhs)  = vars lhs ++ vars rhs
vars (Not e)         = vars e

pattern [] = [ [] ]
pattern (x:xs) = do y  <- [False, True]
                    ys <- pattern xs
                    return $ (x,y):ys


assign (lhs `And` rhs) vars = (assign lhs vars) && (assign rhs vars)
assign (lhs `Or` rhs)  vars = (assign lhs vars) || (assign rhs vars)
assign (Var x) vars = fromJust $ lookup x vars
assign (Not e) vars = not (assign e vars)

table e = map (\vars -> (map snd vars, assign e vars)) (pattern $ nub $ vars e)

x = Var "x"
y = Var "y"
example = x `And` (Not y) `Or` ((Not x) `And` y)

参考

2010-03-29(月)

HaskellでFizzBuzz

| HaskellでFizzBuzz - みずぴー日記 を含むブックマーク

30分プログラム、その748。HaskellでFizzBuzz。

当初の予定ではSchemeで便利なスクリプトを書く予定でしたが、諸事情により中止となりました。(手元のマシンに処理系がインストールされてなかった。)

というわけで、たまたま入っていたHaskellでFizzBuzzを書きました。FizzBuzzを書いたのは他にネタが思いつかなかったからです。

使い方

*Main> main
1
2
Fizz
4
Buzz
Fizz
7
8
Fizz
Buzz
11
Fizz
13
14
Fizz Buzz

ソースコード

fizz = cycle ["","","Fizz"]
buzz = cycle ["","","","","Buzz"]
digits = map show [1..]

fizzbuzz = zipWith3 f fizz buzz digits
    where f "" "" n = n
          f x  "" _ = x
          f "" y  _ = y
          f x  y  _ = x ++ " " ++ y

main = mapM_ putStrLn fizzbuzz

参考

2010-03-21(日)

テイラー展開によるネイピア数

| テイラー展開によるネイピア数 - みずぴー日記 を含むブックマーク

30分プログラム、その743。Haskellでテイラー展開によるネイピア数を求めてみる。

mixiの課題コミュインスパイアされています。

数値に関する型クラスがよく分からなくて、A Gentle Introduction to Haskell: Numbersを読みながらやってました。とりあえず浮動小数っぽいのをFloatingに、整数っぽいのをIntegralにしてみました。これでいいよね?

使い方

*Main> e !! 100
2.7182818011463845
*Main> e !! 100
2.7182818284590455

ソースコード

import Data.Ratio
myExp  :: Floating a => a -> [ a ]
term :: (Floating a, Integral b) => a -> b -> a
fact :: Num a => a -> a

fact 0 = 1
fact n = n * fact (n - 1)

term x n = (x ** n') / (fact n')
    where n' = fromRational ((toInteger n) % 1)

myExp x = scanl1 (+) $ map (term x) [0..]

e = myExp 1

参考

2010-03-03(水)

文字の間にwを挟む関数

| 文字の間にwを挟む関数 - みずぴー日記 を含むブックマーク

30分プログラム、その739。文字の間にwを挟む関数を書いてみました。

文字の間に文字を挟むだけなら、intersperseというずばりそのものの関数があります。が、今回は文字列を挟みたかったので自分で書きました。

あと、日本語の文字列(UTF8)を扱うためにutf8-stringパッケージを使ってます。

使い方

$ ./interperse ' w ' うはおけ
う w は w お w け

ソースコード

import System
import qualified System.IO.UTF8  as U
import Codec.Binary.UTF8.String

insertMid :: [a] -> [a] -> [a]

insertMid _   []    = []
insertMid _   [x] = [x]
insertMid sep (x:xs) = x:(sep ++ insertMid sep xs)

main = do sep:s:_ <- getArgs
          U.putStrLn $ insertMid (decodeString sep) (decodeString s)

参考

nobsunnobsun 2010/03/05 08:48 interMid sep = concat . intersperse sep . map (:[])

mzpmzp 2010/03/05 20:54 うおお。すごい。
map (:[])がクールですね。

2010-02-02(火)

べき集合

| べき集合 - みずぴー日記 を含むブックマーク

30分プログラム、その730。べき集合をもとめる関数。

前にべき集合を一行で求めるコードを見たことあるような気がするけど、思い出せなかったし、辿りつけなかった。ちぇー。

使い方

Prelude> powerSet [1..3]
[[1,2,3],[2,3],[1,3],[3],[1,2],[2],[1],[]]

ソースコード

powerSet:: [a] -> [[a]]

powerSet [] = [[]]
powerSet (x:xs) = concat [ [ (x : ys),  ys ] | ys <- powerSet xs ]

参考

BLUEPIXYBLUEPIXY 2010/02/03 15:14 "プログラミングHaskell"という本で、subsという部分リストを求める関数があるけど、それのことですかね。