Latest comments posted by M.Suzuki

M.Suzuki's comment on 漢数字で九九の表

基本的な数字を作ってから・・・なので、目新しさはありません。

k = ["一","二","三","四","五","六","七","八","九"]
ku = "  ":k
kl = "〇":k

main = putStrLn $ concat [str (x*y) | x <- [one..nine] ,y <- [one-one..nine]]
    where
        one = ten - nine
        nine = length k
        ten = length ku
        str n
            | n < one   = "\n"
            | otherwise = "  " ++ ku!!u ++ kl!!l
            where
                (u,l) = divMod n ten

[ Haskell ] [ download code ] ]

M.Suzuki's comment on タブ区切りデータの処理

タブ区切りデータの処理 (Nested Flatten)

あまり美しくないですが、基本に忠実に。

import System.Environment
import Data.List

q1 (x:xs) = x:sortBy (\a b -> compare (toNum a) (toNum b)) xs
    where
        toNum n = read (head n)::Int
q2 = map (\[i,l,f,a] -> [i,f,l,a])
q3 (x:xs) = x:map (\[i,l,f,a] -> [i,l,f,show $ 1+read a]) xs

main = do
    args <- getArgs
    contents <- if (not.null) args
        then readFile $ head args
        else getContents
    let rec = map words $ lines contents
    putStrLn $ shows $ q1 rec
    putStrLn $ shows $ q2 rec
    putStrLn $ shows $ q3 rec
    where
        shows list = unlines $ map (concat.intersperse "\t") list

[ Haskell ] [ download code ] ]

M.Suzuki's comment on lessの実装

lessの実装 (Nested Flatten)

IOまみれですが、なんとか実装しました。
ライブラリを使えば楽勝と思いきや、必要な機能が無かったり、
画面サイズを超えるとエラーになったりと、意外と手間取り、
検索機能を入れる前に、力尽きてしまいました。

{-# LANGUAGE ForeignFunctionInterface #-}

--
--  ghc --make hless.hs -lncurses
--
--  need : hscurses-1.3

import System.IO
import Control.Exception
import System.Environment
import qualified UI.HSCurses.Curses as Curses
import qualified UI.HSCurses.CursesHelper as CursesH

import Foreign
import Foreign.C.Types

--

foreign import ccall unsafe "ncurses.h winsdelln"
    winsdelln :: Curses.Window -> CInt -> IO CInt

deleteln :: Int -> IO CInt
deleteln n = winsdelln Curses.stdScr $ fromIntegral (-n)

insertln :: Int -> IO CInt
insertln n = winsdelln Curses.stdScr $ fromIntegral n

--
data File = File {
    fhandle ::  Handle,
    list    ::  [Integer]
} deriving (Show)

data Info = Info {
    file    ::  File,
    top     ::  Int
} deriving (Show)

--
scanFile :: Handle -> IO [Integer]
scanFile fp = do
    eof <- hIsEOF fp
    if eof
        then return []
        else do
            p <- hTell fp
            l <- hGetLine fp
            flist <- scanFile fp
            return (p : flist)

showLine :: File -> Int -> IO String
showLine f n
    | n >= (length $ list f)    = do return "~"
    | otherwise             = do
        hSeek (fhandle f) AbsoluteSeek $ (list f)!!n
        line <- hGetLine $ fhandle f
        return line
--

getW = do
    (_,w) <- Curses.scrSize
    return w

getH = do
    (h,_) <- Curses.scrSize
    return h

drawLine :: Info -> Int -> IO ()
drawLine info n = do
    str <- showLine (file info) (n + (top info))
    ss <- trim str
    Curses.mvWAddStr Curses.stdScr n 0 ss
    where
        trim s = do
            w <- getW
            if (length s) >= w
                then
                    return ((take (w-2) s) ++ "$")  -- (x_x)
                else
                    return s

redraw :: Info -> IO ()
redraw info = do
    h <- getH
    redraw' h
    Curses.refresh
    where
        redraw' 0 = return ()
        redraw' n = do
            m <- getH
            drawLine info (m-n)
            redraw' (n-1)

--

moveDown :: Info -> IO Info
moveDown info
    | (top info) >= len =   return info
    | otherwise         =   scrollUp
    where
        len = length $ list $ file info
        next = info { top = (top info) + 1 }
        scrollUp = do
            h <- getH
            CursesH.gotoTop
            deleteln 1
            Curses.move (h-1) 0
            drawLine next (h-1)
            Curses.refresh
            return next

moveUp :: Info -> IO Info
moveUp info
    | (top info) == 0   =   return info
    | otherwise         =   scrollDown
    where
        next = info { top = (top info) - 1 }
        scrollDown = do
            CursesH.gotoTop
            insertln 1
            drawLine next 0
            Curses.refresh
            return next

eventLoop :: Info -> IO Info
eventLoop info =
    do
        key <- Curses.getCh
        case key of
            Curses.KeyChar 'l' -> process $ return info
            Curses.KeyChar 'q' -> return info
            Curses.KeyChar 'n' -> process $ moveDown info
            Curses.KeyChar 'p' -> process $ moveUp info
            Curses.KeyUp       -> process $ moveUp info
            Curses.KeyDown     -> process $ moveDown info
            _ -> eventLoop info
        where
            process f = do
                r <- f
                eventLoop r

--

main = do
    (fileName:_) <- getArgs
    fp <- openFile fileName ReadMode
    flist <- scanFile fp
    let info = Info { file = File { fhandle = fp, list = flist}, top = 0}
    runMain info `finally` CursesH.end
    where
        runMain info = do
            CursesH.start
            redraw info
            eventLoop info

[ Haskell ] [ download code ] ]

M.Suzuki's comment on 2^i * 3^j * 5^k なる整数

2^i * 3^j * 5^k なる整数 (Nested Flatten)

軽く候補の絞込み(2と3と5の倍数しか回答は無いので)を入れてみました。

list max b n
    | (b^n) > max   =   []
    | otherwise = n : list max b (n+1)

scan n = [(n,i,j,k)|i<-list n 2 0,j<-list n 3 0,k<-list n 5 0,n == (2^i*3^j*5^k)]

result = take 100 $ concatMap (scan) $ filter (check) [1..]

check n
    | n == 1            =   True
    | (n `mod` 2) == 0  =   True
    | (n `mod` 3) == 0  =   True
    | (n `mod` 5) == 0  =   True
    | otherwise         =   False

main=do
    mapM (\x-> putStrLn $ format x) result
    where
        format (n,i,j,k) = concat [show n," = ",fmt 2 i," * ",fmt 3 j," * ",fmt 5 k]
        fmt b n = show b ++ "^" ++ show n

[ Haskell ] [ download code ] ]

M.Suzuki's comment on 起動オプションの解析

起動オプションの解析 (Nested Flatten)

少々無理矢理な感じです。。。Parsecが使えたらもっと楽なのでしょうね(^^;

data Args = Args {
    outputFlag :: Bool,
    quoteFlag :: Bool,
    debugLevel :: Int,
    names :: [String]
} deriving (Show)

newArgs =   Args {
        outputFlag = False,
        quoteFlag = False,
        debugLevel = 0,
        names = []
    }

parse [] result = result

parse (arg:args) result
    | arg == "-d"       = parse (tail args) result{ debugLevel = read $ head args }
    | opt == "-d"       = parse args result{ debugLevel = read num }
    | (head arg) == '-' = parse args $ parse' (tail arg) result
    | otherwise         = parse args result{ names = (names result) ++ [arg] }
    where
        (opt,num) = splitAt 2 arg
        parse' [] res = res
        parse' ('o':xs) res = parse' xs res{ outputFlag = True }
        parse' ('q':xs) res = parse' xs res{ quoteFlag = True }
        parse' _ _ =    error $ arg ++ " is unknown option."

optParse :: [String] -> Args
optParse args
    | (outputFlag result) == False  =   error "-o is need option."
    | (names result) == []  =   error "need file name."
    | otherwise     =   result
    where
        result = parse args newArgs

dump args = do
    putStrLn "[Option information]"
    putStrLn $ "o(output) : " ++ (onoff $ outputFlag args)
    putStrLn $ "q(quote) : " ++ (onoff $ quoteFlag args)
    putStrLn $ "d(debug) : " ++ (show $ debugLevel args)
    putStrLn ""
    putStrLn "[Paramater information]"
    putStrLn $ "count : " ++ (show $ length $ names args)
    mapM (\(no,name)->putStrLn $ (show no) ++ " : " ++ name) $ zip [1,2..] $ names args
    putStrLn ""
    where
        onoff True = "ON"
        onoff _ = "OFF"

main = do
    args <- getArgs
    dump $ optParse args
{--
    mapM_ test testData
    mapM_ dumps testData
    where
        dumps arg = dump $ optParse arg
        test arg = putStrLn $ show $ optParse arg
        testData = map words ["-o AAA",
                    "-o AAA BBB CCC",
                    "-oq AAA",
                    "-o -q AAA",
                    "-o -d1 AAA",
                    "-o -d 1 AAA",
                    "-q -d2 -o AAA"]
--}

[ Haskell ] [ download code ] ]

M.Suzuki's comment on 文字列型日時ののN秒後時間取得

文字列型日時ののN秒後時間取得 (Nested Flatten)

なんの工夫もないコードです。

import Data.Time

addDate time sec = show $ addUTCTime sec $ read time

main = do
    putStrLn $ addDate "2008-09-02 10:20:30 UTC" 15
    putStrLn $ addDate "2008-09-02 10:20:30 UTC" (-5)

[ Haskell ] [ download code ] ]

M.Suzuki's comment on LL Golf Hole 7 - バイト数を読みやすくする

LL Golf Hole 7 - バイト数を読みやすくする (Nested Flatten)

内包表現を使用して空白を詰めると73Byte

1	toMan n = last [(show $ n/1024^x) ++ [y] \| (x,y) <- zip [0,1..] " kMGTPEZY", n>=1024^x]

[ Haskell ] [ download code ] ]

M.Suzuki's comment on LL Golf Hole 8 - 横向きのピラミッドを作る

LL Golf Hole 8 - 横向きのピラミッドを作る (Nested Flatten)

がんばって53Byte

1	main=mapM(\x->putStrLn$replicate(4-abs x)'*')[-3..3]

[ Haskell ] [ download code ] ]

M.Suzuki's comment on LL Golf Hole 7 - バイト数を読みやすくする

LL Golf Hole 7 - バイト数を読みやすくする (Nested Flatten)

バイト数との事なので。。。
スペースと改行を詰めて101Byte

1
2
3

toMan n = snd $ last $ filter (\x -> n>fst x)
    $ map (\(x,y) -> (1024^x,(show $ n/1024^x) ++ [y]))
    $ zip [0,1..] " kMGTPEZY"

[ Haskell ] [ download code ] ]

M.Suzuki's comment on LL Golf Hole 7 - バイト数を読みやすくする

LL Golf Hole 7 - バイト数を読みやすくする (Nested Flatten)

もうちょっと短くなりますね。

1
2
3

toMan n = snd $ last $ filter (\x -> n>fst x)
        $ map (\(x,y) -> (10^x,(show $ n/10^x) ++ [y]))
        $ zip [0,3..] " kMGTPEZY"

[ Haskell ] [ download code ] ]

M.Suzuki's comment on LL Golf Hole 7 - バイト数を読みやすくする

LL Golf Hole 7 - バイト数を読みやすくする (Nested Flatten)

全部作ってから判断すると言う素直(富豪?)な実装。

toMan n = snd $ head $ reverse $ filter (\(x,y) -> n>x)
        $ map (\(x,y) -> (10**x, (show (n / (10**x))) ++ y))
        $ zip [0,3.0..] ["","k","M","G","T","P","E","Z","Y"]

main = do
    putStrLn $ toMan 1234567890123456789012345678901

[ Haskell ] [ download code ] ]

M.Suzuki's comment on LL Golf Hole 6 - 10進数を2進数に基数変換する

LL Golf Hole 6 - 10進数を2進数に基数変換する (Nested Flatten)

なんか同じような定義があっていまいちです。。。

toChar n = (['0'..'9']++['A'..'Z']++['a'..'z'])!!n

toStr 0 _ = "0"
toStr n b = toStr' n b
    where
        toStr' 0 _ = ""
        toStr' n b = toStr' (n `div` b) b ++ [toChar (n `mod` b)]

main = do
    putStrLn $ toStr 0 10
    putStrLn $ toStr 255 2
    putStrLn $ toStr 255 10
    putStrLn $ toStr 255 16
    putStrLn $ toStr 255 32

[ Haskell ] [ download code ] ]

M.Suzuki's comment on LL Golf Hole 3 - 13日の金曜日を数え上げる

LL Golf Hole 3 - 13日の金曜日を数え上げる (Nested Flatten)

方法は、各年の全月の13日が金曜日か調べるだけです。
が、目的の日付の曜日を調べる手軽な手段を見つけられなかったので、
ClockTime と CalendarTime を相互変換して、
 曜日を得るために addToClockTime すると言う、なんか変な事になっています。

module Main (main) where
import Time
import Control.Monad
import System.IO.Unsafe

crossProduct :: [a] -> [b]-> [(a,b)]
crossProduct = liftM2 p
    where
        p x y = (x,y)

isJason :: (Int,Int) -> Bool
isJason (year,month) = week == Friday
    where
        mon = toEnum (month-1) :: Month
        clock = toClockTime $ CalendarTime year mon 13 0 0 0 0 Sunday 0 "JST" 9 False
        time = addToClockTime (TimeDiff 0 0 0 0 0 0 0) clock
        week = ctWDay $ unsafePerformIO $ toCalendarTime time

isAfter :: CalendarTime -> (Int,Int) -> Bool
isAfter cal (year,month) =
    year > ctYear cal || month > (fromEnum $ ctMonth cal) || 13 <= ctDay cal

main :: IO ()
main = do
    time <- getClockTime
    cal <- toCalendarTime time
    putStrLn $ show $
        filter (isAfter cal) $
        filter (isJason) $ crossProduct [(ctYear cal)..2013] [1..12]

[ Haskell ] [ download code ] ]