M.Suzuki
タブ区切りデータの処理
(Nested
Flatten)
あまり美しくないですが、基本に忠実に。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | 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
|
lessの実装
(Nested
Flatten)
IOまみれですが、なんとか実装しました。 ライブラリを使えば楽勝と思いきや、必要な機能が無かったり、 画面サイズを超えるとエラーになったりと、意外と手間取り、 検索機能を入れる前に、力尽きてしまいました。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 | {-# 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
|
2^i * 3^j * 5^k なる整数
(Nested
Flatten)
軽く候補の絞込み(2と3と5の倍数しか回答は無いので)を入れてみました。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | 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
|
起動オプションの解析
(Nested
Flatten)
少々無理矢理な感じです。。。Parsecが使えたらもっと楽なのでしょうね(^^;
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 | 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"]
--}
|
文字列型日時ののN秒後時間取得
(Nested
Flatten)
なんの工夫もないコードです。
1 2 3 4 5 6 7 | 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)
|
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]
|
LL Golf Hole 8 - 横向きのピラミッドを作る
(Nested
Flatten)
がんばって53Byte
1 | main=mapM(\x->putStrLn$replicate(4-abs x)'*')[-3..3]
|
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"
|
もうちょっと短くなりますね。
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"
|
全部作ってから判断すると言う素直(富豪?)な実装。
1 2 3 4 5 6 | 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
|
LL Golf Hole 6 - 10進数を2進数に基数変換する
(Nested
Flatten)
なんか同じような定義があっていまいちです。。。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 | 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
|
LL Golf Hole 3 - 13日の金曜日を数え上げる
(Nested
Flatten)
方法は、各年の全月の13日が金曜日か調べるだけです。 が、目的の日付の曜日を調べる手軽な手段を見つけられなかったので、 ClockTime と CalendarTime を相互変換して、 曜日を得るために addToClockTime すると言う、なんか変な事になっています。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | 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]
|
lessの実装
(Nested
Flatten)
効率はともかく、巨大なファイルでも表示できるように作ってみました。
表示はcurses、ファイルの行インデックススキャンをバックグラウンドで行うためにpthreadを使用しています。
行インデックスもテンポラリファイルとして書き出しているので、fpos_tが32bitの環境でも2GB、64bitなら8EBまでいける(自信なし)はずです。
ただし、システム側に懲りすぎたので、タブやら一行の折り返しやらは手を抜いて全く手付かずです。
検索機能もUIが手抜きのためインクリメンタルサーチしかできません。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 | /*
Large less
programed by M.Suzuki
ver 0.1 2008/8/4
key binding
n,j,^n scroll up
p,k,^p scroll down
/ i-search
ESC i-search cancel
TAB next search(i-search only)
q quit
*/
#include <stdio.h>
#include <string.h>
#include <curses.h>
#include <pthread.h>
#define LINE_MAX 256 /* file text width max */
#define False 0
#define True (!False)
static pthread_mutex_t file_mutex;
static FILE* fileFp;
static FILE* seekFp;
static fpos_t lineTop;
static fpos_t lineMax;
static bool readMaxFlag;
static bool abortFlag;
static void ScanWait()
{
pthread_mutex_lock(&file_mutex);
while( lineTop + LINES >= lineMax ){
static struct timespec time10ms = {0,10*1000*1000};
pthread_mutex_unlock(&file_mutex);
nanosleep(&time10ms,NULL);
pthread_mutex_lock(&file_mutex);
if( readMaxFlag ){
break;
}
} /* end of while */
pthread_mutex_unlock(&file_mutex);
}
static char* ReadLine(int y, char* buff)
{
char* text = NULL;
ScanWait();
pthread_mutex_lock(&file_mutex);
if( lineTop + y + 1 < lineMax ){
fpos_t offset = sizeof(fpos_t)*(lineTop+y);
fsetpos(seekFp,&offset);
fread(&offset,sizeof(fpos_t),1,seekFp);
fsetpos(fileFp,&offset);
if( fgets(buff,LINE_MAX,fileFp) ){
text = buff;
}
}
pthread_mutex_unlock(&file_mutex);
return text;
}
static void DrawLine(int y)
{
char* text;
char buff[LINE_MAX+1];
text = ReadLine(y,buff);
if( text == NULL ){
text = "~";
}
mvinsstr(y,0,text);
}
static void ViewAll()
{
int y;
erase();
for(y=0;y<LINES;y++){
DrawLine(y);
}
}
static void RollUp()
{
ScanWait();
pthread_mutex_lock(&file_mutex);
if( lineTop >= lineMax ){
if( readMaxFlag ){
pthread_mutex_unlock(&file_mutex);
return;
}
}
lineTop++;
pthread_mutex_unlock(&file_mutex);
move(0,0);
deleteln();
move(LINES-1,0);
DrawLine(LINES-1);
refresh();
}
static void RollDown()
{
pthread_mutex_lock(&file_mutex);
if( lineTop <= 0 ){
pthread_mutex_unlock(&file_mutex);
return;
}
lineTop--;
pthread_mutex_unlock(&file_mutex);
move(0,0);
insdelln(1);
DrawLine(0);
refresh();
}
static void Search()
{
char search[LINE_MAX];
int len = 0;
while(1){
int key = getch();
int y = 0;
if( key == 0x1b ){
break;
}
if( key == '\t' ){
y = 1;
} else {
if( len < LINE_MAX ){
search[len++] = key;
search[len] = '\0';
}
}
while(1){
char buff[LINE_MAX+1];
if( ReadLine(y,buff) == NULL ){
return;
}
if( strstr(buff,search) ){
pthread_mutex_lock(&file_mutex);
lineTop += y;
pthread_mutex_unlock(&file_mutex);
ViewAll();
break;
}
y++;
} /* end of while */
} /* end of while */
}
static void KeyLoop()
{
ViewAll();
while(1){
int key = getch();
if( key == 'q' ){
break;
}
switch(key){
case 'N'-'@':
case 'n':
case 'j':
RollUp();
break;
case 'P'-'@':
case 'p':
case 'k':
RollDown();
break;
case '/':
Search();
break;
} /* end of switch */
} /* end of while */
}
void* ScanThread(void* arg)
{
fpos_t filePos;
fgetpos(fileFp, &filePos);
while(1){
char buff[LINE_MAX+1];
fpos_t fpos = sizeof(fpos_t)*lineMax;
pthread_mutex_lock(&file_mutex);
fsetpos(seekFp,&fpos);
fwrite(&filePos,sizeof(fpos_t),1,seekFp);
lineMax++;
fsetpos(fileFp,&filePos);
if( fgets(buff,LINE_MAX,fileFp) == NULL ){
break;
}
fgetpos(fileFp,&filePos);
if( abortFlag ){
break;
}
pthread_mutex_unlock(&file_mutex);
} /* end of while */
readMaxFlag = True;
pthread_mutex_unlock(&file_mutex);
return NULL;
}
static void MainLoop()
{
pthread_t scanThread_id;
char tmpName[L_tmpnam];
tmpnam(tmpName);
if( (seekFp=fopen(tmpName,"w+b")) == NULL ){
perror(tmpName);
return;
}
pthread_mutex_init(&file_mutex,NULL);
lineTop = 0;
lineMax = 0;
if( pthread_create(&scanThread_id,NULL,ScanThread,NULL)!=0){
perror("ScanThread");
return;
}
initscr();
noecho();
raw();
cbreak();
KeyLoop();
nocbreak();
noraw();
echo();
endwin();
pthread_mutex_lock(&file_mutex);
abortFlag = True;
pthread_mutex_unlock(&file_mutex);
pthread_join(scanThread_id,NULL);
fclose(seekFp);
remove(tmpName);
}
int main(int argc, char* argv[])
{
char* fname = NULL;
int i;
for(i=1;i<argc;i++){
char* p = argv[i];
if( *p == '-' ){
/* option */
} else {
fname = argv[i];
}
} /* end of for */
if( fname != NULL ){
if( (fileFp=fopen(fname,"r")) == NULL ){
perror(fname);
return 1;
}
MainLoop();
fclose(fileFp);
}
return 0;
}
|
ワーカスレッドを安全に終了させるまで待機
(Nested
Flatten)
「スレッドプールを作り、スレッドを待機させてから、リクエストを投げて結果を全て受け取る」と言う要求と受け取りました。
このプログラムでは、スレッドプールは残るようになっています。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 | #
# Thread pool
#
require 'thread'
THREADS = 5
cmd_queue = Queue.new
result_queue = Queue.new
thread_list = []
puts 'Thread start'
(0..THREADS).each do | no |
thread_list << Thread.new(no) do | no |
puts "Thread #{no} start"
while cmd = cmd_queue.pop
puts "Thread #{no} execute to #{cmd}"
sleep rand(10)+5
puts "Thread #{no} finished"
result_queue.push("#{no}")
end
end
end
puts 'Execute start'
(0..THREADS).each do | no |
cmd_queue.push("cmd #{no}")
end
puts 'Waitting execute'
(0..THREADS).each do
no = result_queue.pop
puts "Result #{no}"
end
puts 'All complete'
|
すべて置換
(Nested
Flatten)
なんかもっとシンプルに書けそうな気もするのですが。。。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | --
-- 文字列の置き換え
--
module Main where
import Data.List
replace :: String -> String -> String -> String
replace _ _ "" = ""
replace "" _ all = all
replace inp out all@(s:ss)
| isPrefixOf inp all = out ++ replace inp out (drop (length inp) all)
| otherwise = s : replace inp out ss
main = do
putStrLn $ show $ replace "abc" "ABC" "abcdefgabcdefg"
|


M.Suzuki #7842() [ Haskell ] Rating0/0=0.00
Rating0/0=0.00-0+
[ reply ]