4. Arrays

single_level = [ "this", "that", "the", "other" ]

-- there is no non-homogeneous list. You can do things with tuples:
nested = ("this", "that", ["the", "other"]) -- (String, String, [String])

-- arrays are generally eschewed in Haskell, lists are prefered.
-- arrays are useful if you desperately need:
-- * huge amounts of raw data.
-- * constant (O(1)) lookup => use Data.Array
-- * constant (O(1)) update => use Data.Array.IO, Data.Array.ST or Data.Array.Storable
--                             (or even Data.Array.Diff)
-- see http://haskell.org/haskellwiki/Cookbook#Arrays
-- and http://www.haskell.org/haskellwiki/Modern_array_libraries for more

-- creating an Array from a list:
import Data.Array
listToArray :: [a] -> Array Int a
listToArray l = listArray (0, length l - 1) l

a1 = listToArray l1
-- => array (0,3) [(0,"Crosby"),(1,"Stills"),(2,"Nash"),(3,"Young")]

-- getting back the list
l1' = elems a1


-- creating an IOArray from a list:
import Data.Array.IO
listToIOArray :: [a] -> IO (IOArray Int a)
listToIOArray l = newListArray (0, length l - 1) l

a1 = listToIOArray l1

l1' = a1 >>= getElems 

a  = [ "quick", "brown", "fox" ]
a' = words "Why are you teasing me?"

l = lines 
      "The boy stood on the burning deck\n\
      \It was as hot as glass."

big_array = do s <- readFile "mydatafile"
               return (lines s)
-- more compact:
big_array = fmap lines (readFile "mydatafile")


-- using readProcess from "Helpers"
his_host = "www.haskell.org"
host_info = do Right info <- readProcess "nslookup" [his_host] ""
               return info

-- calling ps on our running process
import System
import System.Posix (getProcessID)

t = do id <- getProcessID
       system ("ps " ++ show id)

import Data.List
commify_series :: [String] -> String
commify_series []  = ""
commify_series [x]  = x
commify_series xs  = intercalate ", " (init xs) ++ " and " ++ (last xs)

array = ["red", "yellow", "green"]
s1 = "I have " ++ commify_series array ++ " marbles" -- I have red, yellow and green marbles
s2 = "I have " ++ concat  array ++ " marbles" -- I have redyellowgreen marbles
s3 = "I have " ++ unwords array ++ " marbles" -- I have red yellow green marbles

-- arrays can't be resized
-- similar behaviour for lists explained below

what_about_that_list x = unlines
    [ "The list now has " ++ show (length x) ++ " elements."
    , "The index of the last element is " ++ show (length x - 1) ++ "."
    , "Element .3 is`" ++ x!!3 ++ "'."
    ]

l1 = [ "Crosby", "Stills", "Nash", "Young" ]

-- remove last element
l2 = init l1    -- ["Crosby", "Stills", "Nash"]

-- keep 3 elements
l3 = take 3 l1  -- ["Crosby", "Stills", "Nash"]

-- calling what_about_that_list on l2 or l3 would raise
--   *** Exception: Prelude.(!!): index too large
-- when accessing element .3

-- grow list
l4 = take 10001 (l1 ++ repeat "")
-- same, but much less haskell'ish, prefer above
l4' = l1 ++ replicate (10001 - length l1) ""

-- writing a function that grow and shrink a list is easy:
resize_list n default_val l = take n (l ++ repeat default_val)

bad_users = filter is_valid_user all_users

t = mapM_ complain bad_users

t' = mapM_ do_it all_users
    where do_it user = do usage <- get_usage user
                          when (usage > max_quota) (complain user)

-- equivalent of "env | sort"
import System.Environment
import List
t = getEnvironment >>= putStr . format
    where format = unlines . map (\(var, val) -> var ++ "=" ++ val) . sort

-- display lines from "who" matching "simonpj" (readProcess is in "Helpers")
t = do Right s <- readProcess "who" [] ""
       mapM_ putStrLn (filter ("simonpj" `isPrefixOf`) $ lines s)

-- print file with words reversed:
t = readFile "/etc/fstab" >>= putStr . reverse_words_of_each_line
    where reverse_words_of_each_line = unlines . map (unwords . reverse . words) . lines

-- modify every element
l = map (-1 +) [1,2,3]          -- [0,1,2]

-- multiply everything in a and b by seven
l = [ ("a", [ 0.5, 3 ]), ("b", [ 0, 1 ]) ]
l' = map (\(name, xs) -> (name, map (* 7) xs)) l
-- => [ ("a", [ 3.5, 21 ]), ("b", [ 0, 7 ]) ]
-- same using Arrow.second
l_' = map (Arrow.second $ map (* 7)) l
-- for a more cryptic version, replace Arrow.second with fmap

-- same using Data.Map
import qualified Data.Map as Map
m = Map.fromList [ ("a", [ 0.5, 3 ]), ("b", [ 0, 1 ]) ]
m' = Map.map (map (* 7)) m 

-- not relevant in haskell since we have always kind of references

l = nub [ 1, 1, 2, 2, 3, 3, 3, 5 ]  -- [ 1, 2, 3, 5 ]

-- generate a list of users logged in, removing duplicates (readProcess is in "Helpers")
t = do Right s <- readProcess "who" [] ""
       let users = sort $ nub $ map (head . words) $ lines s
       putStrLn ("users logged in: " ++ unwords users)

l = [ 1, 2, 4 ] \\ [ 4, 1 ]         -- [ 2 ]

-- beware of duplicates:
xs = [ 1, 1, 2, 3, 3, 4, 5 ]
ys = [ 1, 2, 4 ]
l1 = xs \\ ys                   -- [ 1, 3, 3, 5 ]
l2 = nub xs \\ ys               -- [ 3, 5 ]
l3 = filter (`notElem` ys) xs   -- [ 3, 3, 5 ]

-- for faster operations, use Data.Set:
import qualified Data.Set as Set
l = filter (`Set.notMember` Set.fromList [ 4, 1 ]) [ 1, 2, 4 ]
-- => [ 2 ]

s1 = Set.fromList [ 1, 2, 4 ]
s2 = Set.fromList [ 4, 1 ]
s3 = Set.\\ s1 s2

a = [1, 3, 5, 6, 7, 8]
b = [2, 3, 5, 7, 9]

l1 = a `intersect` b            -- [ 3, 5, 7 ]
l2 = a `union` b                -- [ 1, 3, 5, 6, 7, 8, 2, 9 ]
l3 = a \\ b                     -- [ 1, 6, 8 ]

-- see also union and intersection in Data.Set

l = [ "Time", "Flies" ]
l2 = l ++ [ "An", "Arrow" ]   -- ["Time", "Flies", "An", "Arrow"]

insertAt n e l = before ++ [e] ++ after
    where (before, after) = splitAt n l

l3 = insertAt 2 "Like" l2 -- ["Time", "Flies", "Like", "An", "Arrow"]

replaceAt n e l = before ++ [e] ++ tail after
    where (before, after) = splitAt n l

replaceAllAt assoc l = foldr (\(n, e) -> replaceAt n e) l assoc

l4 = replaceAt 0 "Fruit" l3
l5 = replaceAllAt [ (3,"A"), (4,"Banana") ] l4
-- => ["Fruit", "Flies", "Like", "A", "Banana"]

-- arrays are better suited for modifying an element,
-- but arrays are not suited for adding elements
-- (using listToArray from "Helpers")
l3' = listToArray l3
l4' = l3' Array.// [ (0, "Fruit") ]
l5' = l4' Array.// [ (3,"A"), (4,"Banana") ]

l = reverse [1..5]       -- [5,4,3,2,1]

reverse_sort   = reverse . sort
reverse_sort'  = sortBy (\a b -> b <=> a)
reverse_sort'' = sortBy (flip (<=>))

l = reverse_sort [3,2,5,1]      -- [5,3,2,1]

-- remove n elements from front of array
(front,array') = splitAt array n

-- remove n elements from the end of array
(array',end)  = splitAt array (array.length array - n)

(this : that : friends') = [ "Peter", "Paul", "Mary", "Jim", "Tim" ]
-- this contains "Peter", that has "Paul", and friends' has "Mary", "Jim", and "Tim"

beverages = words "Dew Jolt Cola Sprite Fresca"
(beverages', pair) = splitAt (length beverages - 2) beverages 
-- pair contains ["Sprite", "Fresca"]
-- and beverages' has ["Dew", "Jolt", "Cola"]

data Employee = Employee { name, position :: String
                         , salary :: Int } deriving (Show,Eq)

employees = [ Employee { name="Jim",  position="Manager",  salary=26000 }
            , Employee { name="Jill", position="Engineer", salary=24000 }
            , Employee { name="Jack", position="Engineer", salary=22000 } ]

(Just engineer) = find ((== "Engineer") . position) employees

s = name engineer ++ " is engineer"

bigs = filter (> 1000000) nums

-- display lines from "who" matching "simonpj" (readProcess is in "Helpers")
t = do Right s <- readProcess "who" [] ""
       mapM_ putStrLn (filter ("simonpj" `isPrefixOf`) $ lines s)

-- using employees defined in previous section
engineers  = [ x | x <- employees, position x == "Engineer"]
engineers' = filter ((== "Engineer") . position) employees
-- => [ Employee { name="Jill", ... }, Employee { name="Jack", ... } ]

secondary_assistance = filter ((\x -> x >= 26000 && x < 30000) . salary) employees
-- => [ Employee { name="Jim", position="Manager", salary=26000 } ]

-- sort works for numbers
l1 = sort [100, 3, 20]          -- [3, 20, 100]
-- strings representing numbers will be sorted alphabetically
l2 = sort ["100", "3", "20"]    -- ["100", "20", "3"]

-- you may specify another sort method (not lexicographic ordering):
-- for comparing: import Data.Ord (comparing)
l3 = sortBy (comparing (read :: String -> Int)) ["100", "3", "20"] -- ["3", "20", "100"]
-- same, but may typically run faster
sortByKey f = map snd . sortBy (comparing fst) . map (\x -> (f x, x))
l3' = sortByKey (read :: String -> Int) ["100", "3", "20"]

-- more cryptic: replace (\x -> (f x, x)) with (f Arrow.&&& id)

data Employee = Employee { name, position :: String
                         , salary :: Int } deriving (Show,Eq)

employees = [ Employee { name="Jim",  position="Manager",  salary=26000 }
            , Employee { name="Jill", position="Engineer", salary=24000 }
            , Employee { name="Jack", position="Engineer", salary=22000 } ]

employee_sorted = sortBy (comparing name) employees
-- => [ Employee { name="Jack", ... }, Employee { name="Jill", ... }, Employee { name="Jim", ... } ]

sortByKey f = map snd . sortBy (comparing fst) . map (\x -> (f x, x))
sortByKeyRev f = map snd . sortBy (flip $ comparing fst) . map (\x -> (f x, x))

employee_sorted' = sortByKey name employees

ordered     = sortByKey    abs [ 1, -3, 2, 6 ] -- [ 1, 2, -3, 6 ]
ordered_rev = sortByKeyRev abs [ 1, -3, 2, 6 ] -- [ 6, -3, 2, 1 ]

names = [ "Azzz", "Za", "Bbbbbbb" ]
sort_by_2nd_char  = sortByKey (!! 1) names -- ["Za","Bbbbbbb","Azzz"]
sort_by_last_char = sortByKey last names   -- ["Za","Bbbbbbb","Azzz"]
sort_by_length    = sortByKey length names -- ["Za","Azzz","Bbbbbbb"]

--
import Text.Regex
m = readFile "/etc/passwd" >>= (putStr . unlines . sortByKey key . lines)
    where key line = case splitRegex (mkRegex ":") line of
                       (name : _ : uid : gid : _) ->
                           (read gid :: Int, read uid :: Int, name) 

import System.Posix (sleep)

-- circular lists are easily defined using infinite list
circular = [1,2,3,4,5] ++ circular

m = mapM_ do_it (take 10 circular)
    where do_it n = do putStrLn ("Handling process " ++ show n)
                       sleep 1

rand :: Int -> Int -> IO Int
rand low high = getStdRandom (randomR (low, high))

randomPermute :: [a] -> IO [a]
randomPermute []  = return []
randomPermute xs  = 
    do n <- rand 0 (length xs - 1)
       let (a, e : b) = splitAt n xs -- taking n-th element and putting it first
       ab <- randomPermute (a ++ b)
       return $ e : ab

l = randomPermute [1..5]        -- example of result: [2,3,5,1,4]

-- using groupNelem from "Helpers"
make_columns :: Int -> [String] -> [String]
make_columns screen_width mylist = 
    map concat $ transpose $ groupNelem rows $ map pad_it mylist
        where maxlen = maximum(map length mylist) + 1 -- 1 needed to make extra space
              cols = max 1 (screen_width `div` maxlen)
              rows = 1 + (length mylist `div` cols)
              pad_it s = take maxlen (s ++ repeat ' ')

-- using external program "resize -u" to get terminal size (readProcess is in "Helpers")
getTerminalSize :: IO (Maybe (Int, Int))
getTerminalSize =
    do Right s <- readProcess "resize" ["-u"] ""
       let vars = parse_shell_vars s
       return $ do x <- lookup "COLUMNS" vars
                   y <- lookup "LINES" vars
                   return (read x, read y)
    where parse_shell_vars = catMaybes . map break_it . lines
          break_it s = case break (== '=') s of
                         (_, "") -> Nothing
                         (var, _:val) -> Just (var, if last val == ';' then init val else val)

main = do size <- getTerminalSize
          let width = maybe 80 fst size
          interact (unlines . make_columns width . words)

permutations []     =  [[]]
permutations (x:xs) = [zs | ys <- permutations xs, zs <- interleave x ys ]
  where interleave x []     =  [[x]]
        interleave x (y:ys) =  [x:y:ys] ++ map (y:) (interleave x ys)
-- the list comprehension can be replaced by: concatMap (interleave x) $ permutations xs

t = mapM_ (putStrLn . unwords) $ permutations $ words "man bites dog" 
-- man bites dog
-- bites man dog
-- bites dog man
-- man dog bites
-- dog man bites
-- dog bites man