From 6945aac704d78ec5acdd06cc531937d7a9dd20d5 Mon Sep 17 00:00:00 2001 From: sheaf Date: Fri, 20 Jan 2023 17:42:17 +0100 Subject: [PATCH] improve show instances --- cabal.project | 12 ++----- src/app/MetaBrush/Application.hs | 6 ++-- src/metabrushes/MetaBrush/Records.hs | 26 ++++++--------- src/splines/Math/Bezier/Stroke.hs | 40 +++++++++++------------ src/splines/Math/Interval.hs | 31 +++++++----------- src/splines/Math/Interval/Internal.hs | 46 +++++++++++++++++++-------- src/splines/Math/Linear.hs | 21 ++++++++---- src/splines/Math/Linear/Internal.hs | 45 +++++++++++++++++++++++--- 8 files changed, 134 insertions(+), 93 deletions(-) diff --git a/cabal.project b/cabal.project index b162dbc..9787ad5 100644 --- a/cabal.project +++ b/cabal.project @@ -27,12 +27,6 @@ allow-newer: waargonaut:semigroups, waargonaut:text, waargonaut:vector, waargonaut:witherable, --- eigen ---source-repository-package --- type: git --- location: https://github.com/chessai/eigen --- tag: 8fff32a43df743c8c83428a86dd566a0936a4fba - -- records-sop source-repository-package type: git @@ -43,11 +37,11 @@ source-repository-package -- GHC 9.4 -- ------------- --- hw-balancedparens +-- eigen source-repository-package type: git - location: https://github.com/sheaf/hw-balancedparens - tag: 747e4ce2145b436dd352814b71a68fc41fe63e6f + location: https://github.com/chessai/eigen + tag: 1790fdf9138970dde0dbabf8b270698145a4a88c ------------- -- GHC 9.6 -- diff --git a/src/app/MetaBrush/Application.hs b/src/app/MetaBrush/Application.hs index b3349a4..ac1b805 100644 --- a/src/app/MetaBrush/Application.hs +++ b/src/app/MetaBrush/Application.hs @@ -200,11 +200,11 @@ runApplication application = do maxHistorySizeTVar <- STM.newTVarIO @Int 1000 fitParametersTVar <- STM.newTVarIO @FitParameters ( FitParameters - { maxSubdiv = 1 --2 --3 -- 6 - , nbSegments = 2 --3 --6 -- 12 + { maxSubdiv = 5 --2 --3 -- 6 + , nbSegments = 3 --3 --6 -- 12 , dist_tol = 0.1 -- 5e-3 , t_tol = 0.1 -- 1e-4 - , maxIters = 1 -- 100 + , maxIters = 5 -- 100 } ) diff --git a/src/metabrushes/MetaBrush/Records.hs b/src/metabrushes/MetaBrush/Records.hs index 4609e1a..58ea2b1 100644 --- a/src/metabrushes/MetaBrush/Records.hs +++ b/src/metabrushes/MetaBrush/Records.hs @@ -41,12 +41,6 @@ import Control.DeepSeq import Data.Group ( Group(..) ) --- rounded-hw -import Numeric.Rounded.Hardware - ( Rounded(..) ) -import Numeric.Rounded.Hardware.Interval.NonEmpty - ( Interval(..) ) - -- text import Data.Text ( Text ) @@ -130,19 +124,19 @@ instance ( Torsor ( T ( ℝ ( Length ks ) ) ) ( ℝ ( Length ks ) ) instance ( Act ( T ( 𝕀ℝ ( Length ks ) ) ) ( 𝕀ℝ ( Length ks ) ) , Semigroup ( T ( 𝕀ℝ ( Length ks ) ) ) ) => Act ( T ( 𝕀 ( Record ks ) ) ) ( 𝕀 ( Record ks ) ) where - T ( I ( Rounded ( MkR g_lo ) ) ( Rounded ( MkR g_hi ) ) ) - • I ( Rounded ( MkR a_lo ) ) ( Rounded ( MkR a_hi ) ) - = case T ( I ( Rounded g_lo ) ( Rounded g_hi ) ) • I ( Rounded a_lo ) ( Rounded a_hi ) of - I ( Rounded b_lo ) ( Rounded b_hi ) -> - I ( Rounded ( MkR b_lo ) ) ( Rounded ( MkR b_hi ) ) + T ( 𝕀 ( MkR g_lo ) ( MkR g_hi ) ) + • 𝕀 ( MkR a_lo ) ( MkR a_hi ) + = case T ( 𝕀 g_lo g_hi ) • 𝕀 a_lo a_hi of + 𝕀 b_lo b_hi -> + 𝕀 ( MkR b_lo ) ( MkR b_hi ) instance ( Torsor ( T ( 𝕀ℝ ( Length ks ) ) ) ( 𝕀ℝ ( Length ks ) ) , Group ( T ( 𝕀ℝ ( Length ks ) ) ) ) => Torsor ( T ( 𝕀 ( Record ks ) ) ) ( 𝕀 ( Record ks ) ) where - I ( Rounded ( MkR a_lo ) ) ( Rounded ( MkR a_hi ) ) - --> I ( Rounded ( MkR b_lo ) ) ( Rounded ( MkR b_hi ) ) - = case I ( Rounded a_lo ) ( Rounded a_hi ) --> I ( Rounded b_lo ) ( Rounded b_hi ) of - T ( I ( Rounded c_lo ) ( Rounded c_hi ) ) -> - T ( I ( Rounded ( MkR c_lo ) ) ( Rounded ( MkR c_hi ) ) ) + 𝕀 ( MkR a_lo ) ( MkR a_hi ) + --> 𝕀 ( MkR b_lo ) ( MkR b_hi ) + = case 𝕀 a_lo a_hi --> 𝕀 b_lo b_hi of + T ( 𝕀 c_lo c_hi ) -> + T ( 𝕀 ( MkR c_lo ) ( MkR c_hi ) ) type instance RepDim ( Record ks ) = Length ks deriving newtype diff --git a/src/splines/Math/Bezier/Stroke.hs b/src/splines/Math/Bezier/Stroke.hs index da0f098..85cae93 100644 --- a/src/splines/Math/Bezier/Stroke.hs +++ b/src/splines/Math/Bezier/Stroke.hs @@ -85,8 +85,6 @@ import qualified Control.Parallel.Strategies as Strats -- rounded-hw import Numeric.Rounded.Hardware ( Rounded(..) ) -import Numeric.Rounded.Hardware.Interval.NonEmpty - ( Interval(I) ) import qualified Numeric.Rounded.Hardware.Interval.NonEmpty as Interval -- transformers @@ -539,11 +537,11 @@ outlineFunction ptParams toBrushParams brushFromParams sp0 crv = bisSols = bisection 0.0001 curvesI - in --trace - -- ( unlines $ - -- ( "bisectionMethod: #(possible zeroes) = " ++ show ( length bisSols ) ) : - -- "" : - -- map show bisSols ) + in trace + ( unlines $ + ( "bisectionMethod: #(possible zeroes) = " ++ show ( length bisSols ) ) : + "" : + map show bisSols ) fwdBwd ----------------------------------- @@ -1178,9 +1176,9 @@ bisection minWidth eqs = bisect initialCands [] [] | otherwise = bisect cands toTry sols - bisect ( cand@( t@( I ( Rounded ( ℝ1 t_lo ) ) ( Rounded ( ℝ1 t_hi ) ) ) + bisect ( cand@( t@( 𝕀 ( ℝ1 t_lo ) ( ℝ1 t_hi ) ) , i - , s@( I ( Rounded ( ℝ1 s_lo ) ) ( Rounded ( ℝ1 s_hi ) ) ) + , s@( 𝕀 ( ℝ1 s_lo ) ( ℝ1 s_hi ) ) , _, _ ) : cands ) toTry @@ -1195,37 +1193,37 @@ bisection minWidth eqs = bisect initialCands [] [] = let newToTry | t_hi - t_lo > s_hi - s_lo , let t_mid = 0.5 * ( t_lo + t_hi ) - = ( I ( Rounded ( ℝ1 t_lo ) ) ( Rounded ( ℝ1 t_mid ) ), i, s ) - : ( I ( Rounded ( ℝ1 t_mid ) ) ( Rounded ( ℝ1 t_hi ) ), i, s ) + = ( 𝕀 ( ℝ1 t_lo ) ( ℝ1 t_mid ), i, s ) + : ( 𝕀 ( ℝ1 t_mid ) ( ℝ1 t_hi ), i, s ) : toTry | let s_mid = 0.5 * ( s_lo + s_hi ) - = ( t, i, I ( Rounded ( ℝ1 s_lo ) ) ( Rounded ( ℝ1 s_mid ) ) ) - : ( t, i, I ( Rounded ( ℝ1 s_mid ) ) ( Rounded ( ℝ1 s_hi ) ) ) + = ( t, i, 𝕀 ( ℝ1 s_lo ) ( ℝ1 s_mid ) ) + : ( t, i, 𝕀 ( ℝ1 s_mid ) ( ℝ1 s_hi ) ) : toTry in bisect cands newToTry sols initialCands = getCands - ( I ( Rounded $ ℝ1 0 ) ( Rounded $ ℝ1 1 ) ) - ( I ( Rounded $ ℝ1 0 ) ( Rounded $ ℝ1 1 ) ) + ( 𝕀 ( ℝ1 0 ) ( ℝ1 1 ) ) + ( 𝕀 ( ℝ1 0 ) ( ℝ1 1 ) ) getCands t s = [ (t, i, s, ee, 𝛿E𝛿sdcdt ) | let !eqs_t = eqs t , ( eq_t, i ) <- zip ( toList eqs_t ) ( [0,1..] :: [Int] ) , let !( StrokeDatum { ee, 𝛿E𝛿sdcdt = T 𝛿E𝛿sdcdt } ) = eq_t s - , Interval.inf ee < 0 && Interval.sup ee > 0 - , cmpℝ2 (<) ( getRounded ( Interval.inf 𝛿E𝛿sdcdt ) ) ( ℝ2 0 0 ) - && cmpℝ2 (>) ( getRounded ( Interval.sup 𝛿E𝛿sdcdt ) ) ( ℝ2 0 0 ) + , Interval.inf ( ival ee ) < 0 && Interval.sup ( ival ee ) > 0 + , cmpℝ2 (<) ( getRounded ( Interval.inf $ ival 𝛿E𝛿sdcdt ) ) ( ℝ2 0 0 ) + && cmpℝ2 (>) ( getRounded ( Interval.sup $ ival 𝛿E𝛿sdcdt ) ) ( ℝ2 0 0 ) ] isCand :: 𝕀ℝ 1 -> Int -> 𝕀ℝ 1 -> Maybe ( 𝕀 Double, 𝕀ℝ 2 ) isCand t i s = case ( ( eqs t ) `Seq.index` i ) s of StrokeDatum { ee, 𝛿E𝛿sdcdt = T 𝛿E𝛿sdcdt } -> do guard $ - Interval.inf ee < 0 && Interval.sup ee > 0 - && cmpℝ2 (<) ( getRounded ( Interval.inf 𝛿E𝛿sdcdt ) ) ( ℝ2 0 0 ) - && cmpℝ2 (>) ( getRounded ( Interval.sup 𝛿E𝛿sdcdt ) ) ( ℝ2 0 0 ) + Interval.inf ( ival ee ) < 0 && Interval.sup ( ival ee ) > 0 + && cmpℝ2 (<) ( getRounded ( Interval.inf $ ival 𝛿E𝛿sdcdt ) ) ( ℝ2 0 0 ) + && cmpℝ2 (>) ( getRounded ( Interval.sup $ ival 𝛿E𝛿sdcdt ) ) ( ℝ2 0 0 ) return ( ee, 𝛿E𝛿sdcdt ) cmpℝ2 :: ( Double -> Double -> Bool ) -> ℝ 2 -> ℝ 2 -> Bool diff --git a/src/splines/Math/Interval.hs b/src/splines/Math/Interval.hs index 8265088..8d6e706 100644 --- a/src/splines/Math/Interval.hs +++ b/src/splines/Math/Interval.hs @@ -5,7 +5,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Math.Interval - ( 𝕀, 𝕀ℝ + ( 𝕀(..), 𝕀ℝ , Extent(..), type I , singleton, nonDecreasing ) @@ -32,18 +32,12 @@ import Data.Group import Data.Group.Generics ( ) --- rounded-hw -import Numeric.Rounded.Hardware - ( Rounded(..) ) -import Numeric.Rounded.Hardware.Interval.NonEmpty - ( Interval(..) ) - -- splines import Math.Algebra.Dual import Math.Algebra.Dual.Internal ( chainRuleQ ) import Math.Interval.Internal - ( type 𝕀 ) + ( 𝕀(..) ) import Math.Linear ( ℝ(..), T(..) , RepresentableQ(..) @@ -67,12 +61,11 @@ type family I i a where I 'Interval a = 𝕀 a singleton :: a -> 𝕀 a -singleton a = I ( Rounded a ) ( Rounded a ) +singleton a = 𝕀 a a -- | Turn a non-decreasing function into a function on intervals. nonDecreasing :: ( a -> b ) -> 𝕀 a -> 𝕀 b -nonDecreasing f ( I ( Rounded lo ) ( Rounded hi ) ) = - I ( Rounded $ f lo ) ( Rounded $ f hi ) +nonDecreasing f ( 𝕀 lo hi ) = 𝕀 ( f lo ) ( f hi ) deriving via ViaAbelianGroup ( T ( 𝕀 Double ) ) @@ -120,17 +113,17 @@ instance Module ( 𝕀 Double ) ( T ( 𝕀ℝ 4 ) ) where k *^ T a = T $$( tabulateQ \ i -> [|| unT $ k *^ T $$( indexQ [|| a ||] i ) ||] ) instance Inner ( 𝕀 Double ) ( T ( 𝕀ℝ 2 ) ) where - T ( I ( Rounded ( ℝ2 x1_lo y1_lo ) ) ( Rounded ( ℝ2 x1_hi y1_hi ) ) ) ^.^ - T ( I ( Rounded ( ℝ2 x2_lo y2_lo ) ) ( Rounded ( ℝ2 x2_hi y2_hi ) ) ) - = let !x1x2 = I ( Rounded x1_lo ) ( Rounded x1_hi ) * I ( Rounded x2_lo ) ( Rounded x2_hi ) - !y1y2 = I ( Rounded y1_lo ) ( Rounded y1_hi ) * I ( Rounded y2_lo ) ( Rounded y2_hi ) + T ( 𝕀 ( ℝ2 x1_lo y1_lo ) ( ℝ2 x1_hi y1_hi ) ) ^.^ + T ( 𝕀 ( ℝ2 x2_lo y2_lo ) ( ℝ2 x2_hi y2_hi ) ) + = let !x1x2 = 𝕀 x1_lo x1_hi * 𝕀 x2_lo x2_hi + !y1y2 = 𝕀 y1_lo y1_hi * 𝕀 y2_lo y2_hi in x1x2 + y1y2 instance Cross ( 𝕀 Double ) ( T ( 𝕀ℝ 2 ) ) where - T ( I ( Rounded ( ℝ2 x1_lo y1_lo ) ) ( Rounded ( ℝ2 x1_hi y1_hi ) ) ) `cross` - T ( I ( Rounded ( ℝ2 x2_lo y2_lo ) ) ( Rounded ( ℝ2 x2_hi y2_hi ) ) ) - = let !x1y2 = I ( Rounded x1_lo ) ( Rounded x1_hi ) * I ( Rounded y2_lo ) ( Rounded y2_hi ) - !y2x1 = I ( Rounded x2_lo ) ( Rounded x2_hi ) * I ( Rounded y1_lo ) ( Rounded y1_hi ) + T ( 𝕀 ( ℝ2 x1_lo y1_lo ) ( ℝ2 x1_hi y1_hi ) ) `cross` + T ( 𝕀 ( ℝ2 x2_lo y2_lo ) ( ℝ2 x2_hi y2_hi ) ) + = let !x1y2 = 𝕀 x1_lo x1_hi * 𝕀 y2_lo y2_hi + !y2x1 = 𝕀 x2_lo x2_hi * 𝕀 y1_lo y1_hi in x1y2 - y2x1 deriving via ViaModule ( 𝕀 Double ) ( T ( 𝕀ℝ n ) ) diff --git a/src/splines/Math/Interval/Internal.hs b/src/splines/Math/Interval/Internal.hs index 6b62fd3..1ab4b77 100644 --- a/src/splines/Math/Interval/Internal.hs +++ b/src/splines/Math/Interval/Internal.hs @@ -5,17 +5,23 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Math.Interval.Internal - ( type 𝕀 ) + ( 𝕀(.., 𝕀) ) where -- base +import Prelude hiding ( Num(..), Fractional(..), Floating(..), (^) ) +import qualified Prelude import Data.Monoid ( Sum(..) ) +import GHC.Show + ( showCommaSpace ) -- rounded-hw import Numeric.Rounded.Hardware ( Rounded(..) ) import Numeric.Rounded.Hardware.Interval.NonEmpty + ( Interval ) +import qualified Numeric.Rounded.Hardware.Interval.NonEmpty as Interval ( Interval(..) ) import qualified Numeric.Rounded.Hardware.Interval.NonEmpty as Interval ( sup, inf, powInt ) @@ -32,7 +38,19 @@ import Math.Ring -------------------------------------------------------------------------------- -- Intervals. -type 𝕀 = Interval +newtype 𝕀 a = MkI { ival :: Interval a } + deriving newtype ( Prelude.Num, Prelude.Fractional, Prelude.Floating ) + +{-# COMPLETE 𝕀 #-} +pattern 𝕀 :: a -> a -> 𝕀 a +pattern 𝕀 x y = MkI ( Interval.I ( Rounded x ) ( Rounded y ) ) +instance Show a => Show ( 𝕀 a ) where + showsPrec _ ( 𝕀 x y ) + = showString "[" + . showsPrec 0 x + . showCommaSpace + . showsPrec 0 y + . showString "]" deriving via ViaPrelude ( 𝕀 Double ) instance AbelianGroup ( 𝕀 Double ) @@ -40,8 +58,8 @@ deriving via ViaPrelude ( 𝕀 Double ) instance AbelianGroup ( T ( 𝕀 Double ) ) instance Ring ( 𝕀 Double ) where - (*) = (Prelude.*) - x ^ n = Interval.powInt x ( Prelude.fromIntegral n ) + MkI i1 * MkI i2 = MkI $ i1 Prelude.* i2 + MkI x ^ n = MkI $ Interval.powInt x ( Prelude.fromIntegral n ) -- This is very important, as x^2 is not the same as x * x -- in interval arithmetic. This ensures we don't -- accidentally use (^) from Prelude. @@ -55,28 +73,28 @@ deriving via ViaPrelude ( 𝕀 Double ) type instance RepDim ( 𝕀 u ) = RepDim u instance RepresentableQ r u => RepresentableQ ( 𝕀 r ) ( 𝕀 u ) where tabulateQ f = - let !lo = tabulateQ @r @u ( \ i -> [|| getRounded $ Interval.inf $$( f i ) ||] ) - !hi = tabulateQ @r @u ( \ i -> [|| getRounded $ Interval.sup $$( f i ) ||] ) - in [|| I ( Rounded $$lo ) ( Rounded $$hi ) ||] + let !lo = tabulateQ @r @u ( \ i -> [|| getRounded $ Interval.inf $ ival $$( f i ) ||] ) + !hi = tabulateQ @r @u ( \ i -> [|| getRounded $ Interval.sup $ ival $$( f i ) ||] ) + in [|| 𝕀 $$lo $$hi ||] indexQ d i = [|| case $$d of - I ( Rounded lo ) ( Rounded hi ) -> + 𝕀 lo hi -> let !lo_i = $$( indexQ @r @u [|| lo ||] i ) !hi_i = $$( indexQ @r @u [|| hi ||] i ) - in I ( Rounded lo_i ) ( Rounded hi_i ) + in 𝕀 lo_i hi_i ||] instance Representable r u => Representable ( 𝕀 r ) ( 𝕀 u ) where tabulate f = - let !lo = tabulate @r @u ( \ i -> getRounded $ Interval.inf ( f i ) ) - !hi = tabulate @r @u ( \ i -> getRounded $ Interval.sup ( f i ) ) - in I ( Rounded lo ) ( Rounded hi ) + let !lo = tabulate @r @u ( \ i -> getRounded $ Interval.inf $ ival ( f i ) ) + !hi = tabulate @r @u ( \ i -> getRounded $ Interval.sup $ ival ( f i ) ) + in 𝕀 lo hi index d i = case d of - I ( Rounded lo ) ( Rounded hi ) -> + 𝕀 lo hi -> let !lo_i = index @r @u lo i !hi_i = index @r @u hi i - in I ( Rounded lo_i ) ( Rounded hi_i ) + in 𝕀 lo_i hi_i deriving via Sum ( 𝕀 Double ) instance Module ( 𝕀 Double ) ( T ( 𝕀 Double ) ) diff --git a/src/splines/Math/Linear.hs b/src/splines/Math/Linear.hs index 3b6d1bb..07e28fa 100644 --- a/src/splines/Math/Linear.hs +++ b/src/splines/Math/Linear.hs @@ -9,7 +9,7 @@ module Math.Linear Segment(..), Mat22(..) -- * Points and vectors (second version) - , ℝ(..), T(.., V2, V3) + , ℝ(..), T(.., V2, V3, V4) , Fin(..), MFin(..) , RepDim, RepresentableQ(..) , Representable(..), injection, projection @@ -24,6 +24,8 @@ import Data.Kind ( Type ) import GHC.Generics ( Generic, Generic1, Generically(..), Generically1(..) ) +import GHC.Show + ( showSpace ) import GHC.TypeNats ( Nat, type (+) ) @@ -85,9 +87,14 @@ instance Act ( T Double ) Double where instance Torsor ( T Double ) Double where a --> b = T ( b - a ) ---instance {-# OVERLAPPING #-} Show ( ℝ n ) => Show ( T ( ℝ n ) ) where --- show ( T p ) = "V" ++ drop 1 ( show p ) -deriving stock instance Show v => Show ( T v ) +instance {-# OVERLAPPING #-} Show ( ℝ n ) => Show ( T ( ℝ n ) ) where + show ( T p ) = "V" ++ drop 1 ( show p ) +instance {-# INCOHERENT #-} Show v => Show ( T v ) where + showsPrec p ( T v ) + = showParen ( p >= 11 ) + $ showString "T" + . showSpace + . showsPrec 0 v instance Applicative T where pure = T @@ -96,13 +103,15 @@ instance Applicative T where {-# COMPLETE V2 #-} pattern V2 :: Double -> Double -> T ( ℝ 2 ) pattern V2 x y = T ( ℝ2 x y ) ---instance Show (T (ℝ 2)) where --- showsPrec i (T (ℝ2 x y)) = showsPrec i (V x y) {-# COMPLETE V3 #-} pattern V3 :: Double -> Double -> Double -> T ( ℝ 3 ) pattern V3 x y z = T ( ℝ3 x y z ) +{-# COMPLETE V4 #-} +pattern V4 :: Double -> Double -> Double -> Double -> T ( ℝ 4 ) +pattern V4 x y z w = T ( ℝ4 x y z w ) + -------------------------------------------------------------------------------- infixr 5 `VS` diff --git a/src/splines/Math/Linear/Internal.hs b/src/splines/Math/Linear/Internal.hs index fab9641..9d360fc 100644 --- a/src/splines/Math/Linear/Internal.hs +++ b/src/splines/Math/Linear/Internal.hs @@ -1,7 +1,6 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TemplateHaskell #-} - module Math.Linear.Internal ( ℝ(..) , Fin(..), MFin(..) @@ -14,8 +13,12 @@ module Math.Linear.Internal -- base import Data.Kind ( Type, Constraint ) +import Data.List + ( intersperse ) import GHC.Generics ( Generic ) +import GHC.Show + ( showSpace ) import GHC.TypeNats ( Nat ) @@ -38,19 +41,51 @@ data instance ℝ 0 = ℝ0 deriving anyclass NFData newtype instance ℝ 1 = ℝ1 { unℝ1 :: Double } deriving stock ( Generic ) - deriving newtype ( Show, Eq, Ord, NFData ) + deriving newtype ( Eq, Ord, NFData ) data instance ℝ 2 = ℝ2 { _ℝ2_x, _ℝ2_y :: {-# UNPACK #-} !Double } deriving stock Generic deriving anyclass NFData - deriving stock ( Show, Eq, Ord ) + deriving stock ( Eq, Ord ) data instance ℝ 3 = ℝ3 { _ℝ3_x, _ℝ3_y, _ℝ3_z :: {-# UNPACK #-} !Double } deriving stock Generic deriving anyclass NFData - deriving stock ( Show, Eq, Ord ) + deriving stock ( Eq, Ord ) data instance ℝ 4 = ℝ4 { _ℝ4_x, _ℝ4_y, _ℝ4_z, _ℝ4_w :: {-# UNPACK #-} !Double } deriving stock Generic deriving anyclass NFData - deriving stock ( Show, Eq, Ord ) + deriving stock ( Eq, Ord ) + +instance Show ( ℝ 1 ) where + showsPrec p ( ℝ1 x ) + = showParen ( p >= 11 ) + $ showString "ℝ1" + . foldr (.) id ( showSpace : intersperse showSpace coords ) + where + coords = map ( showsPrec 0 ) [ x ] + +instance Show ( ℝ 2 ) where + showsPrec p ( ℝ2 x y ) + = showParen ( p >= 11 ) + $ showString "ℝ2" + . foldr (.) id ( showSpace : intersperse showSpace coords ) + where + coords = map ( showsPrec 0 ) [ x, y ] + +instance Show ( ℝ 3 ) where + showsPrec p ( ℝ3 x y z ) + = showParen ( p >= 11 ) + $ showString "ℝ3" + . foldr (.) id ( showSpace : intersperse showSpace coords ) + where + coords = map ( showsPrec 0 ) [ x, y, z ] + +instance Show ( ℝ 4 ) where + showsPrec p ( ℝ4 x y z w ) + = showParen ( p >= 11 ) + $ showString "ℝ4" + . foldr (.) id ( showSpace : intersperse showSpace coords ) + where + coords = map ( showsPrec 0 ) [ x, y, z, w ] --------------------------------------------------------------------------------