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にスクロールバーの付け方を教えていただきました。