[Haskell-beginners] Spoj BWHEELER problem - input problem

David McBride toad3k at gmail.com
Sun Jan 15 09:54:54 CET 2012


It works fine for me, whether compiled or interpretted.  Are you sure
there isn't some residual files left from a previous compile that you
are running?  Try rm *.o *.hi.  Or something more mundane, not saving
the file, or running the wrong executable.

2012/1/14 Artur Tadrała <artur.tadrala at gmail.com>:
> Hello
>
> While learning Haskell I'm trying to solve some simple problems on spoj.pl
> occasionally. Currently I'm working on:
> http://www.spoj.pl/problems/BWHEELER/. I figured out how to solve it but I
> have some problems with reading input (that's my guess)
>
> Here is my solution:
>
> import Data.List
> import Data.Array
> import qualified Data.ByteString.Lazy.Char8 as BS
> import IO
>
> traverse :: Array Int (Char, Int) -> Int -> Int -> String -> String
> traverse endings n k acc =
>     let (c,i) = endings ! n
>     in if k == 0
>         then acc
>         else traverse endings i (k-1) (c:acc)
>
> solve :: (Int, String) -> String
> solve (n,w) =
>     let l = length w
>         endings = sort $ zip w [0..]
>         endingsArray = array (0, l) (zip [0..] endings)
>     in reverse $ traverse endingsArray (n-1) l ""
>
> parseCases :: [BS.ByteString] -> [(Int, String)]
> parseCases (l:l':ls) =
>     let n = readInt l
>         w = BS.unpack l'
>     in (n,w):parseCases ls
> parseCases _ = []
>
> main :: IO ()
> main = do
>   ls <- BS.lines `fmap` (BS.readFile "input.txt")
> --BS.getContents
>   putStr $ unlines $ map solve $ parseCases ls
>
> readInt :: BS.ByteString -> Int
> readInt x =
>   case BS.readInt x of Just (i,_) -> i
>                        Nothing    -> error ("Unparsable Int" ++ (show x))
>
>
> The input.txt file contains following text:
> 2
> bacab
> 3
> rwlb
> 11
> baaabaaaabbbaba
> 0
>
> When I compile and execute this code i get follwing output:
> aaaaaa
> lllll
> bbb
>
> It's different  when compared to this in ghci ( this is what I expect):
>  > map solve [(2,"bacab"), (3, "rwlb"), (11,"baaabaaaabbbaba")]
> ["abcba","rbwl","baaabbbbaaaaaab"]
>
> Can you explain me what I'm doing wrong?
> I appreciate any tips how to improve this code also.
>
> Thanks for help!
> Artur Tadrała
>
> _______________________________________________
> Beginners mailing list
> Beginners at haskell.org
> http://www.haskell.org/mailman/listinfo/beginners
>



More information about the Beginners mailing list