4D graph in gnuplot Haskell package

Question

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.

Answer 1

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:

1. We throw away function's values that less, than precision. (I use filter in testedRange for this purpose)
2. 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.
3. 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.