Related
[EDIT3: a single file with almost full code:
https://github.com/agutie58/landOfLispInHaskell/blob/main/exampleLoLTextGameHaskell.hs
EDIT2: an example of the actual game.]
[Original question]
I have a function run that is based on a Domain, and a list of events:
if all events are treated, it listens for new events and
if they are events, it treats several of them.
The majority of events modifies the Domain:
data Domain = Domain (String, World) deriving (Show)
data World = World {loc :: String, descSites :: [(Key,String)], mapSites :: [(Key, [Lloc])], objects:: [Key], siteObjects::[(Key,String)]} deriving (Show)
run :: Domain -> [Event] -> IO ()
run dm [] = do
events <- uiUpdate dm
run dm events
run _ (EventExit:_) =
return ()
run dm (e:es) =
run (dmUpdate dm e) es
The part that I want to focus on is run (dmUpdate dm e) es, where dmUpdate dm e returns a Domain value:
One example of this function dmUpdate that works well is:
dmUpdate :: Domain -> Event -> Domain
dmUpdate (Domain v) (EventLook) = look (snd v)
dmUpdate (Domain v) (EventWalk direction) = walk direction (snd v)
dmUpdate dm _ _ = dm
where:
look :: World -> Domain
walk :: String -> World -> Domain
-- etc.
I want to render (print to console) the result of a new state. For example:
dmUpdate (Domain v) (EventLook) = do let newDomain = look (snd v)
putStr (fst newDomain)
newDomain
But it does not work. I try to compute a new state of the world, then do I/O and then try to return newDomain as a parameter.
I thought to pass a function like this:
run dm (e:es) =
run (dmUpdate dm e renderMsg) es
where renderMsg txt = (putStr txt) >> (hFlush stdout)
...in order to do somthing like:
-- dmUpdate :: dmUpdate :: Domain -> Event -> (String -> IO ()) -> IO () -> Domain
dmUpdate (Domain v) (EventLook) (renderMsg) = let newDomain = look (snd v)
renderMsg (fst newDomain)
But does not work.
Any ideas!? Thanks in advance!
[EDIT1]
I also tried :
dmUpdate :: Domain -> Event -> IO Domain
dmUpdate (Domain v) (EventLook) = do let newDomain = look (snd v)
putStr (fst newDomain)
newDomain
dmUpdate dm _ _ = () dm
... but I got this message:
[2 of 2] Compiling Main ( textGameMain.hs, interpreted )
textGameMain.hs:25:1: error:
Equations for ‘dmUpdate’ have different numbers of arguments
textGameMain.hs:(25,1)-(27,47)
textGameMain.hs:33:1-23
|
25 | dmUpdate (Domain v) (EventLook) = do let newDomain = look (snd v)
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^...
textGameMain.hs:70:8: error:
• Couldn't match expected type ‘Domain’
with actual type ‘IO Domain’
• In the first argument of ‘run’, namely ‘(dmUpdate dm e)’
In the expression: run (dmUpdate dm e) es
In an equation for ‘run’: run dm (e : es) = run (dmUpdate dm e) es
|
70 | run (dmUpdate dm e ) es
So then, I tried to change run:
run dm (e:es) =
run () (dmUpdate dm e ) es
But I did not manage to make it work... :S
[EDIT2]
So, my code does this (it is based on Land of Lisp, and it is an adaptation to Haskell) :
*Main> main
WORLD> look
you are in the living-room. a wizard is snoring loudly on the couch.
There is door going west from here.
There is ladder going upstairs from here.
You see a whiskey on the floor.
You see a bucket on the floor.
WORLD> walk west
WORLD> look
you are in a beautiful garden. there is a well in front of you.
There is door going east from here.
You see a frog on the floor.
You see a chain on the floor.
[EDIT3]
(Full code - in fact I collapsed two files into a single one for simplicity...can adding a file be done in some other manner !?)
https://github.com/agutie58/landOfLispInHaskell/blob/main/exampleLoLTextGameHaskell.hs
ghci exampleLoLTextGameHaskell.hs
main
(...and then, something to EDIT2...)
You code is far from complete, holds a lot of - for your question - unncesseary parts. I copied your code, simpliefied a little, and made some guessing work. Here is my "fixed" version.
module Tmp where
import Text.Read (readMaybe)
{-| Be clear about your types. Introducing type alisases helps others read your code.
I simply guessed that the string-part of the Domain is the UI state -}
type UIState = String
data Domain = Domain (UIState,World) deriving Show
data World = World {loc:: Int} deriving Show
-- | I Have only implemented two directions, so that this example is easy to work with.
data Dir = L | R deriving (Read, Show)
{- | These were the event types that you had in your code. I elaborated them a little.
By using the "deriving (Read)" we get a low-code input mechanism, but you should probalbly write
your own input parser
-}
data Event = EventExit | EventWalk Dir| EventLook deriving (Read)
-- | The run-loop now has TWO steps. Render UI and get new events. Process events. Finally recurse.
run :: Domain -> [Event] -> IO ()
run dm [] = uiUpdate dm >> getAction >>= run dm
run _ (EventExit:_) = return ()
run dm (e:es) = run (dmUpdate dm e) es
{-| Update the domain when a single event acts on it -}
dmUpdate :: Domain -> Event -> Domain
dmUpdate (Domain v) (EventLook) = look (snd v)
dmUpdate (Domain v) (EventWalk direction) = walk direction (snd v)
dmUpdate dm _ = dm
look w = Domain ("You are at coordinate " ++ (show .loc $ w), w)
walk L w#World{loc=l}= Domain ("You went left", w{loc=l-1})
walk R w#World{loc=l} = Domain ("You went right", w{loc=l+1})
{-| Present the "output" that the domain holds for us -}
uiUpdate :: Domain -> IO ()
uiUpdate dm = do
let Domain (usState,s) = dm
putStrLn usState
{-| Ask user for input. Only a single event is collected. -}
getAction :: IO [Event]
getAction = do
putStrLn "What do you want to do? Choose between EventExit | EventWalk R | EventWalk L | EventLook"
act <- readMaybe <$> getLine
case act of
Nothing -> putStrLn "Not a valid action" >> getAction
Just evt -> pure [evt]
main :: IO ()
main = run (Domain ("",World 0)) [EventLook]
Finally, you might want to look into StateT, so you can abstract away the Domain object being passed around all the time. But that is outside the scope of this question, I guess.
Do you have any idea how I can loop the function func2 10 times
type Vertex = Int
type OutNeighbors = [Vertex]
data Graph = Graph [(Vertex,OutNeighbors)] deriving (Eq, Show, Read)
func2 (Graph g) = filter (\x -> contains (fst x) (func1 (Graph g))) g --I need to repeat this function 10 times.
I am kind of new to haskell and I have no idea how to do loops
Do you have any idea how I can loop the function func2 10 times
You could iterate it and !! at 10:
> take 5 $ iterate ("hi " ++) "there!"
["there!","hi there!","hi hi there!","hi hi hi there!","hi hi hi hi there!"]
> let func2 = (+3) in iterate func2 0 !! 10
30
but that would require func2 to return the same type as its input, and right now it appears to have type
func2 :: Graph -> [(Vertex,OutNeighbors)]
But if you wrapped Graph back onto it, i.e.,
func2 :: Graph -> Graph
func2 (Graph g) = Graph (... g)
then you could iterate on it.
In Haskell you can use recursion for loops, here is an example:
myLoop 0 g = g
myLoop n g = myLoop (n - 1) (Graph (func2 g))
Now calling myLoop 10 g will call func2 10 times on g.
Note that I had to wrap the result back in the Graph type, that is probably something you should do in the func2 function:
func2 (Graph g) = Graph (filter (\x -> contains (fst x) (func1 (Graph g))) g)
You can get a little bit higher-level if you wrap this up in the State monad from the transformers package:
import Control.Monad.Trans.State.Lazy (execState, modify)
import Control.Monad (replicateM_)
myLoop :: Int -> Graph -> Graph
myLoop n g = execState (replicateM_ n (modify func2)) g
This is one of these situations where, in order to avoid typing errors, you need to be able to refer to both the whole parameter and to its subcomponents thru proper names.
Fortunately, Haskell provides just that. This is known as the “as patterns”. More details here: SO-q30326249.
In your case, you could note your graph parameter as: g#(Graph(pairs)). Then, g is your graph object, and pairs is the corresponding list of type [(Vertex,OutNeighbors)].
You do not tell us about your contains function, but it is possible to infer that its type is:
contains :: Vertex -> Graph -> Bool
With that in mind, a version of your graph function taking an arbitrary iteration count can be written this way:
type Vertex = Int
type OutNeighbors = [Vertex]
data Graph = Graph [(Vertex,OutNeighbors)] deriving (Eq, Show, Read)
funcN :: Int -> Graph -> Graph
funcN iterCount g#(Graph(pairs)) =
if (iterCount <= 0) then g -- nothing to do
else let
gm1 = funcN (iterCount - 1) g -- recursion
fn = \(v,ngs) -> contains v gm1 -- filtration
in
Graph (filter fn pairs)
Using the same techniques, a tentative version of the contains function could be like this:
contains :: Vertex -> Graph -> Bool
contains v g#( Graph [] ) = False
contains v g#( Graph ((v0,ngs0):pairs) ) = (v == v0) || contains v (Graph(pairs))
This second function is a bit more complicated, because lists can be described thru 2 patterns, empty and non-empty.
Finally, a version of the function that does exactly 10 iterations can be written like this:
func10 :: Graph -> Graph
func10 g = funcN 10 g
or also in a more concise fashion using partial application (known in Haskell circles as currying):
func10 :: Graph -> Graph
func10 = funcN 10
Addendum: library style, using nest:
If for some reason “manual recursion” is frowned upon, it is possible to use instead the nest :: Int -> (a -> a) -> a -> a library function. It computes the Nth compositional power of a function, using recursion internally.
Then one just has to write the single iteration version of the graph function. The code looks like this:
import Data.Function.HT (nest)
funcNl :: Int -> Graph -> Graph
funcNl iterCount g0 = let
-- 2 local function definitions:
ftfn g1 (v, ngs) = contains v g1
func1 g2#(Graph(pairs)) = Graph (filter (ftfn g2) pairs)
in
nest iterCount func1 g0
I am trying to write a function that will take a JSON object, make a change to every string value in it and return a new JSON object. So far my code is:
applyContext :: FromJSON a => a -> a
applyContext x =
case x of
Array _ -> map applyContext x
Object _ -> map applyContext x
String _ -> parseValue x
_ -> x
However, the compiler complains about second second case line:
Couldn't match expected type `[b0]' with actual type `a'
`a' is a rigid type variable bound by
the type signature for:
applyContext :: forall a. FromJSON a => a -> a
at app\Main.hs:43:17
I'm guessing that is because map is meant to work on lists, but I would have naively expected it to use Data.HashMap.Lazy.map instead, since that is what the type actually is in that case. If I explicitly use that function I get
Couldn't match expected type `HashMap.HashMap k0 v20' with actual type `a'
which also makes sense, since I haven't constrained a to that extent because then it wouldn't work for the other cases. I suspect that if I throw enough explicit types at this I could make it work but it feels like it should be a lot simpler. What is an idiomatic way of writing this function, or if this is good then what would be the simplest way of getting the types right?
First of all, what FromJSON a => a does mean? It's type of some thing what says: it can be thing with any type but only from class FromJSON. This class can contain types which very differently constructed and you can't do any pattern matching. You can only do what is specified in the class FromJSON declaration by programmer. Basically, there is one method parseJSON :: FromJSON a => Value -> Parser a.
Secondly, you should use some isomorphic representation of JSON for your work. The type Value is good one. So, you can do the main work by the function like Value -> Value. After that, you can compose this fuction with parseJSON and toJSON for generalse types.
Like this:
change :: Value -> Value
change (Array x) = Array . fmap change $ x
change (Object x) = Object . fmap change $ x
change (String x) = Object . parseValue $ x
change x = x
apply :: (ToJSON a, FromJSON b) => (Value -> Value) -> a -> Result b
apply change = fromJSON . change . toJSON
unsafeApply :: (ToJSON a, FromJSON b) => (Value -> Value) -> a -> b
unsafeApply change x = case apply change x of
Success x -> x
Error msg -> error $ "unsafeApply: " ++ msg
applyContext :: (ToJSON a, FromJSON b) => a -> b
applyContext = unsafeApply change
You can write more complicated transformations like Value -> Value with lens and lens-aeson. For example:
import Control.Lens
import Control.Monad.State
import Data.Aeson
import Data.Aeson.Lens
import Data.Text.Lens
import Data.Char
change :: Value -> Value
change = execState go
where
go = do
zoom values go
zoom members go
_String . _Text . each %= toUpper
_Bool %= not
_Number *= 10
main = print $ json & _Value %~ change
where json = "{\"a\":[1,\"foo\",false],\"b\":\"bar\",\"c\":{\"d\":5}}"
Output will be:
"{\"a\":[10,\"FOO\",true],\"b\":\"BAR\",\"c\":{\"d\":50}}"
This is actually in continuation of the question I asked a few days back. I took the applicative functors route and made my own instances.
I need to parse a huge number of json statements all in a file, one line after the other. An example json statement is something like this -
{"question_text": "How can NBC defend tape delaying the Olympics when everyone has
Twitter?", "context_topic": {"followers": 21, "name": "NBC Coverage of the London
Olympics (July & August 2012)"}, "topics": [{"followers": 2705,
"name": "NBC"},{"followers": 21, "name": "NBC Coverage of the London
Olympics (July & August 2012)"},
{"followers": 17828, "name": "Olympic Games"},
{"followers": 11955, "name": "2012 Summer Olympics in London"}],
"question_key": "AAEAABORnPCiXO94q0oSDqfCuMJ2jh0ThsH2dHy4ATgigZ5J",
"__ans__": true, "anonymous": false}
sorry for the json formatting. It got bad
I have about 10000 such json statements and I need to parse them. The code I have written is
something like this -
parseToRecord :: B.ByteString -> Question
parseToRecord bstr = (\(Ok x) -> x) decodedObj where decodedObj = decode (B.unpack bstr) :: Result Question
main :: IO()
main = do
-- my first line in the file tells how many json statements
-- are there followed by a lot of other irrelevant info...
ts <- B.getContents >>= return . fst . fromJust . B.readInteger . head . B.lines
json_text <- B.getContents >>= return . tail . B.lines
let training_data = take (fromIntegral ts) json_text
let questions = map parseToRecord training_data
print $ questions !! 8922
This code gives me a runtime error Non-exhaustive patterns in lambda. The error references to \(Ok x) -> x in the code. By hit and trial, I came to the conclusion that the program works ok till the 8921th index and fails on the 8922th iteration.
I checked the corresponding json statement and tried to parse it standalone by calling the function on it and it works. However, it doesn't work when I call map. I don't really understand what is going on. Having learnt a little bit of haskell in "learn haskell for a great good", I wanted to dive into a real world programming project but seem to have got stuck here.
EDIT :: complete code is as follows
{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -O2 -optc-O2 #-}
{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Maybe
import NLP.Tokenize
import Control.Applicative
import Control.Monad
import Text.JSON
data Topic = Topic
{ followers :: Integer,
name :: String
} deriving (Show)
data Question = Question
{ question_text :: String,
context_topic :: Topic,
topics :: [Topic],
question_key :: String,
__ans__ :: Bool,
anonymous :: Bool
} deriving (Show)
(!) :: (JSON a) => JSObject JSValue -> String -> Result a
(!) = flip valFromObj
instance JSON Topic where
-- Keep the compiler quiet
showJSON = undefined
readJSON (JSObject obj) =
Topic <$>
obj ! "followers" <*>
obj ! "name"
readJSON _ = mzero
instance JSON Question where
-- Keep the compiler quiet
showJSON = undefined
readJSON (JSObject obj) =
Question <$>
obj ! "question_text" <*>
obj ! "context_topic" <*>
obj ! "topics" <*>
obj ! "question_key" <*>
obj ! "__ans__" <*>
obj ! "anonymous"
readJSON _ = mzero
isAnswered (Question _ _ _ _ status _) = status
isAnonymous (Question _ _ _ _ _ status) = status
parseToRecord :: B.ByteString -> Question
parseToRecord bstr = handle decodedObj
where handle (Ok k) = k
handle (Error e) = error (e ++ "\n" ++ show bstr)
decodedObj = decode (B.unpack bstr) :: Result Question
--parseToRecord bstr = (\(Ok x) -> x) decodedObj where decodedObj = decode (B.unpack bstr) :: Result Question
main :: IO()
main = do
ts <- B.getContents >>= return . fst . fromJust . B.readInteger . head . B.lines
json_text <- B.getContents >>= return . tail . B.lines
let training_data = take (fromIntegral ts) json_text
let questions = map parseToRecord training_data
let correlation = foldr (\x acc -> if (isAnonymous x == isAnswered x) then (fst acc + 1, snd acc + 1) else (fst acc, snd acc + 1)) (0,0) questions
print $ fst correlation
here's the data which can be given as input to the executable. I'm using ghc 7.6.3. If the program name is ans.hs, I followed these steps.
$ ghc --make ans.hs
$ ./ans < path/to/the/file/sample/answered_data_10k.in
thanks a lot!
The lambda function (\(Ok x) -> x) is partial in that it will only be able to match objects that were successfully decoded. If you are experiencing this, it indicates that your JSON parser is failing to parse a record, for some reason.
Making the parseToRecord function more informative would help you find the error. Try actually reporting the error, rather than reporting a failed pattern match.
parseToRecord :: B.ByteString -> Question
parseToRecord bstr = handle decodedObj
where handle (Ok k) = k
handle (Error e) = error e
decodedObj = decode (B.unpack bstr) :: Result Question
If you want more help, it might be useful to include the parser code.
Update
Based on your code and sample JSON, it looks like your code is first failing
when it encounters a null in the context_topic field of your JSON.
Your current code cannot handle a null, so it fails to parse. My fix would
be something like the following, but you could come up with other ways to
handle it.
data Nullable a = Null
| Full a
deriving (Show)
instance JSON a => JSON (Nullable a) where
showJSON Null = JSNull
showJSON (Full a) = showJSON a
readJSON JSNull = Ok Null
readJSON c = Full `fmap` readJSON c
data Question = Question
{ question_text :: String,
context_topic :: Nullable Topic,
topics :: [Topic],
question_key :: String,
__ans__ :: Bool,
anonymous :: Bool
} deriving (Show)
It also seems to fail on line 9002, where there is a naked value of "1000" on
that line, and it seems that several JSON values after that line lack the
'__ans__' field.
I would have suggestion to use Maybe in order to parse the null values:
data Question = Question
{ question_text :: String
, context_topic :: Maybe Topic
, topics :: [Topic]
, question_key :: String
, __ans__ :: Bool
, anonymous :: Bool
} deriving (Show)
And then change the readJSON function as follows (in addition, the missing ans-fields can be fixed by returning False on an unsuccessful parsing attempt):
instance JSON Question where
-- Keep the compiler quiet
showJSON = undefined
readJSON (JSObject obj) = Question <$>
obj ! "question_text" <*>
(fmap Just (obj ! "context_topic") <|> return Nothing) <*>
obj ! "topics" <*>
obj ! "question_key" <*>
(obj ! "__ans__" <|> return False) <*>
obj ! "anonymous"
readJSON _ = mzero
After getting rid of the 1000 in line 9000-something (like sabauma mentioned), I got 4358 as result. So maybe these slight changes are enough?
Is it possible to remove the duplicates (as in nub) from a list of functions in Haskell?
Basically, is it possible to add an instance for (Eq (Integer -> Integer))
In ghci:
let fs = [(+2), (*2), (^2)]
let cs = concat $ map subsequences $ permutations fs
nub cs
<interactive>:31:1:
No instance for (Eq (Integer -> Integer))
arising from a use of `nub'
Possible fix:
add an instance declaration for (Eq (Integer -> Integer))
In the expression: nub cs
In an equation for `it': it = nub cs
Thanks in advance.
...
Further, based on larsmans' answer, I am now able to do this
> let fs = [AddTwo, Double, Square]
> let css = nub $ concat $ map subsequences $ permutations fs
in order to get this
> css
[[],[AddTwo],[Double],[AddTwo,Double],[Square],[AddTwo,Square],[Double,Square],[AddTwo,Double,Square],[Double,AddTwo],[Double,AddTwo,Square],[Square,Double],[Square,AddTwo],[Square,Double,AddTwo],[Double,Square,AddTwo],[Square,AddTwo,Double],[AddTwo,Square,Double]]
and then this
> map (\cs-> call <$> cs <*> [3,4]) css
[[],[5,6],[6,8],[5,6,6,8],[9,16],[5,6,9,16],[6,8,9,16],[5,6,6,8,9,16],[6,8,5,6],[6,8,5,6,9,16],[9,16,6,8],[9,16,5,6],[9,16,6,8,5,6],[6,8,9,16,5,6],[9,16,5,6,6,8],[5,6,9,16,6,8]]
, which was my original intent.
No, this is not possible. Functions cannot be compared for equality.
The reason for this is:
Pointer comparison makes very little sense for Haskell functions, since then the equality of id and \x -> id x would change based on whether the latter form is optimized into id.
Extensional comparison of functions is impossible, since it would require a positive solution to the halting problem (both functions having the same halting behavior is a necessary requirement for equality).
The workaround is to represent functions as data:
data Function = AddTwo | Double | Square deriving Eq
call AddTwo = (+2)
call Double = (*2)
call Square = (^2)
No, it's not possible to do this for Integer -> Integer functions.
However, it is possible if you're also ok with a more general type signature Num a => a -> a, as your example indicates! One naïve way (not safe), would go like
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
data NumResLog a = NRL { runNumRes :: a, runNumResLog :: String }
deriving (Eq, Show)
instance (Num a) => Num (NumResLog a) where
fromInteger n = NRL (fromInteger n) (show n)
NRL a alog + NRL b blog
= NRL (a+b) ( "("++alog++ ")+(" ++blog++")" )
NRL a alog * NRL b blog
= NRL (a*b) ( "("++alog++ ")*(" ++blog++")" )
...
instance (Num a) => Eq (NumResLog a -> NumResLog a) where
f == g = runNumResLog (f arg) == runNumResLog (g arg)
where arg = NRL 0 "THE ARGUMENT"
unlogNumFn :: (NumResLog a -> NumResLog c) -> (a->c)
unlogNumFn f = runNumRes . f . (`NRL`"")
which works basically by comparing a "normalised" version of the functions' source code. Of course this fails when you compare e.g. (+1) == (1+), which are equivalent numerically but yield "(THE ARGUMENT)+(1)" vs. "(1)+(THE ARGUMENT)" and thus are indicated as non-equal. However, since functions Num a => a->a are essentially constricted to be polynomials (yeah, abs and signum make it a bit more difficult, but it's still doable), you can find a data type that properly handles those equivalencies.
The stuff can be used like this:
> let fs = [(+2), (*2), (^2)]
> let cs = concat $ map subsequences $ permutations fs
> let ncs = map (map unlogNumFn) $ nub cs
> map (map ($ 1)) ncs
[[],[3],[2],[3,2],[1],[3,1],[2,1],[3,2,1],[2,3],[2,3,1],[1,2],[1,3],[1,2,3],[2,1,3],[1,3,2],[3,1,2]]