diff --git a/Graphics/Dynamic/Plot/R2.hs b/Graphics/Dynamic/Plot/R2.hs --- a/Graphics/Dynamic/Plot/R2.hs +++ b/Graphics/Dynamic/Plot/R2.hs @@ -117,9 +117,6 @@ import Data.Tagged -import Data.Manifold ((:-->)) -import qualified Data.Manifold as 𝓒⁰ - import Text.Printf import Data.IORef @@ -153,44 +150,8 @@ -- {-# RULES "plot/R->R" plot = fnPlot #-} -instance Plottable (Double :--> Double) where - plot f = def { relevantRange_y = otherDimDependence yRangef - , isTintableMonochromic = True - , axesNecessity = 1 - , dynamicPlot = plot } - where yRangef (Interval l r) = uncurry Interval . (minimum &&& maximum) - . map snd $ 𝓒⁰.finiteGraphContinℝtoℝ - (𝓒⁰.GraphWindowSpec l r fgb fgt 9 9) f - where (fgb, fgt) = (minimum &&& maximum) [f $ l, f $ m, f $ r] - m = l + (r-l) * 0.352479608143 - - plot (GraphWindowSpecR2{..}) = curve `deepseq` mkPlot (trace curve) - where curve :: [P2] - curve = map convℝ² $ 𝓒⁰.finiteGraphContinℝtoℝ mWindow f - mWindow = 𝓒⁰.GraphWindowSpec (c lBound) (c rBound) (c bBound) (c tBound) - xResolution yResolution - trace (p:q:ps) = simpleLine p q <> trace (q:ps) - trace _ = mempty - - convℝ² = Dia.p2 - c = realToFrac -instance Plottable (Double :--> (Double, Double)) where - plot f = def { isTintableMonochromic = True - , axesNecessity = 1 - , dynamicPlot = plot } - where plot (GraphWindowSpecR2{..}) = curves `deepseq` mkPlot (foldMap trace curves) - where curves :: [[P2]] - curves = map (map convℝ²) $ 𝓒⁰.finiteGraphContinℝtoℝ² mWindow f - mWindow = 𝓒⁰.GraphWindowSpec (c lBound) (c rBound) (c bBound) (c tBound) - xResolution yResolution - trace (p:q:ps) = simpleLine p q <> trace (q:ps) - trace _ = mempty - - convℝ² = Dia.p2 - c = realToFrac - instance (Plottable p) => Plottable [p] where plot = foldMap plot @@ -224,11 +185,20 @@ instance Plottable (R-->R) where - plot f = def { relevantRange_y = mempty -- otherDimDependence yRangef + plot f = def { relevantRange_y = OtherDimDependantRange yRangef , isTintableMonochromic = True , axesNecessity = 1 , dynamicPlot = plot } - where yRangef (Interval l r) = undefined + where yRangef (Option Nothing) = Option Nothing + yRangef (Option (Just (Interval l r))) + = case intervalImages + 100 + ( const . metricFromLength $ (r-l)/16 , const $ metricFromLength 0.0001 ) + ( alg (\x -> ( point l? (f$~x) ))) of + ([],[]) -> Option Nothing + (liv,riv) -> pure . foldr1 (<>) . map (uncurry Interval . snd) + $ take 4 liv ++ take 4 riv + plot gs@(GraphWindowSpecR2{..}) = curves `deepseq` mkPlot (foldMap trace curves) where curves :: [[P2]] @@ -238,9 +208,8 @@ ( const . metricFromLength $ (rBound-lBound)/fromIntegral xResolution , resolutionFunction gs ) - (lBound, rBound) - (id&&&f) - x₀ = (lBound + rBound)/2 + ((id&&&f) + . alg (\x -> ( point lBound? x ))) trace (p:q:ps) = simpleLine p q <> trace (q:ps) trace _ = mempty gatherSides = uncurry (++) . (take 50 *** take 50) @@ -248,10 +217,31 @@ convℝ² = Dia.p2 c = realToFrac +instance Plottable (R-->(R,R)) where + plot f = def { relevantRange_y = mempty + , isTintableMonochromic = True + , axesNecessity = 1 + , dynamicPlot = plot } + where plot gs@(GraphWindowSpecR2{..}) = curves `deepseq` + mkPlot (foldMap trace curves) + where curves :: [[P2]] + curves = map (map $ convℝ² . snd) . gatherSides + $ discretisePathSegs + 1000 + ( const . metricFromLength $ 1/100 + , resolutionFunction gs ) + f + trace (p:q:ps) = simpleLine p q <> trace (q:ps) + trace _ = mempty + gatherSides = uncurry (++) . (take 50 *** take 50) + + convℝ² = Dia.p2 + c = realToFrac + + resolutionFunction :: GraphWindowSpecR2 -> RieMetric ℝ² resolutionFunction GraphWindowSpecR2{..} = resoFunc - where x₀ = (lBound + rBound)/2 - w = rBound - lBound; h = tBound - bBound + where w = rBound - lBound; h = tBound - bBound ε = projector (recip δx, 0) ^+^ projector (0, recip δy) δx = w / fromIntegral xResolution δy = h / fromIntegral yResolution @@ -606,6 +596,14 @@ -- The individual objects you want to plot can be evaluated in multiple threads, so -- a single hard calculatation won't freeze the responsitivity of the whole window. -- Invoke e.g. from @ghci +RTS -N4@ to benefit from this. +-- +-- ATTENTION: the window may sometimes freeze, especially when displaying +-- complicated functions with 'diffableFnPlot` from ghci. This is apparently +-- a kind of deadlock problem with one of the C libraries that are invoked, +-- in particular, 'diffableFnPlot' makes heavy use of +-- and thus . +-- At the moment, we can recommend no better solution than to abort and restart ghci, +-- if this occurs. plotWindow :: [DynamicPlottable] -> IO GraphWindowSpec plotWindow [] = plotWindow [dynamicAxes] plotWindow graphs' = do @@ -887,7 +885,7 @@ -- of defining functions with range-pattern-matching etc., which is at the moment -- not possible in the ':-->' category. -- --- However, because 'Double' can't really proove properties of a mathematical +-- However, because 'Double' can't really prove properties of a mathematical -- function, aliasing and similar problems are not taken into account. So it only works -- accurately when the function is locally linear on pixel scales (what most -- other plot programs just assume silently). In case of singularities, the @@ -914,16 +912,42 @@ l!n | (x:_)<-drop n l = x | otherwise = error "Function appears to yield NaN most of the time. Cannot be plotted." + type (-->) = RWDiffable ℝ -diffableFnPlot :: (∀ m . ( WithField ℝ PseudoAffine m +-- | Plot a continuous function in the usual way, taking arguments from the +-- x-Coordinate and results to the y one. +-- The signature looks more complicated than it is; think about it as requiring +-- a polymorphic 'Floating' function. Any simple expression like +-- @'fnPlot' (\\x -> sin x / cos (sqrt x))@ will work. +-- +-- Under the hood this uses the category of region-wise differentiable functions, +-- 'RWDiffable', to prove that no details are omitted (like small high-frequency +-- bumps). Note that this can become difficult for contrived cases like @cos(1/sin x)@ +-- – while such functions will never come out with aliasing artifacts, they also +-- may not come out quickly at all. (But for well-behaved functions, using the +-- differentiable category actually tends to be more effective, because the algorithm +-- immediately sees when it can describe an almost-linear region with only a few line +-- segments.) +-- +-- This function is equivalent to using 'plot' on an 'RWDiffable' arrow. +fnPlot :: (∀ m . ( WithField ℝ PseudoAffine m , HasMetric (Needle (Interior m)) ) => AgentVal (-->) m ℝ -> AgentVal (-->) m ℝ ) -> DynamicPlottable -diffableFnPlot f = plot fd +fnPlot f = plot fd where fd :: ℝ --> ℝ fd = alg f +-- | Plot a continuous, “parametric function”, i.e. mapping the real line to a path in ℝ². +paramPlot :: (∀ m . ( WithField ℝ PseudoAffine m + , HasMetric (Needle (Interior m)) ) + => AgentVal (-->) m ℝ -> (AgentVal (-->) m ℝ, AgentVal (-->) m ℝ) ) + -> DynamicPlottable +paramPlot f = plot fd + where fd :: ℝ --> (ℝ,ℝ) + fd = alg1to2 f + scrutiniseDiffability :: (∀ m . ( WithField ℝ PseudoAffine m , HasMetric (Needle (Interior m)) ) => AgentVal (-->) m ℝ -> AgentVal (-->) m ℝ ) @@ -954,42 +978,6 @@ δy = rfh * (tBound - bBound) --- | Plot a continuous function in the usual way, taking arguments from the --- x-Coordinate and results to the y one. --- The signature looks more complicated than it is; think about it as requiring --- a polymorphic 'Floating' function. Any simple expression like --- @'fnPlot' (\\x -> sin x / exp (x^2))@ will work (but the view must not contain --- singularities). --- --- Under the hood this uses the category of continuous functions, ':-->', to prove --- that no details are omitted (like small high-frequency bumps). The flip side is that --- this does not always work very efficiently, in fact it can easily become exponentially --- slow for some parameters. --- Make sure to run multithreaded, to prevent hanging your program this way. Also consider --- limiting the memory: if you try to plot across singularities, the program may well --- eat up all available resorces before failing. (But it will never “succeed” and --- plot something wrong!) --- --- In the future, we would like to switch to the category of piecewise continuously-differentiable --- functions. That wouldn't suffer from said problems, and should --- also generally be more efficient. (That category is not yet implemented in Haskell.) -fnPlot :: (forall m . 𝓒⁰.Manifold m - => AgentVal (:-->) m Double -> AgentVal (:-->) m Double) - -> DynamicPlottable -fnPlot f = plot fc - where fc :: Double :--> Double - fc = alg f - --- | Plot a continuous, “parametric function”, i.e. mapping the real --- line to a path in ℝ². -paramPlot :: (forall m . 𝓒⁰.Manifold m - => AgentVal (:-->) m Double - -> (AgentVal (:-->) m Double, AgentVal (:-->) m Double)) - -> DynamicPlottable -paramPlot f = plot fc - where fc :: Double :--> (Double, Double) - fc = alg1to2 f - continColourSurfaceFnPlot :: ((Double,Double) -> DCol.Colour Double) -> DynamicPlottable continColourSurfaceFnPlot f = def { diff --git a/dynamic-plot.cabal b/dynamic-plot.cabal --- a/dynamic-plot.cabal +++ b/dynamic-plot.cabal @@ -1,5 +1,5 @@ Name: dynamic-plot -Version: 0.1.1.2 +Version: 0.1.2.0 Category: graphics Synopsis: Interactive diagram windows Description: Haskell excels at handling data like continuous functions @@ -60,7 +60,7 @@ , gtk > 0.10 && < 0.15 , glib , colour >= 2 && < 3 - , manifolds == 0.1.6.2 + , manifolds >= 0.1.6.3 && < 0.1.7 , lens < 4.12.4 Other-Extensions: FlexibleInstances , TypeFamilies