A table is a list of lists, where the data is set up as follows:
data Position = CEO | Manager| Programmer | Intern deriving (Eq, Show)
data Field = EmployeeID Int | T Position | Name String | Salary Int deriving (Eq)
instance Show Field where
show (EmployeeID k) = show k
show (T p) = show p
show (Name s) = s
show (Salary k) = show k
type Column = Int
type Row = [Field]
type Table = [Row]
An example table would look like this:
employees = [[EmployeeID 1, Name "Shoo"],
[EmployeeID 2, Name "Barney"],
[EmployeeID 3, Name "Brown"],
[EmployeeID 4, Name "Gold"],
[EmployeeID 5, Name "Sky"]]
How would I go about using a list comprehension to create a function that removes a column from the table? I do not know how to operate on lists of lists. I need to have the function have a type of delete :: Column -> Row -> Row
If I were to implement this without list comprehensions, I'd use map and filter.
Happily, you can easily do both of those with list comprehensions.
I'm going to avoid using your code, but as an example, suppose I had the list of lists:
nameSets = [[ "dave", "john", "steve"]
,[ "mary", "beth", "joan" ]
,[ "daren", "edward" ]
,[ "riley"]
]
And I wanted to get excited versions of all the lists with three elements:
[ [ name ++ "!" | name <- nameSet ] | nameSet <- nameSets, length nameSet == 3 ]
-- [[ "dave!", "john!", "steve!"]
-- ,[ "mary!", "beth!", "joan!" ]
-- ]
Edit: Just noticed that your column is specified by index. In that case, a zip is useful, which can also be done with list comprehensions, but a language extension is needed.
In a source file, put {-# LANGUAGE ParallelListComp #-} at the top to do zips in list comprehensions.
Here's how they work:
% ghci -XParallelListComp
ghci> [ (x,y) | x <- "abcdef" | y <- [0..5] ]
[('a',0),('b',1),('c',2),('d',3),('e',4),('f',5)]
Or, without the extension
% ghci
ghci> [ (x,y) | (x,y) <- zip "abcdef" [0..5] ]
[('a',0),('b',1),('c',2),('d',3),('e',4),('f',5)]
List comprehension does not work very well for removing by index, but here's a try (homework adjusted):
deleteAt :: Column -> Row -> Row
deleteAt n r = [e|(i,e) <- zip (a list of all indexes) r, test i] where
test i = (True if index i should be kept and False otherwise)
If you want to make a list comprehension that operates on lists of lists, you can just nest the comprehensions:
operate :: Table -> Table
operate t = [[myFunction field|field <- row, myPredicate field]| row <- t]
myFunction :: Field -> Field
myPredicate :: Field -> Bool
Hmm, this isn't an answer since you requested using list comprehensions. But I think list comprehensions are quite ill-suited to this task. You only need take and drop.
ghci> take 2 [1,2,3,4,5]
[1,2]
ghci> drop 2 [1,2,3,4,5]
[3,4,5]
To delete an element at index i, append together the first i elements and the list with the first i+1 elements dropped.
Related
I am new to Haskell and the syntax has been giving me a bit of trouble, especially in understanding how to iterate. I am creating a method what will process a string and return a list of tuples containing each letter and their number of occurences.
The tuples do reappear with duplicate letters so a list like "abba" should return [('a',2), ('b',2), ('b',2), ('a',2)]
counting_letters :: Eq a => [a] -> [(a,Int)]
counting_letters [] = []
counting_letters list
| length list == 0 = []
| otherwise = [(x,c) | x <- [head list], let c = (length.filter(==x)) list]
Right now, the only cases that work as expected are the empty list and single element lists such as "a". I understand that this only points to the head but when I attempted to use [head list .. last list] it gave me an error that it could not deduce (Enum a). How can I safely access each element in a list?
The behavior you desire is simply
counting_letters :: Eq a => [a] -> [(a,Int)]
counting_letters list = [(x,c) | x <- list, let c = (length.filter(==x)) list]
without any special cases.
I am trying to write a function that finds a pair by matching its first component and returns that pair's second component. When one tries to look up a character that does not occur in the cipher key, the function should leave it unchanged. Examples:
ghci> lookUp 'B' [('A','F'), ('B','G'), ('C','H')]
'G'
ghci> lookUp '9' [('A','F'), ('B','G'), ('C','H')]
'9'
I have a cipher key that I am not sure whether would help, but here it is:
alphabet = ['A'..'Z']
makeKey :: Int -> [(Char, Char)]
makeKey k = zip alphabet (rotate k alphabet)
That outputs something like this:
ghci> makeKey 5
[('A','F'),('B','G'),('C','H'),('D','I'),('E','J'),('F','K'),
('G','L'),('H','M'),('I','N'),('J','O'),('K','P'),('L','Q'),
('M','R'),('N','S'),('O','T'),('P','U'),('Q','V'),('R','W'),
('S','X'),('T','Y'),('U','Z'),('V','A'),('W','B'),('X','C'),
('Y','D'),('Z','E')]
This is my code so far:
lookUp :: Char -> [(Char, Char)] -> Char
lookUp a xs = [ c | (b,c) <- xs, b == a ]
When I try to run it, it produces a list and character mismatch error. How do I fix this?
With list comprehension you return a list of items. If you thus implement this as:
lookUp :: Char -> [(Char, Char)] -> [Char]
lookUp a xs = [ c | (b,c) <- xs, b == a ]
you will retrieve a list of Characters (a String) which contains the second item c of the 2-tuples, given the first item b of that 2-tuple matches with the query a.
But you do not want to retrieve a list, but only the first match, or the same item given the item is not in the list of 2-tuples.
We can implement this for example with recursion where we enumerate over the elements of the list and if we find the given item, we return the second item. If no 2-tuple can be found with as first item the item we are looking for, we return the item we are looking for:
lookUp :: Eq a => a -> [(a, a)] -> a
lookUp query = go
where go [] = … -- (1)
go ((xa, xb) : xs)
| query = xa = … -- (2)
| otherwise = … -- (3)
where you need to fill in the … parts. For the third case, you will need to recurse on the tail xs of the list.
I have a program with two data structures I wish to combine. The use of Data.Map here is incidental because I'm using it elsewhere for a related purpose. If a solution never uses Data.Map, that's fine (probably better). I've simplified the problem to the below script that has all the essential elements.
My actual program is in a different domain, but in the analogy various "interviewers" are assigned to interview all the people in given households (named by index position of the "house"). I would like to determine which interviewers will need to conduct multiple interviews.
If an interviewer is assigned multiple households, she automatically must interview multiple people (in the scenario, all households are occupied). However, if she is assigned only one household, she might also need to interview the several people there.
The initial wrong approach I found (misled by my wrong assumption about the domain) produces the result below. However, I'm having trouble formulating the correct solution. For my purpose, the order in which the interviews occur in the result is not important.
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
-- Create Map from list of pairs, making dup vals into a list
fromListWithDuplicates :: Ord k => [(k, v)] -> Map k [v]
fromListWithDuplicates pairs =
Map.fromListWith (++) [(k, [v]) | (k, v) <- pairs]
data Person = Person {
name :: String
} deriving (Show, Eq)
households = [[Person "Alice", Person "Bob"],
[Person "Carlos"],
[Person "Dabir", Person "Eashan"],
[Person "Fatima"] ]
interviewers = [("Agent1", [0]), ("Agent2", [1,2]), ("Agent3", [3])]
multiInterviewsWRONG households interviewers =
let assignments = [(agent, name person) |
(agent, houseIndices) <- interviewers,
index <- houseIndices,
person <- (households !! index),
length houseIndices > 1 ]
in Map.assocs $ fromListWithDuplicates assignments
main :: IO ()
main = do
-- Prints: [("Agent2", ["Eashan","Dabir","Carlos"])]
putStrLn $ show (multiInterviewsWRONG households interviewers)
-- Correct: [("Agent2", ["Eashan","Dabir","Carlos"]),
-- ("Agent1", ["Alice","Bob"]]
Followup: this solution is just Willem Van Onsem's below, but putting it in one place:
import Util (lengthExceeds)
multiInterviews households interviewers =
let assignments = [(agent, name person) |
(agent, houseIndices) <- interviewers,
index <- houseIndices,
person <- (households !! index) ]
in filter (flip lengthExceeds 1 . snd)
(Map.assocs $ fromListWithDuplicates assignments)
Obviously Willem's answer is great, but I think it can't hurt to also offer one without a list comprehension:
atLeastTwo :: [a] -> Bool
atLeastTwo (_:_:_) = True
atLeastTwo _ = False
transformSnd :: (b -> c) -> (a, b) -> (a, c)
transformSnd fun (f, s) = (f, fun s)
-- or transformSnd = second (from Control.Arrow; h/t Willem)
-- or transformSnd = fmap (from (,)'s Functor instance; h/t Will Ness)
-- or transformSnd = second (from Data.Bifunctor)
mult :: [(String, [String])]
mult = filter (atLeastTwo . snd) . map (transformSnd toInterviewees) $ interviewers
where toInterviewees = map name . concatMap (households !!)
-- mult == [("Agent1",["Alice","Bob"]),("Agent2",["Carlos","Dabir","Eashan"])]
I'm reasonably sure the two versions run equally fast; which one is more readable depends on who's doing the reading.
There are a couple of functional differences. First, with Willem's answer, you get a map, while with this one you get a list (but the difference is mainly cosmetic, and you said you didn't care much).
Second, the two versions behave differently if there are two pairs in the interviewers list that have the same first element. Doing it Willem's way will do what you probably want, i. e. treat them as one pair with a longer second element; doing it this way will give you two pairs in the result list which have the same first element.
Also, you probably know this, but: if you find yourself combining lists a lot, you might want sets instead.
You should remove the length houseIndices > 1 constraints, since that means that it will only retain agents, given they have to interview two or more households. You thus should use as list comprehension:
multiInterviews households interviewers =
let assignments = [
(agent, name person) |
(agent, houseIndices) <- interviewers,
index <- houseIndices,
person <- households !! index
]
# …
The given list comprehension will produce a list that looks like:
Prelude> :{
Prelude| [
Prelude| (agent, name person) |
Prelude| (agent, houseIndices) <- interviewers,
Prelude| index <- houseIndices,
Prelude| person <- households !! index
Prelude| ]
Prelude| :}
[("Agent1","Alice"),("Agent1","Bob"),("Agent2","Carlos"),("Agent2","Dabir"),("Agent2","Eashan"),("Agent3","Fatima")]
We however need to filter, we can look at the assocs with lists that contain at least two items. We can implement an efficient function to determine if the list has at least two items:
atLeastTwo :: [a] -> Bool
atLeastTwo (_:_:_) = True
atLeastTwo _ = False
and apply this filter to the assocs of the Map:
multiInterviews households interviewers =
let assignments = …
in filter (atLeastTwo . snd) (Map.assocs (fromListWithDuplicates assignments))
I have a list of strings like the following:
[ "aaa", "aaa", "aba", "aaa"]
I want to make a function that returns the first position of the list where there is an item containing the character 'b'. How can I do it in Haskell?
Here is a function that will do what you want:
getIndexWithb = findIndex ('b' `elem`)
You will need to import Data.List to make this work. Also note that this function returns type Maybe Int for the case that 'b' never appears in any of the strings.
Usage:
> getIndexWithb [ "aaa", "aaa", "aba", "aaa"]
Just 2
The List Utilities chapter of the Haskell Report describes a function findIndex which finds the index of the first element of a list that satisfies an arbitrary predicate. It can be implemented as
findIndex p xs =
case [ i | (x, i) <- zip xs [0..], p x ] of
[] -> Nothing
e:_ -> Just e
With that, you can find the first element of the list that contains 'b' with
findIndex ('b'`elem`) ["aaa", "aaa", "aba", "aaa"]
You ask for the first position so I'm not clear whether you want an index value or the actual value. Here's a function that gives you a tuple containing both the index and the value at that index.
import Data.Maybe
firstOccurrenceOf :: Char -> [String] -> Maybe (Int, String)
firstOccurrenceOf c list =
listToMaybe $ filter (elem c . snd) $ zip [0..] list
listToMaybe provides a safe alternative to head which will return Nothing instead of crashing on an empty list.
Suppose I have a list comprehension that returns a list of sequences, where the elements chosen depend on each other (see example below). Is there a way to (conveniently) program the number of elements and their associated conditions based on an earlier computation? For example, return type [[a,b,c]] or [[a,b,c,d,e]] depending on another value in the program? Also, are there other/better ways than a list comprehension to formulate the same idea?
(I thought possible, although cumbersome and limited, to write out a larger list comprehension to start with and trim it by adding to s a parameter and helper functions that could make one or more of the elements a value that could easily be filtered later, and the associated conditions True by default.)
s = [[a, b, c, d] | a <- list, someCondition a,
b <- list, b /= a, not (someCondition b),
otherCondition a b,
c <- list, c /= a, c /= b, not (someCondition c),
otherCondition b c,
d <- list, d /= a, d /= b, d /= c,
someCondition d, someCondition (last d),
otherCondition c d]
The question is incredibly difficult to understand.
Is there a way to (conveniently) program the number of elements and their associated conditions based on an earlier computation?
The problem is "program" is not really an understandable verb in this sentence, because a human programs a computer, or programs a VCR, but you can't "program a number". So I don't understand what you are trying to say here.
But I can give you code review, and maybe through code review I can understand the question you are asking.
Unsolicited code review
It sounds like you are trying to solve a maze by eliminating dead ends, maybe.
What your code actually does is:
Generate a list of cells that are not dead ends or adjacent to dead ends, called filtered
Generate a sequence of adjacent cells from step 1, sequences
Concatenate four such adjacent sequences into a route.
Major problem: this only works if a correct route is exactly eight tiles long! Try to solve this maze:
[E]-[ ]-[ ]-[ ]
|
[ ]-[ ]-[ ]-[ ]
|
[ ]-[ ]-[ ]-[ ]
|
[ ]-[ ]-[ ]-[ ]
|
[ ]-[ ]-[ ]-[E]
So, working backwards from the code review, it sounds like your question is:
How do I generate a list if I don't know how long it is beforehand?
Solutions
You can solve a maze with a search (DFS, BFS, A*).
import Control.Monad
-- | Maze cells are identified by integers
type Cell = Int
-- | A maze is a map from cells to adjacent cells
type Maze = Cell -> [Cell]
maze :: Maze
maze = ([[1], [0,2,5], [1,3], [2],
[5], [4,6,1,9], [5,7], [6,11],
[12], [5,13], [9], [7,15],
[8,16], [14,9,17], [13,15], [14,11],
[12,17], [13,16,18], [17,19], [18]] !!)
-- | Find paths from the given start to the end
solve :: Maze -> Cell -> Cell -> [[Cell]]
solve maze start = solve' [] where
solve' path end =
let path' = end : path
in if start == end
then return path'
else do neighbor <- maze end
guard (neighbor `notElem` path)
solve' path' neighbor
The function solve works by depth-first search. Rather than putting everything in a single list comprehension, it works recursively.
In order to find a path from start to end, if start /= end,
Look at all cells adjacent to the end, neighbor <- maze end,
Make sure that we're not backtracking over a cell guard (negihbor `notElem` path),
Try to find a path from start to neighbor.
Don't try to understand the whole function at once, just understand the bit about recursion.
Summary
If you want to find the route from cell 0 to cell 19, recurse: We know that cell 18 and 19 are connected (because they are directly connected), so we can instead try to solve the problem of finding a route from cell 0 to cell 18.
This is recursion.
Footnotes
The guard,
someCondition a == True
Is equivalent to,
someCondition a
And therefore also equivalent to,
(someCondition a == True) == True
Or,
(someCondition a == (True == True)) == (True == (True == True))
Or,
someCondition a == (someCondition a == someCondition a)
The first one, someCondition a, is fine.
Footnote about do notation
The do notation in the above example is equivalent to list comprehension,
do neighbor <- maze end
guard (neighbor `notElem` path)
solve' path' neighbor
The equivalent code in list comprehension syntax is,
[result | neighbor <- maze end,
neighbor `notElem` path,
result <- solve' path' neighbor]
Is there a way to (conveniently) program the number of elements and their associated conditions based on an earlier computation? For example, return type [[a,b,c]] or [[a,b,c,d,e]] depending on another value in the program?
I suppose you want to encode the length of the list (or vector) statically in the type signature. Length of the standard lists cannot be checked on type level.
One approach to do that is to use phantom types, and introduce dummy data types which will encode different sizes:
newtype Vector d = Vector { vecArray :: UArray Int Float }
-- using EmptyDataDecls extension too
data D1
data D2
data D3
Now you can create vectors of different length which will have distinct types:
vector2d :: Float -> Float -> Vector D2
vector2d x y = Vector $ listArray (1,2) [x,y]
vector3d :: Float -> Float -> Float -> Vector D3
vector3d x y z = Vector $ listArray (1,3) [x,y,z]
If the length of the output depends on the length of the input, then consider using type-level arithmetics to parametrize the output.
You can find more by googling for "Haskell statically sized vectors".
A simpler solution is to use tuples, which are fixed length. If your function can produce either a 3-tuple, or a 5-tuple, wrap them with an Either data type: `Either (a,b,c) (a,b,c,d,e).
Looks like you're trying to solve some logic puzzle by unique selection from finite domain. Consult these:
Euler 43 - is there a monad to help write this list comprehension?
Splitting list into a list of possible tuples
The way this helps us is, we carry our domain around while we're making picks from it; and the next pick is made from the narrowed domain containing what's left after the previous pick, so a chain is naturally formed. E.g.
p43 = sum [ fromDigits [v0,v1,v2,v3,v4,v5,v6,v7,v8,v9]
| (dom5,v5) <- one_of [0,5] [0..9] -- [0..9] is the
, (dom6,v6) <- pick_any dom5 -- initial domain
, (dom7,v7) <- pick_any dom6
, rem (100*d5+10*d6+d7) 11 == 0
....
-- all possibilities of picking one elt from a domain
pick_any :: [a] -> [([a], a)]
pick_any [] = []
pick_any (x:xs) = (xs,x) : [ (x:dom,y) | (dom,y) <- pick_any xs]
-- all possibilities of picking one of provided elts from a domain
-- (assume unique domains, i.e. no repetitions)
one_of :: (Eq a) => [a] -> [a] -> [([a], a)]
one_of ns xs = [ (ys,y) | let choices = pick_any xs, n <- ns,
(ys,y) <- take 1 $ filter ((==n).snd) choices ]
You can trivially check a number of elements in your answer as a part of your list comprehension:
s = [answer | a <- .... , let answer=[....] , length answer==4 ]
or just create different answers based on a condition,
s = [answer | a <- .... , let answer=if condition then [a,b,c] else [a]]
You have Data.List.subsequences
You can write your list comprehension in monadic form (see guards in Monad Comprehensions):
(Explanation: The monad must be an instance of MonadPlus which supports failure.
guard False makes the monad fail evaluating to mzero., subsequent results are appended with mplus = (++) for the List monad.)
import Control.Monad (guard)
myDomain = [1..9] -- or whatever
validCombinations :: [a] -> [[a]]
validCombinations domainList = do
combi <- List.subsequences domainList
case combi of
[a,b] -> do
guard (propertyA a && propertyB b)
return combi
[a,b,c] -> do
guard (propertyA a && propertyB b && propertyC c)
return combi
_ -> guard False
main = do
forM_ (validCombinations myDomain) print
Update again, obtaining elements recursively, saving combinations and checks
import Control.Monad
validCombinations :: Eq a => Int -> Int -> [a] -> [(a -> Bool)] -> [a] -> [[a]]
validCombinations indx size domainList propList accum = do
elt <- domainList -- try all domain elements
let prop = propList!!indx
guard $ prop elt -- some property
guard $ elt `notElem` accum -- not repeated
{-
case accum of
prevElt : _ -> guard $ some_combined_check_with_previous elt prevElt
_ -> guard True
-}
if size > 1 then do
-- append recursively subsequent positions
other <- validCombinations (indx+1) (size-1) domainList propList (elt : accum)
return $ elt : other
else
return [elt]
myDomain = [1..3] :: [Int]
myProps = repeat (>1)
main = do
forM_ (validCombinations 0 size myDomain myProps []) print
where
size = 2
result for size 2 with non trivial result:
[2,3]
[3,2]