I am trying to write a simple higher order function in Haskell which takes two arguments:
A list of functions of any type.
A list of (Numbers or Strings or Boolean, etc) --> any type
The function should apply all the functions in the first list to all the elements in the the second list, store the values in a list, and return the list. An example of the program is:
Main> apply [(^2),(^3),(^4)] [2..8]
--result: --[4,8,9,16,25,27,32,36,49,64,81,125,128,216,256,343,512,625,1296,2401,4096]
The type of the function must be:
apply :: Ord u => [v->u]->[v]->[u]
To do that I've used two helper functions and used recursion. My program is this:
apply :: Ord u => [v->u]->[v]->[u]
apply p s = myApply p s [] --line 59--
myApply :: Ord u => [v->u]->[u]->[u]->[u]
myApply f_list num_list starterlist
| null f_list = starterlist
| otherwise = myApply (tail f_list) (num_list) ( applyList (head f_list) num_list starterlist )
applyList :: Ord u => (v->u)->[u]->[u]->[u]
applyList f num_list starterlist
| null num_list = starterlist
| otherwise = applyList f (tail num_list) ( (head num_list) : starterlist )
I get the error:
ERROR "Lab2.hs":59 - Inferred type is not general enough
*** Expression : applyList
*** Expected type : Ord a => (b -> a) -> [a] -> [b] -> [a]
*** Inferred type : Ord a => (a -> a) -> [a] -> [a] -> [a]
Any idea what is wrong the with types?
The reason why you get this error is because there are conflicting type signatures:
apply :: Ord u => [v->u]->[v]->[u]
apply p s = myApply p s [] --line 59--
myApply :: Ord u => [v->u]->[u]->[u]->[u]
myApply f_list num_list starterlist
| null f_list = starterlist
| otherwise = myApply (tail f_list) (num_list) ( applyList (head f_list) num_list starterlist )
As you can see, the apply function immediately calls the myApply function. Since myApply has signature [v -> u] -> [u] -> [u] -> [u], it means that apply can only have signature [v->u] -> [u] -> [u].
A quick fix is to generalize both myApply and myApplyList to [v -> u] -> [v] -> [u] -> [u]. Now the compile will also detect an error you've made in your applyList function: you forgot to call f on the head num_list. So you can fix it and obtain the following code:
apply :: Ord u => [v->u]->[v]->[u]
apply p s = myApply p s [] --line 59--
myApply :: Ord u => [v->u]->[v]->[u]->[u]
myApply f_list num_list starterlist
| null f_list = starterlist
| otherwise = myApply (tail f_list) (num_list) ( applyList (head f_list) num_list starterlist )
applyList :: Ord u => (v->u)->[v]->[u]->[u]
applyList f num_list starterlist
| null num_list = starterlist
| otherwise = applyList f (tail num_list) ( (f (head num_list)) : starterlist )
Nevertheless, this code is quite unelegant and uses way to many functions and arguments. You can replace it entirely with a single list comprehension:
apply :: [v -> u] -> [v] -> [u]
apply fs xs = [f x | f <- fs, x <- xs]
Based on your comment you also have to sort the values later in the process, you can do this by using the sort :: Ord a => [a] -> [a] builtin:
-- sorting variant
apply :: Ord u => [v -> u] -> [v] -> [u]
apply fs xs = sort [f x | f <- fs, x <- xs]
This generates the required result:
Prelude Data.List> (\fs xs -> sort [f x | f <- fs, x <- xs]) [(^2),(^3),(^4)] [2..8]
[4,8,9,16,16,25,27,36,49,64,64,81,125,216,256,343,512,625,1296,2401,4096]
Variation on a theme: taking into Willem's comment indicating that this is a pretty convoluted code (making it difficult to analyze) I'd start with a simpler code, without stating any types at all, to first get a simple working case (that is, a function that produces the expected output), still using a helper function, and recursion:
apply fs [] = []
apply [] xs = []
apply (f:fs) xs = (helper f xs) ++ (apply fs xs)
helper f [] = []
helper f (x:xs) = f x : helper f xs
Then I would ask the Haskell compiler to give me information about what type signature it inferred:
*Main> :t apply
apply :: [t1 -> t] -> [t1] -> [t]
By realizing that t1 -> t maps to your v->u, I can see that the type signature can also be written as:
[v -> u] -> [v] -> [u]
Doing the similar for helper, you will end up with the following:
apply :: [v->u] -> [v] -> [u]
apply fs [] = []
apply [] xs = []
apply (f:fs) xs = (helper f xs) ++ (apply fs xs)
helper :: (v -> u) -> [v] -> [u]
helper f [] = []
helper f (x:xs) = f x : helper f xs
From here, you can work your way by adding Ord constraint, and build up sorting functionality, etc.
I have created a film database and functions related to the database.
I am now creating a demo function where it gives results of particular functions carried out when the number is pressed in ghci. For example, when demo 2 is typed, it shows all the films in the database.
I have managed to create most the demo functions however, i am having problem with 3 of them and keep being displayed with errors. I have commented out the ones which do not work and need help understanding what the problem is.
I have included all the functions i have created with the demo function below.
import Data.List
import Text.Printf
import Data.Ord
import Data.Char
type Rating = (String, Int)
type Title = String
type Director = String
type Year = Int
type Film = (Title, Director, Year,[Rating])
testDatabase :: [Film]
testDatabase = [("Blade Runner","Ridley Scott",1982,[("Amy",6), ("Bill",9), ("Ian",7), ("Kevin",9), ("Emma",4), ("Sam",5), ("Megan",4)]),
("The Fly","David Cronenberg",1986,[("Megan",4), ("Fred",7), ("Chris",5), ("Ian",0), ("Amy",5)]),
("Psycho","Alfred Hitchcock",1960,[("Bill",4), ("Jo",4), ("Garry",8), ("Kevin",7), ("Olga",8), ("Liz",10), ("Ian",9)]),
("Body Of Lies","Ridley Scott",2008,[("Sam",3), ("Neal",7), ("Kevin",2), ("Chris",5), ("Olga",6)]),
("Avatar","James Cameron",2009,[("Olga",2), ("Wally",8), ("Megan",9), ("Tim",5), ("Zoe",8), ("Emma",3)]),
("Titanic","James Cameron",1997,[("Zoe",7), ("Amy",2), ("Emma",5), ("Heidi",3), ("Jo",8), ("Megan",5), ("Olga",7), ("Tim",10)]),
("The Departed","Martin Scorsese",2006,[("Heidi",2), ("Jo",8), ("Megan",5), ("Tim",2), ("Fred",5)]),
("Aliens","Ridley Scott",1986,[("Fred",8), ("Dave",6), ("Amy",10), ("Bill",7), ("Wally",2), ("Zoe",5)]),
("Prometheus","Ridley Scott",2012,[("Garry",3), ("Chris",4), ("Emma",5), ("Bill",1), ("Dave",3)]),
("E.T. The Extra-Terrestrial","Steven Spielberg",1982,[("Ian",7), ("Amy",2), ("Emma",7), ("Sam",8), ("Wally",5), ("Zoe",6)]),
("The Birds","Alfred Hitchcock",1963,[("Garry",7), ("Kevin",9), ("Olga",4), ("Tim",7), ("Wally",3)]),
("Goodfellas","Martin Scorsese",1990,[("Emma",7), ("Sam",9), ("Wally",5), ("Dave",3)]),
("The Shawshank Redemption","Frank Darabont",1994,[("Jo",8), ("Sam",10), ("Zoe",3), ("Dave",7), ("Emma",3), ("Garry",10), ("Kevin",7)]),
("Gladiator","Ridley Scott",2000,[("Garry",7), ("Ian",4), ("Neal",6), ("Wally",3), ("Emma",4)]),
("The Green Mile","Frank Darabont",1999,[("Sam",3), ("Zoe",4), ("Dave",8), ("Wally",5), ("Jo",5)]),
("True Lies","James Cameron",1994,[("Dave",3), ("Kevin",4), ("Jo",0)]),
("Minority Report","Steven Spielberg",2002,[("Dave",5), ("Garry",6), ("Megan",2), ("Sam",7), ("Wally",8)]),
("The Wolf of Wall Street","Martin Scorsese",2013,[("Dave",6), ("Garry",6), ("Megan",0), ("Sam",4)]),
("War Horse","Steven Spielberg",2011,[("Dave",6), ("Garry",6), ("Megan",3), ("Sam",7), ("Wally",8), ("Zoe",8)]),
("Lincoln","Steven Spielberg",2012,[("Ian",3), ("Sam",7), ("Wally",3), ("Zoe",4), ("Liz",7), ("Megan",4)]),
("Vertigo","Alfred Hitchcock",1958,[("Bill",7), ("Emma",5), ("Zoe",9), ("Olga",6), ("Tim",10)]),
("The Terminal","Steven Spielberg",2004,[("Olga",3), ("Heidi",8), ("Bill",2), ("Sam",6), ("Garry",8)]),
("Jaws","Steven Spielberg",1975,[("Fred",3), ("Garry",0), ("Jo",3), ("Neal",9), ("Emma",7)]),
("Hugo","Martin Scorsese",2011,[("Sam",4), ("Wally",3), ("Zoe",4), ("Liz",7)])]
------------------------------------------------------------
-----------------FUNCTIONAL CODE----------------------------
------------------------------------------------------------
--when adding need to be addFilm string string int and the list name called testDatabase
addFilm :: String -> String -> Int -> [Film] -> [Film]
addFilm title director year database = (title, director, year, []) : database
--Some functions needed later on:
averageFilmRating :: [(String,Int)] -> Float
averageFilmRating ratings
= (fromIntegral(sum $ map snd ratings)) / (fromIntegral(length ratings))
--Formats the films for decimal, gives average rating of films instead of all users ratings.
formatFilmOutput :: Film -> String
formatFilmOutput (title, director, year, rating)
= printf "%s by %s. Year: %d, Average Rating: %.1f" (title) (director) (year) (averageFilmRating rating)
--Shows all films in the database
displayAllFilm :: [String]
displayAllFilm = map formatFilmOutput testDatabase
--Shows films by director name
displayByDirector :: String -> [Film]
displayByDirector name
= filter(\(_,director,_,_) -> director == name) testDatabase
--Gives the average of directors films
directorAverage :: String -> Float
directorAverage dir
= averageFilmRating [rating | (title, director, year, ratings) <- displayByDirector dir, rating <- ratings]
--These two functions give the films rated of average 6 or over
filmsRated :: Int -> [Film]
filmsRated rating
= filter(\(_,_,_,a) -> averageFilmRating a >= fromIntegral rating) testDatabase
filmsaveragesix = filmsRated 6
--Shows what films the user has rated.
userRatedFilms :: String -> [Film]
userRatedFilms username
= filter ((username `elem`) . (\(_,_,_,xs) -> map fst xs)) testDatabase
-- Allows user to rate or re-rate film.
databaseNoFilm:: [Film] -> Title -> [Film]
databaseNoFilm database t = [(title, director, year, ratings) | (title, director, year, ratings) <- database, title /= t]
rateFilm :: [Film] -> Title -> Rating -> [Film]
rateFilm database findtitle (u, r) = databaseNoFilm database findtitle ++ [(title,director,year,(u, r):[(username,rtg) | (username,rtg) <- ratings, username /= u]) | (title, director, year, ratings) <- database, title == findtitle]
--Displays films by year in descending order of rating
filmsByYear :: Int -> [Film]
filmsByYear year = sortFilms $ filter(\(_,_,yr,_) -> yr >= year) testDatabase
sortFilms :: [Film] -> [Film]
sortFilms = sortBy $ flip $ comparing averageFilmRating'
where
averageFilmRating' (_,_,_,rs) = averageFilmRating rs
------------------------------------------------------------
-----------------DEMO FUNCTION------------------------------
------------------------------------------------------------
demo :: Int -> IO ()
demo choice = do
case choice of
-- 1 -> do
-- putStrLn addFilm "Gravity" "Alfonso Cuaron" 2013 testDatabase
2 -> do
putStrLn (unlines displayAllFilm)
3 -> do
putStrLn (unlines (map formatFilmOutput(displayByDirector "James Cameron")))
4 -> do
putStrLn (unlines (map formatFilmOutput(filmsaveragesix)))
-- Get the director average of James Cameron
-- 5 -> do
-- putStrLn (directorAverage "James Cameron")
6 -> do
putStrLn (unlines (map formatFilmOutput(userRatedFilms "Zoe")))
-- all films after Zoe rates "Jaws" 8
-- 7 -> do
-- putStrLn rateFilm testDatabase "Jaws" ("Zoe", 8)
-- 77 all films after Zoe rates "Vertigo" 3
8 -> do
putStrLn (unlines (map formatFilmOutput(filmsByYear 2009)))
The problem here relates to the demo functions which have been commented out. When uncommented and run the error for demo 1 relates to:
Couldn't match type `String -> String -> Int -> [Film] -> [Film]'
with `[Char]'
Expected type: String
Actual type: String -> String -> Int -> [Film] -> [Film]
In the first argument of `putStrLn', namely `addFilm'
In a stmt of a 'do' block:
putStrLn addFilm "Gravity" "Alfonso Cuaron" 2013 testDatabase
In the expression:
do { putStrLn
addFilm "Gravity" "Alfonso Cuaron" 2013 testDatabase }
It is a similar error for the rest of the commented demo functions
The problem you were having has to do with the line
putStrLn addFilm "Gravity" "Alfonso Cuaron" 2013 testDatabase
To the compiler, this looks like you're trying to apply 5 arguments to putStrLn, which is a function that only takes 1 argument, hence the compiler error. If you were to do
putStrLn (addFilm "Gravity" "Alfonso Cuaron" 2013 testDatabase)
Or equivalently (and prettier)
putStrLn $ addFilm "Gravity" "Alfonso Cuaron" 2013 testDatabase
Then you're applying the 4 arguments to addFilm, then applying that result to putStrLn. This still won't compile because addFilm returns a list of Films, not a String which is what putStrLn expects. You can instead use print, which is defined as
print :: Show a => a -> IO ()
print x = putStrLn $ show x
Or you could use your formatFilmOutput function:
putStrLn $ unlines $ map formatFilmOutput $ addFilm "Gravity" ...
and unlines converts the list of strings into a single string joined by new lines.
In case you're wondering what the $ operator is, it's literally defined as
($) :: (a -> b) -> a -> b
($) = id
infixr 0 $
The important part of the definition is the infixr 0 $ line. This means that it's right associative with a fixity of 0, which is the lowest precedence. Function application has a precedence of 9, meaning it always takes priority over operators, so
add1 x * 2
Is always the same as
(add1 x) * 2
The $ operator just acts as an alternative to parentheses. You can use it as
f $ g $ h $ i $ j $ k $ l $ m x
-- f through m are functions of one argument
Which means apply x to m, then apply that to l, then to k, then to j, and so on, or you could write it as
f (g (h (i (j (k (l (m x)))))))
Which isn't fun to balance parentheses for. This only works for applying the last argument to a function, not any of the middle ones. So
add = (+)
add $ 1 + 2 $ 3 + 4
won't work, that parses as
add (1 + 2 (3 + 4))
add (3 (7))
add (3 7)
Which just doesn't make sense.
I'm trying to map JSON data to columns. Everything I need is contained in data array. Example:
{"data":
[
{"stamp":1348249585,"date":"2012-09-21 17:46","blur":"blurs/1.jpg","img":["imgs/1.jpg",[1600,1200]],"thumb":["thumbs/1.jpg",[150,113]]},
{"stamp":1375607177,"date":"2013-08-04 09:06","blur":"blurs/2.jpg","img":["imgs/2.jpg",[1600,1200]],"thumb":["thumbs/2.jpg",[150,113]]},
{"stamp":1376242046,"date":"2013-08-11 17:27","blur":"blurs/3.jpg","img":["imgs/3.jpg",[1600,1200]],"thumb":["thumbs/3.jpg",[150,113]]},
...
Currently, I am using #>> operator with dynamically generated condition:
1) Calculate number of elements in data array
2) Create varchar array condition to match every "row"
3) Process elements on individual rows.
My solution is:
select
json_row,
json_row#>>'{stamp}' as stamp,
json_row#>>'{date}' as date,
json_row#>>'{img,0}' as img,
json_row#>>'{img,1,0}' as img_width,
json_row#>>'{img,1,1}' as img_height,
json_row#>>'{thumb,0}' as thumb,
json_row#>>'{thumb,1,0}' as thumb_width,
json_row#>>'{thumb,1,1}' as thumb_height,
json_row#>>'{thumb,2,0}' as th_x1,
json_row#>>'{thumb,2,1}' as th_y1,
json_row#>>'{thumb,3,0}' as th_x2,
json_row#>>'{thumb,3,1}' as th_y2,
json_row#>>'{blur}'
from
(
select
(gjson#>>c.cond)::json json_row
from
gallery_json
cross join (
select ('{data,'|| generate_series(0,
(select json_array_length((gjson#>>'{data}')::json) from gallery_json) - 1) || '}')::varchar[] cond) c
) rd
This works and I can live with it. But, given that this is my first exercise with JSON in PostgreSQL I would like to ask if there is better way to map similar JSON structure to rows. I think that I am supposed to use json_populate_recordset, but did not succeed so far.
SQLFiddle does not work currently, sample data:
--drop table if exists gallery_json;
create table gallery_json(gjson json);
insert into gallery_json (gjson)
select '{"data":[
{"stamp":1348249585,"date":"2012-09-21 17:46","blur":"blurs/1.jpg","img":["imgs/1.jpg",[1600,1200]],"thumb":["thumbs/1.jpg",[150,113]]},
{"stamp":1376659268,"date":"2013-08-16 13:21","blur":"blurs/7.jpg","img":["imgs/7.jpg",[1600,539]],"thumb":["thumbs/7.jpg",[267,112],[332,112],[32,0]]},
{"stamp":1376666907,"date":"2013-08-16 15:28","blur":"blurs/8.jpg","img":["imgs/8.jpg",[1600,1200]],"thumb":["thumbs/8.jpg",[150,113]]},
{"stamp":1379016669,"date":"2013-09-12 20:11","blur":"blurs/11.jpg","img":["imgs/11.jpg",[1600,590]],"thumb":["thumbs/11.jpg",[267,112],[304,112],[18,0]]},
{"stamp":1383304027,"date":"2013-11-01 11:07","blur":"blurs/17.jpg","img":["imgs/17.jpg",[1600,1200]],"thumb":["thumbs/17.jpg",[150,113]]}]
,"blur":[600,336],"thumb":{"min":[150,112],"max":[267,200]}}'::json
SQL Fiddle
with data as (
select json_array_elements(gjson -> 'data') as data
from gallery_json
)
select
(data -> 'stamp')::text::bigint as stamp,
(data -> 'date')::text::timestamp as date,
(data -> 'blur')::text as blur,
(data -> 'img' -> 0)::text as img,
(data -> 'img' -> 1 -> 0)::text::int as img_width,
(data -> 'img' -> 1 -> 1)::text::int as img_height,
(data -> 'thumb' -> 0)::text as thumb,
(data -> 'thumb' -> 1 -> 0)::text::int as thumb_width,
(data -> 'thumb' -> 1 -> 1)::text::int as thumb_height,
(data -> 'thumb' -> 2 -> 0)::text::int as th_x1,
(data -> 'thumb' -> 2 -> 1)::text::int as th_y1,
(data -> 'thumb' -> 3 -> 0)::text::int as th_x2,
(data -> 'thumb' -> 3 -> 1)::text::int as th_y2
from data
I have a function which calls another function which can return something or Nothing depending on certain conditions. What I am wondering is, if it returns nothing how do I call it again with different arguments.
Say for example I have a function which can return times at 30 minute intervals, and the other function can only not return nothing at a certain time i.e.:
certainTimeFunction :: (Int,Int,Int) -> Maybe String
certainTimeFunction (h,m,s) =
| (11,00,00) = Just "It's eleven o'clock"
| otherwise = Nothing
timeFunction :: (Int,Int,Int) -> (Int,Int,Int)
timeFunction time = certainTimeFunction time
And time has to start with (00,00,00) which of course will return Nothing but then (00,30,00) is tried which again return Nothing until (11,00,00) which then triggers the function to return what is in the first guard, then the whole cycle should end.
As always in Haskell, the answer is to use recursion!
timeFunction :: (Int, Int, Int) -> (Int, Int, Int)
timeFunction time0 = case certainTimeFunction time0 of
Nothing -> timeFunction (perturbTime time0)
Just res -> res
Note that perturbTime and certainTimeFunction should be carefully tuned to work together as it's very easy in a circumstance like this to build an infinite loop. A cleaner way would be to "unroll" the recursion into a lazy list using iterate.
First we create an infinite list of "all perturbations"
... iterate perturbTime :: [(Int, Int, Int)]
then we map certainTimeFunction to check whether any such perturbation returns Just.
... map certainTimeFunction . iterate perturbTime :: [Maybe (Int, Int, Int)]
then we can recover the exact behavior of timeFunction by dropping all of the Nothings.
timeFunction = fromJust . head . dropWhile isNothing
. map certainTimeFunction
. iterate perturbTime
We could also create a version of timeFunction which fails if perturbTime doesn't reach a successful point within n perturbations
timeFunctionN n = safeJustHead
. dropWhile isNothing
. take n
. map certainTimeFunction
. iterate perturbTime
where safeJustHead :: [Maybe a] -> Maybe a -- note this is just `msum`
safeJustHead [] = Nothing -- it's also easy to implement
safeJustHead (x:_) = x -- using `Data.Maybe.listToMaybe`
-- per #bheklilr's comment below
If you just want to feed it times at 30 minute intervals until one succeeds, you could do
import Data.Maybe
timeFunction :: (Int, Int, Int) -> (Int, Int, Int)
timeFunction initialTime = head $ catMaybes $ map certainTimeFunction times
where
add30 (h, m, s) =
let newM = m + 30
newH = h + newM `div` 60
in (newH, newM `mod` 60, s)
times = iterate add30 initialTime
This will lazily compute all increments of 30 minutes from your initial time (my add30 is #JAbrahamson's perturbTime), then certainTimeFunction is mapped to all of those times, then catMaybes compresses this to the Just values (lazily, again), and the first one is taken. Beware, if you don't get a time that certainTimeFunction returns a successful value from, this will loop forever!
If you want to stop when the hours are greater than 23, just use our good friend takeWhile and change times to
times = takeWhile (\(h', _, _) -> h' < 24) $ iterate add30 initialTime
And change the type of timeFunction to Time -> Maybe String
And this is a great example of why you should define your own type instead of using a tuple. If you had
data Time = Time
{ hours :: Int
, minutes :: Int
, seconds :: Int
} deriving (Eq, Show)
Then some helper functions
import Data.Function (on)
asSeconds :: Int -> Time
asSeconds x = Time (x `div` 3600) (x `div` 60 `mod` 60) (x `mod` 60)
asMinutes :: Int -> Time
asMinutes = asSeconds . (* 60)
asHours :: Int -> Time
asHours x = asMinutes . (* 60)
toSeconds :: Time -> Int
toSeconds (Time h m s) = h * 3600 + m * 60 + s
(+:) :: Time -> Time
(+:) = asSeconds .: on (+) toSeconds where (.:) = (.).(.)
timeFunction :: Time -> Maybe Time
timeFunction initialTime = listToMaybe $ catMaybes $ map certainTimeFunction times
where
times = takeWhile ((< 23) . hours) $ iterate (+: asMinutes 30) initialTime
which can be written more cleanly as
timeFunction = listToMaybe . catMaybes
. map certainTimeFunction
. takeWhile ((< 24) . hours)
. iterate (+: asMinutes 30)
You could also make Time an instance of Ord really easily
instance Ord Time where
compare = on compare toSeconds
timeFunction = listToMaybe . catMaybes
. map certainTimeFunction
. takeWhile (< asHours 24)
. iterate (+: asMinutes 30)