Could someone please help me with this? I'm kinda stuck and don't know why i get this error message :
not in scope type constructor or class 'Point'
--import Haste hiding (eval)
--import Haste.Graphics.Canvas
import Data.Maybe
import Expr
-- calculates all points of the graph in pixels
points :: Expr -> Double -> (Int,Int) -> [Point]
points exp sca (w,h) = [(x,realToPix(eval exp(pixToReal x))) | x<- [0..w]]
where
pixToReal :: Int -> Double
pixToReal x = sca*((fromIntegral x)-(fromIntegral w)/2)
realToPix :: Double -> Int
realToPix x = round ((x/sca) + ((fromIntegral w)/2))
-- calculates the lines that are going to be drawn between the points
linez :: Expr -> Double -> (Int,Int) -> [(Point,Point)]
linez exp sca (w,h) = zip (points exp sca (w,h)) (drop 1 (points exp sca (w,h)))
-- width and height of the window
sizeX, sizeY :: Int
sizeX = 300
sizeY = 300
--main :: IO ()
--main = do
--Just can <- getCanvasById "canvas"
--Just canElem <- elemById "canvas"
--Just func <- elemById "formula"
--Just d <- elemById "draw"
--onEvent d OnClick $ \_ (x,y) -> do
--f <- getProp func "value"
--w <- getProp canElem "width"
--h <- getProp canElem "height"
--render can (stroke (path (points (fromJust (readExpr f)) 0.04 (read w,read h))))
--return()
You have to import "Haste.Graphics.Canvas" which defines type alias for "Point".
Related
I am trying to use gnuplot package for Haskell (https://hackage.haskell.org/package/gnuplot) for building a 4D plot as described here (4D plot with gnuplot). But I cann't figure out how to set appropriate 3DGraph type.
My problem is to draw a function like A = f(x,y,z) and A should be encoded with the color.
After few days I find the solution that is suit for my purpose. Maybe someone will find it useful:
module PrintToGraph where
import qualified Graphics.Gnuplot.Advanced as GP
import qualified Graphics.Gnuplot.Frame as Frame
import qualified Graphics.Gnuplot.Frame.OptionSet as OptsSet
import qualified Graphics.Gnuplot.Plot.ThreeDimensional as Plot3D
import qualified Graphics.Gnuplot.Graph.ThreeDimensional as Graph3D
import qualified Graphics.Gnuplot.LineSpecification as LineSpec
import GHC.Exts (groupWith )
import qualified Graphics.Gnuplot.Value.Atom as Atom
import Graphics.Gnuplot.ColorSpecification ( paletteFrac )
import Data.Foldable ( Foldable(foldMap') )
import Data.List ( elemIndex )
import Data.Maybe ( fromJust )
defltOpts :: OptsSet.T (Graph3D.T Double Double Double)
defltOpts = OptsSet.key False OptsSet.deflt
waveFuncVis :: (Double -> (Double, Double, Double) -> Double) -> Double -> Double -> Frame.T (Graph3D.T Double Double Double)
waveFuncVis func depth precision =
let x = Plot3D.linearScale 100 (-10, 10)
testedRange = (groupWith (\(x,y,z) -> test func (x,y,z) depth precision) . filter (\(x,y,z) -> funcWrapper func x y z^2 >= precision)) [(x1,y1,z1) | x1<-x, y1<-x, z1<-x]
range = [(x1,y1,z1) | x1<-x, y1<-x, z1<-x]
calcColor :: [(Double,Double,Double)] -> Double
calcColor array = fromIntegral (fromJust (elemIndex array testedRange)) / fromIntegral (length testedRange)
linespec array = Graph3D.lineSpec $ LineSpec.lineColor (paletteFrac (calcColor array)) LineSpec.deflt
graph array = linespec array <$> Plot3D.cloud Graph3D.points array
in Frame.cons defltOpts $ foldMap' graph testedRange
test :: (Double -> (Double, Double, Double) -> Double)
-> (Double, Double, Double) -> Double -> Double -> Integer
test func (x, y , z) depth precision
| funcWrapper func x y z^2 >= precision = round $ funcWrapper func x y z^2 * depth
| otherwise = 0
funcWrapper :: (Double -> (Double, Double, Double) -> Double) -> Double -> Double -> Double -> Double
funcWrapper func x' y' z' = func 1.0 (toR x' y' z', toTau x' y' z', toPhi x' y' z')
--2pz Hydrogen function
waveHfunc2pz :: Double -> (Double, Double, Double) -> Double
waveHfunc2pz z (r, tau, phi) = a * b * c* e
where a,b,c,e :: Double
a = 1.0/(4.0*sqrt (2.0*pi))
b = (z/aBohr)**2.5
c = pureTrig cos tau
e = r*exp(-1.0 * (z*r/(2.0*aBohr)))
main :: IO ()
main = sequence_ [GP.plotDefault (waveFuncVis waveHfunc2pz 10000 0.0005)]
Briefly:
We throw away function's values that less, than precision. (I use filter in testedRange for this purpose)
Thanks to the groupWith we receive list of the coordinates' lists - [[(x,y,z)]]. Each sublist here contains coordinates which gives the same function value.
To colorize them we convert sublist's index to the Double value and use it as an argument for PaletteFrac.
As a result we receive cloud of colored dots, where each color correspond to the one function value.
Example picture for 2pz hydrogen atom.
Duplicating this from github as per #HeinrichApfelmus's suggestion:
This may be just a usage error on my part, but I am noticing a strange phenomenon when trying to set up conditional visibility/layout for dynamically created UI elements (in WX of course). As somewhat of a toy-example, I tried to create a widget that created StaticText elements on the fly and allowed the user to "browse" through these elements through '<' '>' buttons.
The problem I am noting is that all labels are invisible until a new one is created, at which point the current widget in focus becomes visible. Whether this is a bug or just a paradigm I am misusing, or a subtlety with reactive frameworks, I am unsure as to how to resolve this. Here is the code I have at this point, which exhibits the problem:
{-# LANGUAGE RecursiveDo #-}
module Test.Adder where
import Reactive.Banana
import Reactive.Banana.WX
import Graphics.UI.WX.Attributes
import Graphics.UI.WX hiding (Event, newEvent, empty, Identity)
import Graphics.UI.WXCore hiding (Event, Timer, empty, Identity, newEvent)
import Graphics.UI.WXCore.Frame
-- | Combine Unit-Events
anyEvent :: [Event ()] -> Event ()
anyEvent = foldl1 (unionWith (\_ _ -> ()))
-- | Unsugared if-then-else function
if_ :: Bool -> a -> a -> a
if_ True x _ = x
if_ False _ y = y
-- | Apply a function to the value at an index, or return a default value
-- if the index is out of range
(!?) :: (a -> b) -> b -> Int -> ([a] -> b)
(f!? ~y) n xs
| n < 0 = y
| otherwise = case drop n xs of
x:_ -> f x
[] -> y
main :: IO ()
main = start test
create :: Window w -> Int -> Behavior Int -> Event Int -> Event () -> MomentIO (StaticText ())
create t i bi ei eRef = do
let tx = replicate i '\t' ++ show i
x <- liftIO $ staticText t [ text := tx ]
let beq = (==i) <$> bi
let eMe = filterE (==i) ei
sink x [ visible :== beq ]
reactimate (refresh x <$ anyEvent [ eRef, () <$ eMe ])
return x
test :: IO ()
test = do
f <- frame [text := "Test"]
add <- button f [ text := "+" ]
prv <- button f [ text := "<" ]
cur <- staticText f []
nxt <- button f [ text := ">" ]
tab <- panel f [ clientSize := sz 200 300 ]
deb <- staticText f []
ref <- button f [ text := "refresh" ]
let networkDescription :: MomentIO ()
networkDescription = mdo
eAdd <- event0 add command
eRef <- event0 ref command
let bNotFirst = (>0) <$> bCur
bNotLast = (<) <$> bCur <*> bNext
sink prv [ enabled :== bNotFirst ]
sink cur [ text :== show <$> bCur ]
sink nxt [ enabled :== bNotLast ]
ePrev <- event0 prv command
eNext <- event0 nxt command
let eDelta :: Enum n => Event (n -> n)
eDelta = unions [ pred <$ whenE bNotFirst ePrev
, succ <$ whenE bNotLast eNext ]
eChange = flip ($) <$> bCur <#> eDelta
bCur <- stepper 0 $ eChange
(eIndex, bCount) <- mapAccum 0 ((\x -> (x, succ x)) <$ eAdd)
let bView = (\n i -> if_ (n==0) (0) i) <$> bCount <*> bCur
bNext = pred <$> bCount
eCreate = (\n -> create tab n bView eChange $ anyEvent [eRef,eAdd]) <$> eIndex
reCreate <- execute eCreate
bItemer <- accumB id $ flip (.) . (:) <$> reCreate
let bItems = ($[]) <$> bItemer
bThis = (widget!?(nullLayouts!!0)) <$> bCur <*> bItems
sink tab [ layout :== bThis ]
liftIO $ set f [ layout := column 5 [ margin 10 $ row 5 [ widget add
, widget prv
, widget cur
, widget nxt
, widget ref
]
, fill $ widget tab
]
]
network <- compile networkDescription
actuate network
>
I have a
foobar :: IO (ParseResult [(String,String)])
ParseResult is a monad defined here: https://hackage.haskell.org/package/haskell-src-exts-1.13.5/docs/Language-Haskell-Exts-Parser.html#t:ParseResult
I want to take those strings and write them to a LaTeXT m () defined in https://hackage.haskell.org/package/HaTeX-3.17.1.0/docs/Text-LaTeX-Base-Writer.html
Running this function results in no file being created.
writeReport2 :: [Char] -> IO (ParseResult (IO ()))
writeReport2 name = do x <- foobar
return $ do y <- x
return $ do z <- (execLaTeXT.docAndGraph) y
renderFile fileName z
where
fileName = name ++ ".tex"
However the code:
writeReport :: t -> LaTeXT IO a -> IO ()
writeReport name report = createLatex >>= renderFile fileName
where
createLatex = execLaTeXT report
fileName = "AAAAA" ++ ".tex"
testFoo = [(" | HaskellExample Example File\n | Two examples are given below:\n\n >>> fib 10\n 55\n\n >>> putStrLn \"foo\\nbar\"\n foo\n bar ","fib :: Int -> Int"),("\n | This is a thing: ","fib = undefined"),("\n | This is a thing:\n","fibar :: String -> Float")]
itWorks = writeReport "AAAA.txt" $ docAndGraph testFoo
Will create a new file.
Both sets of code type check.
I could get writeReport2 working without modification.
I think what might have been your problem is the nested IO action in the return value of writeResport2!
In order to flatten the nested IO actions, I had to use the function join :: Monad m => m (m a) -> m a from Control.Monad:
main :: IO ()
main = join $ fromParseResult <$> writeReport2 "test"
Here is my complete code:
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Language.Haskell.Exts.Parser
import Text.LaTeX.Base.Writer
import Text.LaTeX
import Data.String
import Control.Monad
foobar :: IO (ParseResult [(String, String)])
foobar = return (ParseOk testFoo)
testFoo = [ ( " | HaskellExample Example File\n | Two examples are given below:\n\n >>> fib 10\n 55\n\n >>> putStrLn \"foo\\nbar\"\n foo\n bar "
, "fib :: Int -> Int"
)
, ("\n | This is a thing: ", "fib = undefined")
, ("\n | This is a thing:\n", "fibar :: String -> Float")
]
docAndGraph :: Monad m => [(String, String)] -> LaTeXT m ()
docAndGraph x = do
documentclass [] article
document $
raw (fromString (show x))
writeReport2 :: [Char] -> IO (ParseResult (IO ()))
writeReport2 name = do
x <- foobar
return $ do
y <- x
return $ do
z <- (execLaTeXT . docAndGraph) y
renderFile fileName z
where
fileName = name ++ ".tex"
main :: IO ()
main = join $ fromParseResult <$> writeReport2 "test"
Loading into GHCi:
$ stack ghci
io-action-nested-in-other-monads-not-executing-0.1.0.0: initial-build-steps (exe)
Configuring GHCi with the following packages: io-action-nested-in-other-monads-not-executing
Using main module: 1. Package `io-action-nested-in-other-monads-not-executing' component exe:io-action-nested-in-other-monads-not-executing with main-is file: /home/sven/dev/stackoverflow-questions/io-action-nested-in-other-monads-not-executing/src/Main.hs
GHCi, version 8.0.2: http://www.haskell.org/ghc/ :? for help
Loaded GHCi configuration from /home/sven/.ghc/ghci.conf
[1 of 1] Compiling Main ( /home/sven/dev/stackoverflow-questions/io-action-nested-in-other-monads-not-executing/src/Main.hs, interpreted )
Ok, modules loaded: Main.
Loaded GHCi configuration from /tmp/ghci22616/ghci-script
And running it:
λ main
Creates this file:
$ cat test.tex
\documentclass{article}\begin{document}[(" | HaskellExample Example File\n | Two examples are given below:\n\n >>> fib 10\n 55\n\n >>> putStrLn \"foo\\nbar\"\n foo\n bar ","fib :: Int -> Int"),("\n | This is a thing: ","fib = undefined"),("\n | This is a thing:\n","fibar :: String -> Float")]\end{document}%
I know it is not the scope of the question, but you could circumvent the nested IO if you want, by doinf this, for example:
writeReport3 :: [Char] -> IO ()
writeReport3 name = do
let fileName = name ++ ".tex"
x <- foobar
case x of
ParseOk y -> do
z <- execLaTeXT (docAndGraph y)
renderFile fileName z
ParseFailed _ _ ->
return ()
main :: IO ()
main = writeReport3 "test"
I'm trying to write a Haskell program to parse huge text file (about 14Gb), but i can't understand how to make it free unused data from memory or not to make stack overflow during foldr. Here is the program source:
import qualified Data.ByteString.Lazy.Char8 as LBS
import qualified Data.ByteString.Lex.Lazy.Double as BD
import System.Environment
data Vertex =
Vertex{
vertexX :: Double,
vertexY :: Double,
vertexZ :: Double}
deriving (Eq, Show, Read)
data Extent =
Extent{
extentMax :: Vertex,
extentMin :: Vertex}
deriving (Eq, Show, Read)
addToExtent :: Extent -> Vertex -> Extent
addToExtent ext vert = Extent vertMax vertMin where
(vertMin, vertMax) = (makeCmpVert max (extentMax ext) vert, makeCmpVert min (extentMin ext) vert) where
makeCmpVert f v1 v2 = Vertex(f (vertexX v1) (vertexX v2))
(f (vertexY v1) (vertexY v2))
(f (vertexZ v1) (vertexZ v2))
readCoord :: LBS.ByteString -> Double
readCoord l = case BD.readDouble l of
Nothing -> 0
Just (value, _) -> value
readCoords :: LBS.ByteString -> [Double]
readCoords l | LBS.length l == 0 = []
| otherwise = let coordWords = LBS.split ' ' l
in map readCoord coordWords
parseLine :: LBS.ByteString -> Vertex
parseLine line = Vertex (head coords) (coords!!1) (coords!!2) where
coords = readCoords line
processLines :: [LBS.ByteString] -> Extent -> Extent
processLines strs ext = foldr (\x y -> addToExtent y (parseLine x)) ext strs
processFile :: String -> IO()
processFile name = do
putStrLn name
content <- LBS.readFile name
let (countLine:recordsLines) = LBS.lines content
case LBS.readInt countLine of
Nothing -> putStrLn "Can't read records count"
Just (recordsCount, _) -> do
print recordsCount
let vert = parseLine (head recordsLines)
let ext = Extent vert vert
print $ processLines recordsLines ext
main :: IO()
main = do
args <- getArgs
case args of
[] -> do
putStrLn "Missing file path"
xs -> do
processFile (head xs)
return()
Text file contains lines with three floating point numbers delimited with space character. This program always tries to occupy all free memory on a computer and crashes with out of memory error.
You are being too lazy. Vertex and Extent have non-strict fields, and all your functions returning a Vertex return
Vertex thunk1 thunk2
without forcing the components to be evaluated. Also addToExtent directly returns an
Extent thunk1 thunk2
without evaluating the components.
Thus none of the ByteStrings actually is released early to be garbage-collected, since the Doubles are not parsed from them yet.
When that is fixed by making the fields of Vertex and Extent strict - or the functions returning a Vertex resp. Extent forcing all parts of their input, you have the problem that
processLines strs ext = foldr (\x y -> addToExtent y (parseLine x)) ext strs
can't start assembling the result before the end of the list of lines is reached because then
(\x y -> addToExtent y (parseLine x))
is strict in its second argument.
However, barring NaNs and undefined values, if I didn't miss something, the result would be the same if you use a (strict!) left fold, so
processLines strs ext = foldl' (\x y -> addToExtent x (parseLine y)) ext strs
should produce the desired result without holding on to the data if Vertex and Extent get strict fields.
Ah, I did miss something:
addToExtent ext vert = Extent vertMax vertMin
where
(vertMin, vertMax) = (makeCmpVert max (extentMax ext) vert, makeCmpVert min (extentMin ext)
If that isn't a typo (what I expect it is), fixing that would be somewhat difficult.
I think it should be
(vertMax, vertMin) = ...
addToExtent is too lazy. A possible alternative definition is
addToExtent :: Extent -> Vertex -> Extent
addToExtent ext vert = vertMax `seq` vertMin `seq` Extent vertMax vertMin where
(vertMin, vertMax) = (makeCmpVert max (extentMax ext) vert, makeCmpVert min (extentMinext) vert) where
makeCmpVert f v1 v2 = Vertex(f (vertexX v1) (vertexX v2))
(f (vertexY v1) (vertexY v2))
(f (vertexZ v1) (vertexZ v2))
data Vertex =
Vertex{
vertexX :: {-# UNPACK #-} !Double,
vertexY :: {-# UNPACK #-} !Double,
vertexZ :: {-# UNPACK #-} !Double}
deriving (Eq, Show, Read)
The problem is that vertMin and vertMax are never evaluated until the entire file is processed - resulted in two huge thunks in Extent.
I also recommend changing the definition of Extent to
data Extent =
Extent{
extentMax :: !Vertex,
extentMin :: !Vertex}
deriving (Eq, Show, Read)
(though with these changes, the seq calls in addToExtent become redundant).
I can have many Figures on my list. Each Figure can have many Rectangles on its list. I have a problem with my function checkNewRectangleId - this function should ask user about new rectangle id until he write really new id and then it should return this id - but I have an error: couldn't match expected type IO t against inferred type Maybe figureType line (Figure id width height rectangles) <- findFigure idFigure x in my function - could you help ?
import IO
import Char
import System.Exit
import Maybe
import Data.Time.Calendar
import System.Time
checkNewRectangleId :: Int -> [FigureType] -> IO Int
checkNewRectangleId idFigure x = do
idRectangle <- getInt "Give me new rectangle id: "
(Figure id width height rectangles) <- findFigure idFigure x
if isJust (findRectangle idRectangle rectangles) then do
putStrLn ("We have yet rectangle with id " ++ show idRectangle)
checkNewRectangleId idFigure x
else return idRectangle
data FigureType = Figure Int Int Int [RectangleType] deriving(Show, Read)
data RectangleType = Rectangle Int CalendarTime deriving(Show, Read)
findFigure :: Int -> [FigureType] -> Maybe FigureType
findFigure _ [] = Nothing
findFigure n ((Figure id width height rectangles) : xs) =
if n == id then Just (Figure id width height rectangles)
else findFigure n xs
findRectangle :: Int -> [RectangleType] -> Maybe RectangleType
findRectangle _ [] = Nothing
findRectangle n ((Rectangle id date) : xs) =
if n == id then Just (Rectangle id date)
else findRectangle n xs
isInt i = not (null i) && all isDigit i
getInt :: String -> IO Int
getInt q = do
putStr q;
i <- getLine
if isInt i == False then do
putStrLn "Bad number"
getInt q
else return (read i)
Since you say idFigure is guaranteed to exist, you can use fromJust in the Data.Maybe module to convert a Maybe FigureType into a FigureType:
let (Figure id width height rectangles) = fromJust $ findFigure idFigure x
findFigure operates in the Maybe monad, but checkNewRectangleId operates in the IO monad. Haskell will not automatically translate failures (or successes) in one monad into failures (or successes) in another, because the types don't match. So, you have to ask yourself the question, what do you want to happen if findFigure fails to find anything?