improve show instances

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
+  location: https://github.com/chessai/eigen
-  tag: 747e4ce2145b436dd352814b71a68fc41fe63e6f
+  tag: 1790fdf9138970dde0dbabf8b270698145a4a88c
 
 -------------
 -- GHC 9.6 --

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
+                              { maxSubdiv  = 5 --2 --3 -- 6
-                              , nbSegments = 2 --3 --6 -- 12
+                              , nbSegments = 3 --3 --6 -- 12
                               , dist_tol   = 0.1 -- 5e-3
                               , t_tol      = 0.1 -- 1e-4
-                              , maxIters   = 1   -- 100
+                              , maxIters   = 5   -- 100
                               }
                             )
 

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 ) ) )
+  T ( 𝕀 ( MkR g_lo ) ( MkR g_hi ) )
-    • I ( Rounded ( MkR a_lo ) ) ( Rounded ( MkR a_hi ) )
+    • 𝕀 ( MkR a_lo ) ( MkR a_hi )
-      = case T ( I ( Rounded g_lo ) ( Rounded g_hi ) ) • I ( Rounded a_lo ) ( Rounded a_hi ) of
+      = case T ( 𝕀 g_lo g_hi ) • 𝕀 a_lo a_hi of
-          I ( Rounded b_lo ) ( Rounded b_hi ) ->
+          𝕀 b_lo b_hi ->
-            I ( Rounded ( MkR b_lo ) ) ( Rounded ( MkR 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 ) )
+  𝕀 ( MkR a_lo ) ( MkR a_hi )
-    --> I ( Rounded ( MkR b_lo ) ) ( Rounded ( MkR b_hi ) )
+    --> 𝕀 ( MkR b_lo ) ( MkR b_hi )
-      = case I ( Rounded a_lo ) ( Rounded a_hi ) --> I ( Rounded b_lo ) ( Rounded b_hi ) of
+      = case 𝕀 a_lo a_hi --> 𝕀 b_lo b_hi of
-          T ( I ( Rounded c_lo ) ( Rounded c_hi ) ) ->
+          T ( 𝕀 c_lo c_hi ) ->
-            T ( I ( Rounded ( MkR c_lo ) ) ( Rounded ( MkR c_hi ) ) )
+            T ( 𝕀 ( MkR c_lo ) ( MkR c_hi ) )
 
 type instance RepDim ( Record ks ) = Length ks
 deriving newtype

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
+  in trace
-     --    ( unlines $
+         ( unlines $
-     --      ( "bisectionMethod: #(possible zeroes) = " ++ show ( length bisSols ) ) :
+           ( "bisectionMethod: #(possible zeroes) = " ++ show ( length bisSols ) ) :
-     --      "" :
+           "" :
-     --      map show 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 )
+             =   ( 𝕀 ( ℝ1 t_lo  ) ( ℝ1 t_mid ), i, s )
-               : ( I ( Rounded ( ℝ1 t_mid ) ) ( Rounded ( ℝ1 t_hi  ) ), 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, 𝕀 ( ℝ1 s_lo  ) ( ℝ1 s_mid ) )
-               : ( t, i, I ( Rounded ( ℝ1 s_mid ) ) ( Rounded ( ℝ1 s_hi  ) ) )
+               : ( t, i, 𝕀 ( ℝ1 s_mid ) ( ℝ1 s_hi  ) )
                : toTry
         in bisect cands newToTry sols
 
     initialCands =
       getCands
-        ( I ( Rounded $ ℝ1 0 ) ( Rounded $ ℝ1 1 ) )
+        ( 𝕀 ( ℝ1 0 ) ( ℝ1 1 ) )
-        ( I ( Rounded $ ℝ1 0 ) ( Rounded $ ℝ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
+      , Interval.inf ( ival ee ) < 0 && Interval.sup ( ival ee ) > 0
-      ,    cmpℝ2 (<) ( getRounded ( Interval.inf 𝛿E𝛿sdcdt ) ) ( ℝ2 0 0 )
+      ,    cmpℝ2 (<) ( getRounded ( Interval.inf $ ival 𝛿E𝛿sdcdt ) ) ( ℝ2 0 0 )
-        && cmpℝ2 (>) ( getRounded ( Interval.sup 𝛿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
+              Interval.inf ( ival ee ) < 0 && Interval.sup ( ival ee ) > 0
-              && cmpℝ2 (<) ( getRounded ( Interval.inf 𝛿E𝛿sdcdt ) ) ( ℝ2 0 0 )
+              && cmpℝ2 (<) ( getRounded ( Interval.inf $ ival 𝛿E𝛿sdcdt ) ) ( ℝ2 0 0 )
-              && cmpℝ2 (>) ( getRounded ( Interval.sup 𝛿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

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 ) ) =
+nonDecreasing f ( 𝕀 lo hi ) = 𝕀 ( f lo ) ( f hi )
-  I ( Rounded $ f lo ) ( Rounded $ 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 ( 𝕀 ( ℝ2 x1_lo y1_lo ) ( ℝ2 x1_hi y1_hi ) )  ^.^
-    T ( I ( Rounded ( ℝ2 x2_lo y2_lo ) ) ( Rounded ( ℝ2 x2_hi y2_hi ) ) )
+    T ( 𝕀 ( ℝ2 x2_lo y2_lo ) ( ℝ2 x2_hi y2_hi ) )
-      = let !x1x2 = I ( Rounded x1_lo ) ( Rounded x1_hi ) * I ( Rounded x2_lo ) ( Rounded x2_hi )
+      = let !x1x2 = 𝕀 x1_lo x1_hi * 𝕀 x2_lo x2_hi
-            !y1y2 = I ( Rounded y1_lo ) ( Rounded y1_hi ) * I ( Rounded y2_lo ) ( Rounded y2_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 ( 𝕀 ( ℝ2 x1_lo y1_lo ) ( ℝ2 x1_hi y1_hi ) ) `cross`
-    T ( I ( Rounded ( ℝ2 x2_lo y2_lo ) ) ( Rounded ( ℝ2 x2_hi y2_hi ) ) )
+    T ( 𝕀 ( ℝ2 x2_lo y2_lo ) ( ℝ2 x2_hi y2_hi ) )
-      = let !x1y2 = I ( Rounded x1_lo ) ( Rounded x1_hi ) * I ( Rounded y2_lo ) ( Rounded y2_hi )
+      = let !x1y2 = 𝕀 x1_lo x1_hi * 𝕀 y2_lo y2_hi
-            !y2x1 = I ( Rounded x2_lo ) ( Rounded x2_hi ) * I ( Rounded y1_lo ) ( Rounded y1_hi )
+            !y2x1 = 𝕀 x2_lo x2_hi * 𝕀 y1_lo y1_hi
         in x1y2 - y2x1
 
 deriving via ViaModule ( 𝕀 Double ) ( T ( 𝕀ℝ n ) )

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.*)
+  MkI i1 * MkI i2 = MkI $ i1 Prelude.* i2
-  x ^ n = Interval.powInt x ( Prelude.fromIntegral n )
+  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 ) ||] )
+    let !lo = tabulateQ @r @u ( \ i -> [|| getRounded $ Interval.inf $ ival $$( f i ) ||] )
-        !hi = tabulateQ @r @u ( \ i -> [|| getRounded $ Interval.sup $$( f i ) ||] )
+        !hi = tabulateQ @r @u ( \ i -> [|| getRounded $ Interval.sup $ ival $$( f i ) ||] )
-    in [|| I ( Rounded $$lo ) ( Rounded $$hi ) ||]
+    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 ) )
+    let !lo = tabulate @r @u ( \ i -> getRounded $ Interval.inf $ ival ( f i ) )
-        !hi = tabulate @r @u ( \ i -> getRounded $ Interval.sup ( f i ) )
+        !hi = tabulate @r @u ( \ i -> getRounded $ Interval.sup $ ival ( f i ) )
-    in I ( Rounded lo ) ( Rounded hi )
+    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 ) )

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
+instance {-# OVERLAPPING #-} Show ( ℝ n ) => Show ( T ( ℝ n ) ) where
---  show ( T p ) = "V" ++ drop 1 ( show p )
+  show ( T p ) = "V" ++ drop 1 ( show p )
-deriving stock instance Show v => Show ( T v )
+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`

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 ]
 
 --------------------------------------------------------------------------------