Haskellでエイトクイーン(Nクイーン)を解かせてみた
とりあえずHaskell勉強しはじめてもう1年半以上たつのに、自分で何も書いたことがなかったので練習がてらエイトクイーンでも解かせてみました。
所要時間6,7時間。しかもコード汚い…(汗)。
ghc hoge.hs ./a.out 8
とかやって実行。
とりあえず手続き型言語のノリで書いたので根本的に考え方を間違っているような気がする。暇ができたらもう少し綺麗にすることを考えます。
import System type Pt = (Int, Int) --[Pt]にはいままでQを置いた座標と今注目している座標が入る search :: Int -> [Pt] -> [[Int]] -> [String] search n plist table |(snd $ head plist)>=n && (fst $ head plist)==0 = answer |(snd $ head plist)>=n = search n ((fst (plist!!1), (snd (plist!!1))+1):(drop 2 plist)) $ removeQ (plist!!1) 0 table |(fst $ head plist)>=n = (output table : "\n" : (search n ((fst (plist!!1),(snd (plist!!1))+1):(drop 2 plist)) $ removeQ (plist!!1) 0 table)) |table!!(fst $ head plist)!!(snd $ head plist)>0 = search n ((fst $ head plist, (snd $ head plist)+1):(tail plist)) table |otherwise = search n (((fst $ head plist)+1, 0):plist) $ putQ (head plist) 0 table --リストの添字sからe-1までの部分リストを返す takeDrop :: Int -> Int -> [a] -> [a] takeDrop s e list |s<0 && e<0 = [] |s<0 = take e list |s>=(length list) && e>=(length list) = [] |e>=(length list) = drop s list |otherwise = take (e-s) $ drop s list putQ :: Pt -> Int -> [[Int]] -> [[Int]] putQ (y, x) n table |n>=(length table) = [] |otherwise = (calc n (table !! n)) : (putQ (y, x) (n+1) table) where calc :: Int -> [Int] -> [Int] calc yy list |yy == length list = [] |yy < y = (take (x-y+yy) list) ++ (map (+1) $ takeDrop (x-y+yy) (x-y+yy+1) list) ++ (takeDrop (x-y+yy+1) x list) ++ (map (+1) $ takeDrop x (x+1) list) ++ (takeDrop (x+1) (x+y-yy) list) ++ (map (+1) $ takeDrop (x+y-yy) (x+y-yy+1) list) ++ (drop (x+y-yy+1) list) |yy == y = (map (+1) $ take x list) ++ [-1] ++ (map (+1) $ drop (x+1) list) |yy > y = (take (x-yy+y) list) ++ (map (+1) $ takeDrop (x-yy+y) (x-yy+y+1) list) ++ (takeDrop (x-yy+y+1) x list) ++ (map (+1) $ takeDrop x (x+1) list) ++ (takeDrop (x+1) (x+yy-y) list) ++ (map (+1) $ takeDrop (x+yy-y) (x+yy-y+1) list) ++ (drop (x+yy-y+1) list) removeQ :: Pt -> Int -> [[Int]] -> [[Int]] removeQ (y, x) n table |n>=(length table) = [] |otherwise = (calc n (table !! n)) : (removeQ (y, x) (n+1) table) where calc :: Int -> [Int] -> [Int] calc yy list |yy == length list = [] |yy < y = (take (x-y+yy) list) ++ (map (subtract 1) $ takeDrop (x-y+yy) (x-y+yy+1) list) ++ (takeDrop (x-y+yy+1) x list) ++ (map (subtract 1) $ takeDrop x (x+1) list) ++ (takeDrop (x+1) (x+y-yy) list) ++ (map (subtract 1) $ takeDrop (x+y-yy) (x+y-yy+1) list) ++ (drop (x+y-yy+1) list) |yy == y = (map (subtract 1) $ take x list) ++ [0] ++ (map (subtract 1) $ drop (x+1) list) |yy > y = (take (x-yy+y) list) ++ (map (subtract 1) $ takeDrop (x-yy+y) (x-yy+y+1) list) ++ (takeDrop (x-yy+y+1) x list) ++ (map (subtract 1) $ takeDrop x (x+1) list) ++ (takeDrop (x+1) (x+yy-y) list) ++ (map (subtract 1) $ takeDrop (x+yy-y) (x+yy-y+1) list) ++ (drop (x+yy-y+1) list) output :: [[Int]] -> String output table = unlines $ map translate table translate :: [Int] -> String translate line = map (\c -> if c<0 then 'Q' else '+') line --テスト用 translateTest :: [Int] -> String translateTest line = concatMap (\c -> if c<0 then "Q " else (show c ++ " ")) line main = do args <- getArgs let n = read $ head args table = take n $ repeat $ take n $ repeat 0 slist = search n [(0,0)] table mapM_ putStr slist print $ length $ filter (\cs -> cs /= "\n") slist
id:gomi-boxにスクロールバーの付け方を教えていただきました。