Archive for May, 2010

Programming Praxis – ID3v1 tags

May 21, 2010

When the MP3 standard was invented, it did not contain a way to store information about the song until in 1996 Eric Kemp came up with the idea of appending 128 bytes of data to the end of the file containing information like the artist and the album. This information is known as an ID3 tag. This first version, known as ID3v1, was amended in 1997 to optionally store the track number, resulting in ID3v1.1.
In 1998 ID3v2 was released, which is a far more complicated and comprehensive, though technically unrelated, standard.

Your task in today’s exercise is to write a program that can read ID3v1.1 tags. The layout of the ID3 tag can be found in the wikipedia article. When you are finished, you are welcome to read a suggested solution below, or to post your own solution or discuss the exercise in the comments below (to post code, put it between [code][/code] tags).

 
 
 

First, some imports:

import Control.Applicative.Error
import qualified Data.ByteString as B
import Data.ByteString.Char8 (unpack)
import Data.List.Split

We could just use a tuple to store the ID3 info, but that would make function signatures rather hard to read, so we’ll define a data type for it.

data ID3v1 = ID3v1 String String String (Maybe Int) String
                   (Maybe Int) String deriving Show

Since the genre information is stored in a single byte, we’ll need to convert it to the genre name. This is trivial, but the genres take up a lot of space.

genre :: Int -> String
genre c = if c > 147 then "Unknown" else wordsBy (== ',')
    "Blues,Classic Rock,Country,Dance,Disco,Funk,Grunge,Hip-Hop,\
    \Jazz,Metal,New Age,Oldies,Other,Pop,R&B,Rap,Reggae,Rock,\
    \Techno,Industrial,Alternative,Ska,Death Metal,Pranks,\
    \Soundtrack,Euro-Techno,Ambient,Trip-Hop,Vocal,Jazz+Funk,\
    \Fusion,Trance,Classical,Instrumental,Acid,House,Game,\
    \Sound Clip,Gospel,Noise,Alternative Rock,Bass,Soul,Punk,\
    \Space,Meditative,Instrumental Pop,Instrumental Rock,Ethnic,\
    \Gothic,Darkwave,Techno-Industrial,Electronic,Pop-Folk,\
    \Eurodance,Dream,Southern Rock,Comedy,Cult,Gangsta,Top 40,\
    \Christian Rap,Pop/Funk,Jungle,Native US,Cabaret,New Wave,\
    \Psychadelic,Rave,Showtunes,Trailer,Lo-Fi,Tribal,Acid Punk,\
    \Acid Jazz,Polka,Retro,Musical,Rock & Roll,Hard Rock,Folk,\
    \Folk-Rock,National Folk,Swing,Fast Fusion,Bebob,Latin,\
    \Revival,Celtic,Bluegrass,Avantgarde,Gothic Rock,\
    \Progressive Rock,Psychedelic Rock,Symphonic Rock,Slow Rock,\
    \Big Band,Chorus,Easy Listening,Acoustic,Humour,Speech,\
    \Chanson,Opera,Chamber Music,Sonata,Symphony,Booty Bass,\
    \Primus,Porn Groove,Satire,Slow Jam,Club,Tango,Samba,Folklore,\
    \Ballad,Power Ballad,Rhythmic Soul,Freestyle,Duet,Punk Rock,\
    \Drum Solo,Acapella,Euro-House,Dance Hall,Goa,Drum & Bass,\
    \Club - House,Hardcore,Terror,Indie,BritPop,Negerpunk,\
    \Polsk Punk,Beat,Christian Gangsta Rap,Heavy Metal,\
    \Black Metal,Crossover,Contemporary Christian,Christian Rock,\
    \Merengue,Salsa,Thrash Metal,Anime,JPop,Synthpop" !! c

Since each field of the ID3 tag has a fixed length, we don’t need to write a full parser. Instead, we split the last 128 bytes of an mp3 file in the correct places and assemble the tag from that. A bit of extra work is needed (handling null-terminated strings and the optional track number), but it’s nothing complicated.

id3v1 :: B.ByteString -> Maybe ID3v1
id3v1 mp3 = if hdr /= "TAG" then Nothing else Just $ ID3v1
            (nts title) (nts artist) (nts album) (maybeRead year)
            (nts comment) track (genre $ fromEnum gnr) where
    [hdr, title, artist, album, year, cmt, [zbt], [trk], [gnr]] =
        splitPlaces [3,30,30,30,4,28,1,1,1] . unpack $
        B.drop (B.length mp3 - 128) mp3
    nts = takeWhile (> '\NUL')
    (comment, track) | zbt == '\NUL' = (cmt, Just $ fromEnum trk)
                     | otherwise     = (cmt ++ [zbt, trk], Nothing)

Testing reveals that everything is working properly:

main :: IO ()
main = print . id3v1 =<< B.readFile "G:/music/metal/sabaton/40-1.mp3"

Output:

Just (ID3v1 "40 : 1" "SABATON" "The Art of War"
            (Just 2008) "" (Just 4) "Metal")

12 lines of code, 24 lines of data. Not too terrible.

Programming Praxis – Mandelbrot set

May 18, 2010

Fractals are one of the prettier applications of mathematics. A fractal is an infinitely detailed figure that contains copies of itself at higher magnification levels. Easily the most well-known fractal is the Mandelbrot set, named after its discoverer Benoît Mandelbrot, who also coined the term fractal.

The Mandelbrot set is defined as all the points c on the complex plane for which the absolute value of zn remains less than or equal to 2, where zn is defined as:

z0 = c
zn+1 = zn2 + c

While technically n should be allowed to run to infinity, this is obviously not very practical, so an arbitrary n is chosen, with higher values obviously being more accurate.

Your task in today’s exercise is to write a very simple visualizer for the Mandelbrot set; none of the fancy colors from more advanced implementations, just plain old ascii symbols. When you are finished, you are welcome to read a suggested solution below, or to post your own solution or discuss the exercise in the comments below (to post code, put it between [code][/code] tags).

 
 
 

Since the Mandelbrot set is defined on the complex plane, we’re going to be working with complex numbers.

import Data.Complex

Since we’re not exactly working at a very high level of detail, 50 iterations will be plenty.

mandelbrot :: Num a => a -> a
mandelbrot c = iterate (\z -> z^2 + c) c !! 50

Generating the Mandelbrot set is a simple matter of generating a series of points between the given limits using the given resolutions and testing them, assigning stars to the points in the set and spaces to those outside.

display :: Float -> Float -> Float -> Float -> Float -> Float -> String
display x1 x2 resx y1 y2 resy = unlines
    [[if magnitude (mandelbrot (x :+ y)) <= 2 then '*' else ' '
     | x <- [x1, x1 + resx .. x2]] | y <- [y2, y2 - resy .. y1]]

If we choose the correct boundaries we will see the familiar shape of the Mandelbrot set appear.

main :: IO ()
main = putStrLn $ display (-2.1) 0.5 0.025 (-1) 1 0.05
                                                                               **                        
                                                                           *********                     
                                                                           ********                      
                                                                           ********                      
                                                                    *   * **********   *                 
                                                               **     ********************               
                                                              ******************************* ***        
                                                              ***********************************        
                                                          ** ***********************************         
                                                            **************************************       
                                                        *********************************************    
                                                         ******************************************      
                                      **  ******       *********************************************     
                                      *************     ********************************************     
                                    *****************  *********************************************     
                                   ******************* ********************************************      
                              **** ***************************************************************       
     ******************************************************************************************          
                              **** ***************************************************************       
                                   ******************* ********************************************      
                                    *****************  *********************************************     
                                      *************     ********************************************     
                                      **  ******       *********************************************     
                                                         ******************************************      
                                                        *********************************************    
                                                            **************************************       
                                                          ** ***********************************         
                                                              ***********************************        
                                                              ******************************* ***        
                                                               **     ********************               
                                                                    *   * **********   *                 
                                                                           ********                      
                                                                           ********                      
                                                                           *********                     
                                                                               **                        

Sure, it’s rudimentary, but then again it’s only four lines.

Programming Praxis – Brainfuck interpreter

May 14, 2010

Brainfuck is an esoteric programming language. It is known for two things:
1) It is very hard to understand and write brainfuck programs (hence the name).
2) It has a very small instruction set, which means that compilers for it can be very small. In fact, this was the design goal for the language.

A brainfuck program consists of only 8 different characters, each of which is a command:

+ and – increase and decrease the value of the current data cell by one, respectively.
< and > move to the previous/next data cell.
. prints the value of the current data cell.
, accepts a byte of input and stores it in the current cell.
[ and ] handle looping: if a [ is encountered and the value of the current cell is zero, it will skip to the matching ], otherwise it will execute the loop body. Similarly, ] moves execution to the start of the loop if the value of the current data cell is non-zero, otherwise it moves on to the next command, effectively exiting the loop.

The main practical use for brainfuck lies in the fact that it is a Turing-complete language. Hence, any language in which a brainfuck interpreter can be written is necessarily Turing-complete itself. Your task in today’s exercise is to write an interpreter that can run brainfuck programs. When you are finished, you are welcome to read a suggested solution below, or to post your own solution or discuss the exercise in the comments below (to post code, put it between [code][/code] tags).

 
 
 

The first decision we need to make is what data structure we’re going to use. While a plain list would work just fine, there’s a better fit. A zipper perfectly matches our needs: it’s a list with a cursor that we can move left or right one cell at a time – just what we need for the < and > commands. We can also use it for the program itself, since [ and ] require skipping back and forth.

import Data.List.Zipper

Handling [ and ] is going to be nearly identical, since they both need to find the matching bracket, so we make a function to avoid duplication.

skip :: Eq a => (Zipper a -> Zipper a) -> a -> a -> Zipper a -> Zipper a
skip f o c = (\z -> if cursor z == o then skip f o c $ skip f o c z
               else if cursor z == c then z else skip f o c z) . f

Running a brainfuck program is a simple matter of going through it one command at a time and taking the appropriate action.

run :: String -> IO ()
run program = f (fromList program) (fromList [0]) where
    f p z = if endp p then return () else case cursor p of
        '>' -> go $ (\x -> if endp x then insert 0 x else x) $ right z
        '<' -> go $ if beginp z then push 0 z else left z
        '+' -> go $ replace (succ $ cursor z) z
        '-' -> go $ replace (pred $ cursor z) z
        '.' -> putChar (toEnum $ cursor z) >> go z
        ',' -> go . (`replace` z) . fromEnum =<< getChar
        '[' -> jump (skip right '[' ']' p) p
        ']' -> jump p (skip left ']' '[' p)
        _   -> go z
        where jump a b = f (right $ if cursor z == 0 then a else b) z
              go = f (right p)

To test our interpreter, we’ll try to run the brainfuck version of Hello World (I refer you to the Wikipedia article for a description of how it works).

main :: IO ()
main = run $ "++++++++++[>+++++++>++++++++++>+++>+<<<<-]>+\
             \+.>+.+++++++..+++.>++.<<+++++++++++++++.>.++\
             \+.------.--------.>+.>.<"

As you can see, at a mere 15 lines a brainfuck interpreter is pretty small. Also, now we know (as if we didn’t already) that Haskell is a Turing-complete language.

Programming Praxis – Conway’s game of life

May 11, 2010

With the author of Programming Praxis currently hospitalized, I’ll be posting some programming exercises in his stead until he’s recovered.

Conway’s game of life is the most well-known example of cellular automata. It consists of a 2D grid where each cell is either alive or dead. Alive cells stay alive if they have 2 or 3 alive neighbors, otherwise they die. Dead cells become alive when they have 3 alive neighbors. Other rule variations exist, but Conway’s version is the most commonly used one. These simple rules result in a lot of complexity. In fact, the game of life is equivalent to a universal Turing machine.

Theoretically, Conway’s game of life takes place on an infinite grid, but for practical reasons the size of the grid is often limited, with cells beyond the edges being assumed dead.

In today’s exercise, your task is to write an algorithm that takes a starting situation and can produce an arbitrary number of subsequent generations. When you are finished, you are welcome to read a suggested solution below, or to post your own solution or discuss the exercise in the comments below (to post code, put it between [code][/code] tags).

 
 

First, some imports.

import Data.List.Split
import qualified Data.Map as M

Cells stay/become alive if they have 3 neighbors, or 2 if they’re already alive. Anything else dies.

rule :: (Num a) => Char -> a -> Bool
rule c n = c == 'x' && n == 2 || n == 3

Since the algorithm needs to check a cell’s neighbors, we need to know what they are.

neighbours :: (Int, Int) -> [(Int, Int)]
neighbours (y,x) = [(y', x') | y' <- [y-1..y+1], x' <- [x-1..x+1],
                               (y', x') /= (y, x)]

We will need a way to load the starting situation.

load :: String -> M.Map (Int, Int) Char
load = M.fromList . concat . zipWith (\y -> zipWith (\x c ->
           ((y, x), c)) [1..]) [1..] . lines

To obtain the next generation, we just apply the rule to every cell.

next :: M.Map (Int, Int) Char -> M.Map (Int, Int) Char
next b = M.mapWithKey (\k a -> if rule a . length .
             filter (\p -> M.findWithDefault '.' p b == 'x') $
             neighbours k then 'x' else '.') b

Next, we need a function to show a generation in a more readable format.

display :: M.Map (Int, Int) Char -> String
display b = unlines . chunk (snd . fst $ M.findMax b) $ M.elems b

And, finally, something to show multiple subsequent generations.

run :: Int -> M.Map (Int, Int) Char -> IO ()
run n = mapM_ (putStrLn . display) . take n . iterate next

Let’s test to see if everything’s working correctly.

main :: IO ()
main = run 10 $ load ".........\n\
                     \.xx......\n\
                     \.xx..xxx.\n\
                     \.....x...\n\
                     \......x..\n\
                     \..x......\n\
                     \..x......\n\
                     \..x......"

If you implemented everything correctly, the last generation should look like this:

.....xx..
....x..x.
.....xx..
.........
..xx.....
.x..x....
.x.x.....
..x......

Programming Praxis – Integer Logarithms

May 7, 2010

In today’s Programming Praxis exercise we have to write an algorithm to find the integer logarithm of a number, i.e. the largest power the base can be raised to that does not exceed the number. Let’s get started.

First, the O(n) solution, which works the same as the Scheme version.

ilog :: Integral a => a -> a -> Integer
ilog b n = if n == 0 then -1 else ilog b (div n b) + 1

For the O(log n) version, we use the until function to determine the bounds rather than using explicit recursion. Other than that, there’s not much to be had in the way of improvements.

ilognew :: (Ord a, Num a) => a -> a -> Integer
ilognew b n = f (div ubound 2) ubound where
    ubound = until (\e -> b ^ e >= n) (* 2) 1
    f lo hi | mid == lo   = if b ^ hi == n then hi else lo
            | b ^ mid < n = f mid hi
            | b ^ mid > n = f lo mid
            | otherwise   = mid
            where mid = div (lo + hi) 2

Like the Scheme solution, we check the equivalence of the two methods by testing a few different bases and the numbers 1 to a million.

main :: IO ()
main = print $ and [ilognew b n == ilog b n
                   | b <- [2,3,5,7], n <- [1..1000000]]

Only a 30% reduction in lines this time compared to the Scheme solution, since most of the code is checking conditions. Oh well, it’ll do.

Programming Praxis – Spectacular Seven

May 4, 2010

In today’s Programming Praxis exercise our task is to run a simulation of a ballgame to see if the scoring mechanic is fair. The provided Scheme solution clocks in at 25 lines. Let’s see if we can do any better.

First, some imports.

import Control.Applicative
import Control.Monad
import Data.List
import System.Random

After a match, the winner gets a point and the loser is moved to the end of the queue.

match :: Int -> [(a, Int)] -> Int -> [(a, Int)]
match ps ~(x:y:r) w = (p,s + if ps > 7 then 2 else 1) : r ++ [c]
    where ((p,s), c) = if w == 0 then (x,y) else (y,x)

A game ends when one of the teams has 7 or more points.

game :: IO Int
game = f 0 (zip [1..8] [0,0..]) . randomRs (0,1) <$> newStdGen
       where f ps a ~(x:xs) = maybe (f (ps+1) (match ps a x) xs) fst $
                              find ((>= 7) . snd) a

To simulate the game, we play a number of games and calculate the winning percentages of each team.

simulate :: Int -> IO [Float]
simulate n = (\ws -> map (\x -> 100 * (l x - 1) / l ws) . group .
                     sort $ ws ++ [1..8]) <$> replicateM n game
             where l = fromIntegral . length

All that’s left is to run the simulation.

main :: IO ()
main = mapM_ print =<< simulate 10000

That leaves us with 7 lines, more than a two thirds reduction compared to the Scheme solution. That’ll do nicely.