brool » haskell

Stupid Haskell Tricks

tim — Mon, 13 Apr 2009 10:25:30 +0000

Let’s say that you really, really want some notion of objected oriented programming. So let’s make a class that represents a name, and some simple method calls on it:

data S = S { name :: String } deriving (Show)
firstname s = (words (name s))!!0
lastname  s = (words (name s))!!1

But, dammit, you want to invoke it like you would in C++. So define a function:

*Main> let (-->) x f = f x
*Main> let test = S "George Washington"
*Main> test --> firstname
"George"
*Main> test --> lastname
"Washington"

(It’s tempting to use `.`, but it conflicts with the Prelude. Also note that you could define it as “(–>) = flip ($)”). But what if it takes more than one parameter?

*Main> let flip_concat t s = intercalate t $ reverse.words $ name s
*Main> test --> flip_concat ", "
"Washington, George"
*Main> test --> flip_concat(", ")
"Washington, George"

… although you might not like that anything can be applied to (–>).

*Main> [1,2,3] --> length
3
 
class Deref a where
    (-->) :: a -> (a -> b) -> b
    x --> f = f x 
 
instance Deref S
 
*Main> [1,2,3] --> length
 
<interactive>:1:0:
    No instance for (Deref [t])
      arising from a use of `-->' at <interactive>:1:0-17
    Possible fix: add an instance declaration for (Deref [t])
    In the expression: [1, 2, 3] --> length
    In the definition of `it': it = [1, 2, 3] --> length

You can even use tuple passing to make it look even more like a typical call.

*Main> let pretty (pre, mid, post) s = pre ++ (firstname s) ++ mid ++ (lastname s) ++ post
*Main> test --> pretty ("<", ", ", ">")
""

… although that makes it harder to curry.

Haskell To WordPress (Snippet)

tim — Fri, 10 Apr 2009 08:25:00 +0000

A small snippet of code that demonstrates calling into a WordPress XML-RPC server with Haskell and HaxR.

import qualified Data.Map as Map
import Data.Maybe
import Network.XmlRpc.Client
import Network.XmlRpc.Internals
 
server = "http://yourserver.wordpress.com/xmlrpc.php"
 
-- extract multiple posts from the XML response
extract :: Value -> [Map String Value]
extract xmlresp = 
    let ValueArray rs = xmlresp in
    map (\v -> case v of 
                  ValueStruct vs -> Map.fromList vs
                  _              -> Map.fromList []) rs
 
getRecentPosts :: Int -> [Char] -> [Char] -> Int -> IO Value
getRecentPosts = remote server "metaWeblog.getRecentPosts"
 
-- print out the five most recent posts
main = do result <- getRecentPosts 1 "yourname" "yourpass" 5
          let posts = extract result
          mapM_ (\p -> print $ fromJust $ Map.lookup "title" p) posts

Haskell Performance: Array Creation

tim — Mon, 30 Mar 2009 03:00:20 +0000

Ran into another interesting performance problem while converting a small test program over to Haskell. Let’s say that you want to walk through every line of a text file, collate character frequencies, and return anything that maps to a particular frequency. For purposes of explanation we’ll do something really silly like look for lines with 10 capital ‘A’s.

{-# OPTIONS -XBangPatterns #-}
import IO
import System
import Data.Word
import Data.Array.Unboxed
import Control.Monad.ST
import Data.Array.ST
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as BI
import qualified Data.ByteString.Char8 as C
 
counts' !line = do arr <- newArray (0,255) 0 :: ST s (STUArray s Word8 Int)
                   -- collate character counts here
                   return arr
counts !line = runSTUArray (counts' line)
 
hit !line = let freq = counts line in freq!65 == 10
 
main =
    do args <- getArgs
       f <- openFile "wordlist" ReadMode
       text <- B.hGetContents f
       print $ length $ filter hit (C.lines text)

This is fast (0.07s on 300K test file, compiled with -O2 on a Macbook Pro), but there’s no actual collation going on. It suddenly becomes two magnitudes slower as soon as you start to do anything based on the line:

-- version 1 : 9.5 seconds
counts' !line = do arr <- newArray (0,255) 0 :: ST s (STUArray s Word8 Int)
                   readArray arr (B.head line) >>= \v -> writeArray arr (B.head line) (v+1)
                   return arr
counts !line = runSTUArray (counts' line)

.. equals 9.54 seconds just when you collate the first character of the string, and led me to believe that ByteStrings were slow, especially since a constant change to the array was fast (0.07 seconds):

-- version 2 : 0.07 seconds
counts' !line = do arr <- newArray (0,255) 0 :: ST s (STUArray s Word8 Int)
                   readArray arr 0 >>= \v -> writeArray arr 0 (v+1)
                   return arr

(Here I’ll elide the hours of me messing around with profiling and whatnot to try and figure out why B.head was so slow, or how to make B.foldl’ update a state variable, or sprinkling strictness bangs all over the place, or the other tons of false trails that I went down.)

It turns out that the slow portion in all of this is the newArray, not the character collation itself, which can be seen in the profile if the array creation is moved into its own routine and we look at the profile:

-- version 3
-- compile with: ghc -package bytestring stuarray.hs -prof -auto-all -O2 -o stuarray.out
-- run with: ./stuarray.out +RTS -p 
initial_array = do arr <- newArray (0,255) 0 :: ST s (STUArray s Word8 Int)
                   return arr
 
counts' !line = do arr <- initial_array
                   let ix = B.head line
                   readArray arr ix >>= \v -> writeArray arr ix (v+1)
                   return arr
counts !line = runSTUArray (counts' line)

… and the relevant part of the profile:

MAIN                     MAIN                     1           0   0.0    0.0   100.0  100.0
 main                    Main                   240           1   0.7    0.3   100.0  100.0
  hit                    Main                   242      335075   0.0    0.0    99.3   99.7
   counts                Main                   243      335075   0.0    0.2    99.3   99.7
    counts'              Main                   244      335075   0.0    0.0    99.3   99.5
     initial_array       Main                   245      335075  99.3   99.5    99.3   99.5

Which brings up two interesting points:

The Haskell optimizer was so smart that it was able to figure out that the code in version 2 built a constant array… and so only called the newArray once. (Confirmed with a profile).
New array creation seems to be so slow that it dominates a benchmark that has file I/O.

The Ocaml version took about 0.720 seconds (Ocaml version below), compared to Haskell time of about 8.5 seconds. Reducing the array size to 128 in both cases reduced it to 0.112 seconds for Ocaml and 4.3 seconds in Haskell.

Array size	Ocaml	Haskell
128	0.112	4.3
255	0.184	8.5
256	0.720	8.5

Note the discontinuity in Ocaml between 255 and 256 elements, which I find interesting. The nice people in #haskell suggested that I stop constructing/destructing the array and instead just null it out between each line, and it turned out that the best way to do that was just to thaw a starter array.

-- version 4: 0.11 seconds
initial_array = listArray (0,255) (repeat 0) :: UArray Word8 Int
 
counts' !line = do arr <- thaw initial_array
                   let ix = B.head line
                   readArray arr ix >>= \v -> writeArray arr ix (v+1)
                   return arr
counts !line = runSTUArray (counts' line)

This is still kind of strange to me (because an object is still getting constructed/destructed — thaw guarantees a copy) but you can’t argue with a performance increase. (Interestingly, using Array.copy or Array.fill in Ocaml is slower than just using Array.make). Final times? 0.11 seconds in Haskell vs. the best of ~~0.720 second~~ UPDATED: 0.12 seconds in Ocaml… and the Haskell version is just 50% slower than a C implementation with a gratuitous calloc instead of a memset.

UPDATE: An pointed out that zeroing the Ocaml array with a for loop is much faster than Array.copy or Array.fill, bringing it to about the same speed as Haskell.

Lessons learned?

Performance is a treacherous mistress
The Haskell optimizer is awesome but you have to be wary when trying to narrow down performance problems
#haskell is always full of useful suggestions
Array creation seems to be slow enough that alternatives should be explored.

open Char
open String
 
let all_lines fn filename = 
    let chan = open_in filename in
        try
            while true do 
                let line = input_line chan in 
                    fn line
            done
        with End_of_file ->
            close_in chan
 
let initial_array = Array.make 256 0
 
let count line = 
    let freq = initial_array in
    let ix = int_of_char line.[0] in 
        for i = 0 to 255 do freq.(i) <- 0 done;
        freq.(ix) <- freq.(ix) + 1;
        freq
 
let hit line = 
    let freq = count line in
        freq.(65) = 10
 
let _ = 
    let linecount = ref 0 in 
        all_lines (fun line -> if hit line then linecount := !linecount + 1 else ()) "wordlist";
        print_int !linecount

Haskell Performance: Lowercase

tim — Sun, 29 Mar 2009 02:05:25 +0000

I was trying to track down some issues with some text processing programs that I was writing in Haskell, and ran into an interesting problem. I made one small change and my program ended up being 5 times slower, and I had to backtrack to try and find out what it was. So, given a simple Haskell program that sees if a word is in a wordlist:

import IO
import System
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as BI
import qualified Data.ByteString.Char8 as C
 
main = do args <- getArgs
          let searchfor = C.pack $ head args
          f <- openFile "wordlist" ReadMode
          text <- B.hGetContents f 
          print $ length $ filter ((==) searchfor) (C.lines text)

To search a smallish list of about 300K words takes 0.040 seconds on my computer, compared to 0.200 seconds for Python and 0.210 seconds for a naive Haskell implementation that is not using ByteStrings. However, let’s just add lowercase to the equation:

import IO
import System
import Data.Char
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as BI
import qualified Data.ByteString.Char8 as C
 
main = do args <- getArgs
          let searchfor = C.pack $ head args
          f <- openFile "wordlist" ReadMode
          text <- B.hGetContents f 
          print $ length $ filter (\x -> (C.map toLower x) == searchfor) (C.lines text)

Suddenly, the ByteString version becomes about 30% slower than the naive version — 0.337 seconds vs. 0.251 seconds — and is even slower than the Python version. What the heck is going on here? Trying an empty map (i.e., C.map id x) resulted in something fast, so I’m suspecting that the lowercase function itself is slow.

Unfortunately, there doesn’t seem to be a lowercase available in ByteString; at the moment it seems that you need to set up your own ctype table and use that.

import IO
import System
import Data.Char
import Data.Word
import Data.Array.Unboxed
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as BI
import qualified Data.ByteString.Char8 as C
 
ctype_lower = listArray (0,255) (map (BI.c2w . toLower) ['\0'..'\255']) :: UArray Word8 Word8
lowercase = B.map (\x -> ctype_lower!x)
 
main = do args <- getArgs
          let searchfor = C.pack $ head args
          f <- openFile "wordlist" ReadMode
          text <- B.hGetContents f 
          print $ length $ filter (\x -> (lowercase x) == searchfor) (C.lines text)

… which turns out to run really quickly at 0.070 seconds, about the same as a C program doing the same task.

Update: See dons comments below — Char is operating on Unicode, which makes it slow. I wonder if a ctype.h-type library for ByteString makes sense?

Using MissingPy

tim — Fri, 20 Mar 2009 02:15:00 +0000

For comparison purposes, I was rewriting the silly little e-mail digest program in Haskell, using Python libraries for the IMAP interface (it’s available on Github). It’s hard to beat Python’s amazing collection of libraries. Cabal / hackage isn’t bad, but it doesn’t yet approach Python’s “batteries included” philosophy and ease of use. Anyway, I couldn’t find an IMAP library for Haskell, so decided instead to try MissingPy to interface into the Python IMAP library. A quick overview/tutorial:

Installing MissingPy

I had an issue using Cabal to install MissingPy into my GHC 6.10 installation (Mac OS X). I went into the directory that had been unpacked and modified Setup.hs:

import Distribution.PackageDescription
import Distribution.PackageDescription.Parse  -- added this line
import Distribution.Simple

A cabal configure, build, and install of the package then installed everything.

Basic Usage

It’s easiest to play around with MissingPy in ghci. Before you do anything you’ll need to initialize the interpreter with py_initialize and import any necessary modules with pyImport. You can test by using pyRun_SimpleString:

# :m Python.Interpreter Python.Objects Python.Utils Python.Exceptions
# py_initialize
# pyRun_SimpleString "print 'hello'"
hello

The simplest useful way to execute python code is to use pyRun_String. For example:

-- add 1 and 2 in Python
-- can also use Py_file_input or Py_single_input for different handling of the context
addem = pyRun_String "1+2" Py_eval_input [] >>= fromPyObject :: IO Integer

There are also the callByName and pyObject_Call methods for more complicated scenarios.

callByName :: String            -- ^ Object\/function name
           -> [PyObject]        -- ^ List of non-keyword parameters
           -> [(String, PyObject)] -- ^ List of keyword parameters
           -> IO PyObject
 
pyObject_Call :: PyObject       -- ^ Object to call
              -> [PyObject]     -- ^ List of non-keyword parameters (may be empty)
              -> [(String, PyObject)] -- ^ List of keyword parameters (may be empty)
              -> IO PyObject    -- ^ Return value
 
-- example 1: create an IMAP instance
imap <- callByName "imaplib.IMAP4_SSL" [imap_hostname] []
 
-- call "foo.bar(p1,p2)"
bar <- getattr foo "bar"
result <- pyObject_Call bar [p1,p2] []

Manipulating Python Objects

The fromPyObject and toPyObject handle marshaling of objects from Haskell to Python and vice versa. There are some handy functions for doing common operations on Python objects that are especially useful from the REPL: reprOf (like Python repr), strOf (Python str), showPyObject (shows the type and repr), and dirPyObject (like the Python dir()).

# g <- pyRun_String "(1,2,'hello')" Py_eval_input []
# showPyObject g
": (1, 2, 'hello')"
# reprOf g
"(1, 2, 'hello')"
# strOf g
"(1, 2, 'hello')"
# dirPyObject g
["__add__","__class__","__contains__","__delattr__","__doc__","__eq__","__ge__",
"__getattribute__","__getitem__","__getnewargs__","__getslice__","__gt__",
"__hash__","__init__","__iter__","__le__","__len__","__lt__","__mul__","__ne__",
"__new__","__reduce__","__reduce_ex__","__repr__","__rmul__","__setattr__","__str__"]

Dealing with Data

Tuples look like lists when they are returned. There is no conversion of tuples in the toPyObject call, so you’ll need to just convert a list and then convert it to a tuple with pyList_AsTuple. Passing “None,” “True,” or “False” is trickier; the only way I found to do it was create an instance of the value and use it in subsequent calls.

# a
[1,2]
# b <- toPyObject a
# reprOf b
"[1L, 2L]"
# pyList_AsTuple b >>= reprOf
"(1L, 2L)"
 
-- get "True," "False," and "None"
none <- pyRun_String "None" Py_eval_input []
pyTrue <- pyRun_String "True" Py_eval_input []
pyFalse <- pyRun_String "False" Py_eval_input []
 
-- try it out
# r <- pyRun_String "1==1" Py_eval_input []
# r == pyTrue
True

Passing Haskell Objects

If you want to call into functions without having to deal with Python objects, there are a couple of calls that automatically marshal the objects back and forth for you (all suffixed with “Hs”), although they turn out to be less than useful in most situations, since a) the parameters passed in must all be the same type, and b) extracting most return objects from Python is painful.

call	invoked upon	returns
callByNameHs	Object/function name	Haskell
pyObject_CallHs	PyObject	Haskell
pyObject_Hs	PyObject	Python
pyObject_RunHs	PyObject	nothing
callMethodHs	PyObject + method name	Haskell
runMethodHs	PyObject + method name	nothing

Exceptions

Python exceptions can be caught and handled; probably the easiest default way to do this is to use handlePy in conjunction with the ex2ioerr handler, which will automatically print the exception and fail.

addem = handlePy exc2ioerror $ 
           do r <- pyRun_String "1/0" Py_eval_input []
              fromPyObject r :: IO Integer
 
# addem
*** Exception: user error (Python <type 'exceptions.ZeroDivisionError'>: integer division or modulo by zero)

Python to Haskell (String Functions)

tim — Thu, 26 Feb 2009 06:29:40 +0000

I will be updating this as I go… but see also the Wikipedia page on string functions in various languages.

Joining a string list

-- Python:  ",".join(lst)
-- either...
import Data.List
intercalate "," lst
-- or...
import Data.List
concat (intersperse "," lst)

Splitting on a string

-- a.split(ss)
-- You might need to get Data.List.Split from Cabal
import Data.List.Split
splitOn ss a 
-- using regexes
import Text.Regex
splitRegex (mkRegex ss) a

Does the string start with the prefix?

-- Python: a.startswith(b)
import Data.List
isPrefixOf b a
-- ByteString
import Data.ByteString
isPrefixOf b a

Does the string end with the suffix?

-- Python: a.endswith(b)
import Data.List
isSuffixOf b a
-- ByteString
import Data.ByteString
isSuffixOf b a

Does one string contain another?

-- Python: a.find(b) != -1
import Data.List
isInfixOf b a
-- ByteString
import Data.ByteString
isInfixOf b a 
-- ByteString
import Data.ByteString
findSubstring b a -- returns Just int or Nothing

Reverse a string

-- Python: a[::-1]
reverse a
-- ByteString
import Data.ByteString
reverse bs

Access one character

-- Python: a[pos]
a !! pos    -- slow O(n)
-- ByteString
import Data.ByteString
index a pos

Where does one string contain another?

-- Python: a.find(b)
import Data.ByteString
findSubstring a b

Replace substrings

-- Python: b = a.replace(src,dest)
import Text.Regex
b = subRegex (mkRegex src) a dest

Replace regex, calling function on substitution

-- Python: b = re.sub("[0-9]+", lambda x: str(int(x.group(0)) + 1), a)
import Text.Regex (matchRegexAll, mkRegex)
 
subRegexFn fn re s = concat $ reverse $ sub s []
    where sub s accum = case matchRegexAll re s of
                            Nothing -> s:accum
                            Just (pre, mid, post, _) -> sub post $ (fn mid):pre:accum 
 
b = subRegexFn (read . (+ 1) . show) "[0-9]+" a

Strip leading/trailing spaces

-- Python: a.strip()
import Data.Char (isSpace)
trim      :: String -> String
trim      = f . f
   where f = reverse . dropWhile isSpace

Loop through every line in stdin

-- Python:  loop through every line in stdin, applying a function
-- for line in sys.stdin:
--      print fn(line)
let main = interact (unlines . map fn . lines) 
-- or...
let main = do { a <- stdin; mapM_ print (map fn (lines a)); }

State Monads in Haskell

tim — Tue, 24 Feb 2009 21:36:25 +0000

I would like Haskell better if it didn’t do its best to make me feel stupid. Tasks that are easy in other languages, such, say, maintaining some state or generating a random number, become difficult. After banging my head on the State monad I finally arrived at a kind of understanding, which I put here so I can restore context in the future!

Presume that you’ve got a function that, given a list, returns a list of booleans corresponding to whether the value was the first occurrence in the list. In Python it would look something like this:

def is_first(lst):
    found = set()
    r = []
    for item in lst:
        r.append(item not in found)
        found.add(item)
    return r

For example:

>>> is_first([1,2,3,1,4])
[True, True, True, False, True]

The most simplistic way of converting this to Haskell would require using recursion for the looping, resulting in the following (non-tail-recursive) function:

first  lst = first' lst []
first' [] _ = []
first' (h:t) state = 
       if h `elem` found then False:(first' t state)
       else True:(first' t (h:state))

The first’ function needs to “carry around” state as it loops around. Now, say that the lookup function is more complicated than we thought, so we break it out into a separate function. We have to pass around the state to all functions that access it, resulting in:

first  lst = first' lst []
first' [] _ = []
first' (h:t) state = 
       if (isfound h state) then False:(first' t state)
       else True:(first' t (h:state))
 
isfound h state = h `elem` state

Since isfound references the state, then it needs to be passed in explicitly.

I think that my main problem with understanding the State monad was that I kept wanting to treat the state as a global variable; so, I was thinking of “s <- get" and "put s" as references to a global stored somewhere, which left me with the question of "where is the initial put that sets the state?" Instead, though, you should think of "s <- get" and "put s" as references to an implicitly passed parameter.

The State Monad allows this particular pattern to be changed so that the state doesn’t need to be explicitly passed. Rewriting:

state_first lst = evalState (state_first' lst) []
state_first' []    = return []
state_first' (h:t) = do state <- get
                        let found = h `elem` state
                        put (if found then state else (h:state))
                        rest <- state_first' t
                        return $ (not found):rest

Basically, given a Haskell function, you can convert it into the state monad by:

Removing the explicitly passed state
Changing all references to the state parameter to “param <- get"
Instead of recursively descending, use “put new-state-value”
Calling a state returns using “<-" to 'strip' the value

Now, this doesn’t seem more elegant, but note that if you have to break functionality out, the state parameter no longer needs to be explicitly passed:

state_first lst = evalState (state_first' lst) []
state_first' []    = return []
state_first' (h:t) = do state <- get
                        found <- isfound h
                        put (if found then state else (h:state))
                        rest <- state_first' t
                        return $ (not found):rest
 
isfound h = do state <- get
               return $ h `elem` state

UPDATED: following a question on #haskell (which was very friendly, especially to a complete newcomer), the following more elegant ways of solving this came up:

-- using mapAccum
first lst = snd $ mapAccumL first' [] lst
    where first' acc x = (if found then acc else x:acc, not found)
              where found = x `elem` acc
 
-- with mapM (not exactly equivalent to example)
first lst = evalState first' []
    where first' = mapM (\a -> do state <- get; put (a:state); return $ not (a `elem` state)) lst
 
-- with mapM, equivalent to example
first lst = evalState first' []
    where first' = mapM isfound lst 
          isfound a = do state <- get
                         let found = a `elem` state
                         put (if found then state else (a:state))
                         return $ not found

For more information:
Roll Your Own IRC Bot
Grok Haskell Monad Transformers
Monads For The Working Haskell Programmer
Haskell Monads: Another View