» CS 330: Lecture 30 – Haskell IO Continued

CS 330: Lecture 30 – Haskell IO Continued

April 20, 2018 by Chris Johnson. Filed under cs330, lectures, spring 2018.

Dear students,

Last time we introduced ourselves to Haskell’s world of purity and its world of side effects. We learned that any value that gets created in the world of side effects is packaged up in an IO wrapper using the return function. We can unpackage such wrappers using the <- operator. We will finish out our discussion of Haskell IO today.

Let’s deal with command-line parameters. This, like getting the username, involves communicating with the process, which is a stateful thing. We enter the world of side effects. The getArgs function in System.Environment has this signature:

getArgs :: IO [String]

Let’s extract out the first argument and turn into an Int:

main = do
  args <- getArgs              -- unwrap from the IO
  let arg0 = head arg          -- pull out just the first
  let n = read arg0 :: Int     -- parse the int

Erm… We should do something interesting here. Let’s print out all the factors of n. How can we do this in Haskell? Through filtering!

factors n = filter (\x -> mod n x == 0) [2..n - 1]

main = do
  args <- getArgs              -- unwrap from the IO
  let arg0 = head arg          -- pull out just the first
  let n = read arg0 :: Int     -- parse the int
  putStrLn $ show $ factors n

Let’s do another example, this time with a loop. Let’s print the first command-line parameter vertically. For acrostics and crossword puzzles and stuff. We still don’t have loops, but we can use recursion. Here’s our function that “loops”:

downer :: String -> IO ()
downer [] = return ()
downer (first:rest) = do
  putStrLn [first]
  downer rest

And our main:

main = do
  args <- getArgs
  let arg0 = head args
  downer arg0

One of your homework problems requires a loop until the user gets a right answer. We can’t use pattern matching for that, so let’s rewrite this using a more flexible construct:

downer list = do
  if list == [] then
    return ()
  else
    do
      putStrLn [first]
      downer rest

I think it’s time we tackle a few problems from the outside world:

For Take Two Stones, we want to grab the number of stones from the user. We’ve done this before:

main = do
  line <- getLine
  let nstones = read line :: Int

Alice goes first, then Bob. Then Alice again, and then Bob again. And so on. Whoever picks up the last stone wins. Do we actually have to play this game out to determine the winner? No. If the number of stones is odd, Alice will pick up the last one and she’ll win. Otherwise, Bob wins.

We can solve this with an if statement:

main = do
  line <- getLine
  let nstones = read line :: Int
  if even nstones then
    putStrLn "Bob"
  else
    putStrLn "Alice"

Or with list indexing:

main = do
  line <- getLine
  let nstones = read line :: Int
  let names = ["Bob", "Alice"]
  putStrLn $ names !! mod nstones 2

Next up is Encoded Message.

Let’s first chunk an encoded string up:

import Data.List.Split

unscramble message = chunksOf n message
  where n = (floor . sqrt . fromIntegral) $ length message

Next we transpose the matrix:

import Data.List.Split

unscramble message = (transpose . chunksOf n) message
  where n = (floor . sqrt . fromIntegral) $ length message

This is looking better, but our ordering is wrong. Let’s reverse the lists and then flatten them together:

import Data.List.Split

unscramble message = (concat . reverse . transpose . chunksOf n) message
  where n = (floor . sqrt . fromIntegral) $ length message

Now, let’s write a main that reads in the number of messages and unscrambles each one:

main = do
  line <- getLine
  let ncases = read line :: Int
  solveCases ncases

We can define our helper function with pattern matching to reflect the recursive iteration:

solveCases 0 = return ()
solveCases n = do
  line <- getLine
  putStrLn $ unscramble line
  solveCase $ n - 1

Now, let’s do a comprehensive example of a full Haskell program with a real purpose: solving day 1 of Advent of Code 2016.

First up, we need a main that reads in the input file. The standard library can help immensely here:

import System.IO

main = do
  text <- readFile "day1.in"
  putStrLn text

Next let’s split up the list:

import System.IO
import Data.List.Split

main = do
  text <- readFile "day1.in"
  let commands = splitOn ", " text
  putStrLn $ show commands

Okay, we’ve got a list of commands of turning and moving. Each has this form: [RL]\d+. If the commands are L3, R1, R3, R1, that would play out as follows:

We start off at what we’ll call (0, 0), facing north.
We turn left to face west and move 3 units to (-3, 0).
We turn right to face north and move 1 units to (-3, 1).
We turn right to face east and move 3 units to (0, 1).
We turn right to face south and move 1 unit to (0, 0).

It would be silly to fully walk that route, as we just end up back where we started. We don’t have time to waste! Instead we want to simulate the steps in a program and determine where the Easter Bunny Headquarters is. Let’s practice getting a feel for the problem. Where would we end up with the following commands?

R2, L3
R1, L1, R1, L1
L10, R3, R4, L2, L4

Alright, let’s pick off small pieces of this problem at a time. Let’s model our current direction as a pair of Ints. What happens to our direction when we turn?

Current Direction	After L	After R
(0, 1)	(-1, 0)	(1, 0)
(1, 0)	(0, 1)	(0, -1)
(0, -1)	(1, 0)	(-1, 0)
(-1, 0)	(0, -1)	(0, 1)

Let’s write a function to compute our new direction based on the letter in a command. We don’t need a conditional statement for this, as the x and y components just sort of trade places, with some negation thrown in:

turn :: Char -> (Int, Int) -> (Int, Int)
turn 'L' (dx, dy) = (-dy, dx)
turn 'R' (dx, dy) = (dy, -dx)

Next we need that takes us from one location and direction to the next location and direction given a command. Let’s accept the state of our simulations as a 4-tuple:

processCommand :: (Int, Int, Int, Int) -> String -> (Int, Int, Int, Int)
processCommand (x, y, dx, dy) command = (x', y', dx', dy')
  where ...

Okay, so what’s our new state? Let’s start by extracting out the letter and number from the command:

processCommand (x, y, dx, dy) command = (x', y', dx', dy')
  where
    letter = head command
    number = read (tail command) :: Int

We can use turn to get our new direction:

processCommand (x, y, dx, dy) command = (x', y', dx', dy')
  where
    letter = head command
    number = read (tail command) :: Int
    (dx', dy') = turn letter (dx, dy)

Finally, then, we can use our computed direction to jump to the next location:

processCommand :: (Int, Int, Int, Int) -> String -> (Int, Int, Int, Int)
processCommand (x, y, dx, dy) command = (x', y', dx', dy')
  where
    letter = head command
    number = read (tail command) :: Int
    (dx', dy') = turn letter (dx, dy)
    (x', y') = (x + number * dx', y + number * dy')

We can test this!

processCommand (0, 0, 0, 1) "R10" -- should put us at (10, 0, 1, 0), right?

Now, time to process the whole sequence. That’s just a recursive solution, right?

processCommands :: (Int, Int, Int, Int) -> [String] -> (Int, Int, Int, Int)
processCommands state [] = state
processCommands state (first:rest) = processCommands (processCommand state first) rest

Hey, wait. What are we doing here? We’re reducing a list down to a single summary value. Scrap that last definition. This is a job for fold!

processCommands start = foldl' processCommand start

Finally, we can complete our main!

main = do
  text <- readFile "day1.in"
  let commands = splitOn ", " text
  let stop = processCommands (0, 0, 0, 1) commands
  putStrLn $ show stop

The problem actually wants us to compute how many blocks away is the headquarters:

main = do
  text <- readFile "day1.in"
  let commands = splitOn ", " text
  let (x, y, _, _) = processCommands (0, 0, 0, 1) commands
  putStrLn $ show $ abs x + abs y

See you next time, when we discuss laziness and tail recursion!

Sincerely,

P.S. It’s time for a haiku!

main‘s a misnomer
There’s just one way code starts up
With a real bigbang

P.P.S. Here’s the code we wrote together:

factors.hs

import System.Environment

factors n = filter (\x -> n `mod` x == 0) [1..n]

main = do
  args <- getArgs
  let nString = head args
  let n = read nString :: Int
  putStrLn $ show $ factors n
  return ()

take_two_stones.hs

main = do
  line <- getLine
  let n = read line :: Int
  let names = ["Bob", "Alice"]
  putStrLn $ names !! mod n 2
  -- if even n then
    -- putStrLn "Bob"
  -- else
    -- putStrLn "Alice"

detailed_differences.hs

diffStr a b = map (\(l, r) -> if l == r then '.' else '*') $ zip a b

solve :: Int -> IO ()
solve 0 = return ()
solve n = do
  a <- getLine
  b <- getLine
  putStrLn a
  putStrLn b
  putStrLn $ diffStr a b
  putStrLn ""
  solve $ n - 1

main = do
  line <- getLine
  let ncases = read line :: Int
  solve ncases

encoded_message.hs

import Data.List
import Data.List.Split

unscramble message = (concat . reverse . transpose . chunksOf n) message
  where n = (floor . sqrt . fromIntegral) $ length message