I am not quite sure what this ZInt is actually describing.
data Nat = Zero | S Nat
data ZInt = Z Nat Nat deriving Show
addZ :: ZInt -> ZInt -> ZInt
addZ (Z a b) (Z c d) = Z (add a c) (add b d)
with
add :: Nat -> Nat -> Nat
add a Zero = a
add a (S b) = S (add a b)
mult :: Nat -> Nat -> Nat
mult _ Zero = Zero
mult a (S b) = add a (mult a b)
At first glance i thought maybe it's a presentation of complex numbers, adding imaginary and real components (in function addZ) without displaying form of
a+b*i
But what is happening in this functions?
subZ :: ZInt -> ZInt -> ZInt
subZ (Z a b) (Z c d) = Z (add a d) (add b c)
multZ :: ZInt -> ZInt -> ZInt
multZ (Z a b) (Z c d) = Z (add (mult a d) (mult c b)) (add (mult a c) (mult b d))
So I do understand data Nat = Zero | S Nat and also the add and mult functions, but not addZ, subZ and multZ.
It's just integer numbers. Nat represents a natural number. ZInt represents an integer number. In Z a b if a >= b then integer is a - b else -(b - a).
For example:
ZInt representation | Traditional representation
Z Zero Zero | 0
Z (S Zero) Zero | 1
Z Zero (S Zero) | -1
Z (S Zero) (S Zero) | 0
...
As we can see, to negate an integer you just swap the Nat values in its representation:
negate :: ZInt -> ZInt
negate (Z n m) = Z m n
And we can define subZ like this:
a `subZ` b = a `addZ` negate b
This representation is not canonical, Z (S Zero) (S Zero) is the same integer as Z Zero Zero. So, we can define canonical form like this:
canonical :: ZInt -> ZInt
canonical (Z (S n) (S m)) = canonical (Z n m)
canonical x = x
What reason is to define integer numbers by this way?
First of all, it mathematically clear. If someone defined the set of natural number named N the we can easy define the set of integers named Z as Z = N * N where (*) is product of two sets.
In Haskell, I can see only one reason for that. By this way we can define integer numbers on type level.
First, ZInt is representing each integer as an ordered pair of natural numbers. #freestyle covers how this representation works well; I will just expand on how the arithmetic operators take advantage of this encoding.
addZ, subZ and multZ are simply manipulating the pair of natural numbers that represent each integer.
addZ (Z a b) (Z c d) = Z (add a c) (add b d)
(a - b) + (c - d) == a - b + c - d
== a + c - b - d
== (a + c) - (b + d)
subZ (Z a b) (Z c d) = Z (add a d) (add b c)
(a - b) - (c - d) == a - b - c + d
== a + d - b - c
== (a + d) - (b + c)
multZ (Z a b) (Z c d) = Z (add (mult a d) (mult c b)) (add (mult a c) (mult b d))
(a - b) * (c - d) == ac - ad - bc + bd
== ac + bd - ad - bc
== (ac + bd) - (ad + bc)
Note that the given definition of multZ can get the sign wrong; it should be
multZ (Z a b) (Z c d) = Z (add (mult a c) (mult b d)) (add (mult a d) (mult b c))
(For clarity, it should also use mult b c instead of mult c b, even though multiplication of natural numbers is commutative.)
Related
I am trying to implement my code based almost directly on a paper (pages 34-35). I am using Haskell's Num class instead of the user-defined Number class suggested in the paper.
I want to focus on implementing addition over dynamic time-varying Float values, and subsequently addition over time-varying Points.
Listing 1 is my attempt. How do I get addition of points with time-varying coordinates to work properly? My research requires a review of the code in that particular paper. As far as it is practical, I need to stick to the structure of the original code in the paper. In other words, what
do I need to add to Listing 1 to overload (+) from Num to perform addition on time varying points?
module T where
type Time = Float
type Moving v = Time -> v
instance Num v => Num (Moving v) where
(+) a b = \t -> (a t) + (b t)
(-) a b = \t -> (a t) - (b t)
(*) a b = \t -> (a t) * (b t)
-- tests for time varying Float values, seems OK
a,b::(Moving Float)
a = (\t -> 4.0)
b = (\t -> 5.0)
testA = a 1.0
testAddMV1 = (a + b ) 1.0
testAddMV2 = (a + b ) 2.0
-- Point Class
class Num s => Points p s where
x, y :: p s -> s
xy :: s -> s -> p s
data Point f = Point f f deriving Show
instance Num v => Points Point v where
x (Point x1 y1) = x1
y (Point x1 y1) = y1
xy x1 y1 = Point x1 y1
instance Num v => Num (Point (Moving v)) where
(+) a b = xy (x a + x b) (y a + y b)
(-) a b = xy (x a - x b) (y a - y b)
(*) a b = xy (x a * x b) (y a * y b)
-- Cannot get this to work as suggested in paper.
np1, np2 :: Point (Moving Float)
np1 = xy (\t -> 4.0 + 0.5 * t) (\t -> 4.0 - 0.5 * t)
np2 = xy (\t -> 0.0 + 1.0 * t) (\t -> 0.0 - 1.0 * t)
-- Error
-- testAddMP1 = (np1 + np2 ) 1.0
-- * Couldn't match expected type `Double -> t'
-- with actual type `Point (Moving Float)'
The error isn't really about the addition operation. You also can't write np1 1.0 because this is a vector (I don't particularly like calling it that) whose components are functions. Whereas you try to use it as a function whose values are vectors.
What you're trying to express here is, "evaluate both the component-functions at this time-slice, and give me back the point corresponding to both coordinates". The standard solution (which I don't recommend, though) is to give Point a Functor instance. This is something the compiler can do for you:
{-# LANGUAGE DeriveFunctor #-}
data Point f = Point f f
deriving (Show, Functor)
And then you can write e.g.
fmap ($1) (np1 + np2)
Various libraries have special operators for this, e.g.
import Control.Lens ((??))
np1 + np2 ?? 1
Why is a functor instance a bad idea? For the same reason it's a bad idea to implement multiplication on points as component-wise multiplication†: it does not make sense physically. Namely, it depends on a particular choice of coordinate system, but the choice of coordinate frame is in principle arbitrary and should not affect the results. For addition it indeed does not affect the result (disregarding float inaccuracy), but for multiplication or arbitrary function-mapping it can massively affect the result.
A better solution is to just not use "function-valued points" in the first place, but instead point-valued functions.
np1, np2 :: Moving (Point Float)
np1 = \t -> xy (4.0 + 0.5 * t) (4.0 - 0.5 * t)
np2 t = xy (0.0 + 1.0 * t) (0.0 - 1.0 * t)
†Actually a functor instance is a less bad idea than a Num instance. The particular operation fmap ($1) is in fact equivariant under coordinate transformation. That's because point-evaluation of functions is a linear mapping. To properly express this, you could make Point an endofunctor in the category of linear maps.
I include a renaming approach in Listing 2 and a qualified import approach in Listing 3 .
Listing 2 contains code that I believe is reasonably close to the original code. It was necessary rename the operations in Number by appending (!). This avoids a clash with the operations in Prelude Num class. I believe that there were two errors in the original code. The most serious is in the instance Number (Moving Float) where the same operation symbols are used on the left and right of the equations (e.g. +). The compiler has no way to distinguish these operations. The other error is a syntax error instance Number v => (Point v) there is no class name after =>. In sort the original code will not run, which was the motivation behind the question.
Listing 2
module T where
type Time = Float
type Moving v = Time -> v
class Number a where
(+!), (-!), (*!) :: a -> a -> a
sqr1, sqrt1 :: a -> a
-- Define Number operations in terms of Num operations from Prelude
-- Original code does not distinguish between these operation and will not compile.
instance Number (Moving Float) where
(+!) a b = \t -> (a t) + (b t)
(-!) a b = \t -> (a t) - (b t)
(*!) a b = \t -> (a t) * (b t)
sqrt1 a = \t -> sqrt (a t)
sqr1 a = \t -> ((a t) * (a t))
data Point f = Point f f deriving Show
class Number s => Points p s where
x, y :: p s -> s
xy :: s -> s -> p s
dist :: p s -> p s -> s
dist a b = sqrt1 (sqr1 ((x a) -! (x b)) +! sqr1 ((y a) -! (y b)))
instance Number v => Points Point v where
x (Point x1 y1) = x1
y (Point x1 y1) = y1
xy x1 y1 = Point x1 y1
-- Syntax error in instance header in original code.
instance Number (Point (Moving Float)) where
(+!) a b = xy (x a +! x b) (y a +! y b)
(-!) a b = xy (x a -! x b) (y a -! y b)
(*!) a b = xy (x a *! x b) (y a *! y b)
sqrt1 a = xy (sqrt1 (x a)) (sqrt1 (y a))
sqr1 a = xy (sqr1 (x a)) (sqr1 (y a))
mp1, mp2 :: Point (Moving Float)
mp1 = (xy (\t -> 4.0 + 0.5 * t) (\t -> 4.0 - 0.5 * t))
mp2 = xy (\t -> 0.0 + 1.0 * t) (\t -> 0.0 - 1.0 * t)
movingDist_1_2 = dist mp1 mp2
dist_at_2 = movingDist_1_2 2.0 -- gives 5.83
Listing 3 uses a qualified import as suggested by ben. Note we need an additional instance to define the operations in the Number class using the Num class.
Listing 3
module T where
import qualified Prelude as P
type Time = P.Float
type Moving v = Time -> v
class Number a where
(+), (-), (*) :: a -> a -> a
sqr, sqrt:: a -> a
instance Number P.Float where
(+) a b = a P.+ b
(-) a b = a P.- b
(*) a b = a P.* b
sqrt a = P.sqrt a
sqr a = a P.* a
instance Number (Moving P.Float) where
(+) a b = \t -> (a t) + (b t)
(-) a b = \t -> (a t) - (b t)
(*) a b = \t -> (a t) * (b t)
sqrt a = \t -> sqrt (a t)
sqr a = \t -> ((a t) * (a t))
data Point f = Point f f deriving P.Show
class Number s => Points p s where
x, y :: p s -> s
xy :: s -> s -> p s
dist :: p s -> p s -> s
dist a b = sqrt (sqr ((x a) - (x b)) + sqr ((y a) - (y b)))
instance Number v => Points Point v where
x (Point x1 y1) = x1
y (Point x1 y1) = y1
xy x1 y1 = Point x1 y1
instance Number (Point (Moving P.Float)) where
(+) a b = xy (x a + x b) (y a + y b)
(-) a b = xy (x a - x b) (y a - y b)
(*) a b = xy (x a * x b) (y a * y b)
sqrt a = xy (sqrt (x a)) (sqrt (y a))
sqr a = xy (sqr (x a)) (sqr (y a))
mp1, mp2 :: Point (Moving P.Float)
mp1 = xy (\t -> 4.0 + (0.5 * t)) (\t -> 4.0 - (0.5 * t))
mp2 = xy (\t -> 0.0 + (1.0 * t)) (\t -> 0.0 - (1.0 * t))
movingDist_1_2 = dist mp1 mp2
dist_at_2 = movingDist_1_2 2.0
Given binary natural numbers, with a zero case a "twice" case and a "twice plus one" case. How can one express addition using primitive recursion (using only the function foldBNat)?
-- zero | n * 2 | n * 2 + 1
data BNat = Z | T BNat | TI BNat
deriving (Show)
foldBNat :: BNat -> t -> (BNat -> t -> t) -> (BNat -> t -> t) -> t
foldBNat n z t ti =
case n of
Z -> z
T m -> t m (foldBNat m z t ti)
TI m -> ti m (foldBNat m z t ti)
div2 :: BNat -> BNat
div2 n = foldBNat n Z (\m _ -> m) (\m _ -> m)
pred :: BNat -> BNat
pred n = foldBNat n Z (\_ r -> TI r) (\m _ -> T m)
succ :: BNat -> BNat
succ n = foldBNat n (TI Z) (\m _ -> TI m) (\_ r -> T r)
Idea: To compute a + b, we need to increment b a times. So:
0 + b = b
1 + b = succ b
2 + b = succ (succ b)
3 + b = succ (succ (succ b))
...
We might start out by writing
plus a b = foldBNat a b (\m r -> ...
But here we get stuck: m represents half of a (since a = T m here, i.e. a = 2 * m) and r is the result of incrementing b m times (i.e. m + b). There's nothing useful we can do with that. What we want is a + b = 2*m + b, which we can't directly obtain from m + b. Applying T would only give us 2 * (m + b) = 2*m + 2*b, which is too big, and according to the rules we can't directly recurse on plus to compute m + (m + b) = 2*m + b.
What we need is a more direct way of manipulating the number of succ operations.
Idea: Don't compute a number directly; instead compute a function (that increments its argument a certain number of times). So:
incBy 0 = id
incBy 1 = succ
incBy 2 = succ . succ
incBy 3 = succ . succ . succ
...
We can implement that directly:
incBy :: BNat -> (BNat -> BNat)
incBy n = foldBNat n id (\_ r -> r . r) (\_ r -> succ . r . r)
Here r . r gives us a function that increments a number twice as often as r does (by applying r twice).
Now we can simply define addition as:
plus :: BNat -> BNat -> BNat
plus n m = (incBy n) m
(which happens to be redundant because plus = incBy).
I'm having a problem with defining mult on Nats in Haskell.
mult :: Nat -> Nat -> Nat
mult Z m = Z
mult m Z = Z
mult (S m)(S n) = S (mult m n)
two = S (S Z)
three = S (S (S Z))
I get these results:
> mult Z three
Z
> mult two three
S (S Z)
> mult three three
S (S (S Z))
Which part is causing the problem here?
Solved.
Nat : Natural
Z : Zero
mult : multiply
mult :: Nat -> Nat -> Nat
mult Z m = Z -------- 0*m = 0
mult (S n) m = plus m (mult n m) -------- (n+1)*m = m+nm
> mult Z three
Z
> mult two three
S (S (S (S (S (S Z)))))
> mult three three
S (S (S (S (S (S (S (S (S Z))))))))
my cell was having problem with equation
mult (S m)(S n) = S (mult m n)
it was incorrect equation same as (1+m)(1+n) = 1 + mn
so i changed equation as
mult (S n) m = plus m (mult n m) --- (n+1)*m = m+nm
Thanks for who answered my question. I finished easily thanks to your help.
Let's think about this more carefully. Instead of pattern matching on both sides, let's just do one. So:
mult :: Nat -> Nat -> Nat
mult Z m = -- TODO: 0 * m = ???
mult (S n) m = -- TODO: (1 + n) * m = ???
Let's start with 0 * m, which is obviously 0:
mult Z m = Z
Now for (1 + n) * m. From simple algebra, this is m + n*m. So, assuming you've already made a plus function somewhere, this is easy:
mult (S n) m = plus m (mult n m)
Note that an implementation of plus is a requirement for this. If you understand this, try re-writing mult by pattern matching on both sides.
Suppose there are some data types to express lambda and combinatorial terms:
data Lam α = Var α -- v
| Abs α (Lam α) -- λv . e1
| App (Lam α) (Lam α) -- e1 e2
deriving (Eq, Show)
infixl 0 :#
data SKI α = V α -- x
| SKI α :# SKI α -- e1 e2
| I -- I
| K -- K
| S -- S
deriving (Eq, Show)
There is also a function to get a list of lambda term's free variables:
fv ∷ Eq α ⇒ Lam α → [α]
fv (Var v) = [v]
fv (Abs x e) = filter (/= x) $ fv e
fv (App e1 e2) = fv e1 ++ fv e2
To convert lambda term to combinatorial term abstract elimination rules could be usefull:
convert ∷ Eq α ⇒ Lam α → SKI α
1) T[x] => x
convert (Var x) = V x
2) T[(E₁ E₂)] => (T[E₁] T[E₂])
convert (App e1 e2) = (convert e1) :# (convert e2)
3) T[λx.E] => (K T[E]) (if x does not occur free in E)
convert (Abs x e) | x `notElem` fv e = K :# (convert e)
4) T[λx.x] => I
convert (Abs x (Var y)) = if x == y then I else K :# V y
5) T[λx.λy.E] => T[λx.T[λy.E]] (if x occurs free in E)
convert (Abs x (Abs y e)) | x `elem` fv e = convert (Abs x (convert (Abs y e)))
6) T[λx.(E₁ E₂)] => (S T[λx.E₁] T[λx.E₂])
convert (Abs x (App y z)) = S :# (convert (Abs x y)) :# (convert (Abs x z))
convert _ = error ":["
This definition is not valid because of 5):
Couldn't match expected type `Lam α' with actual type `SKI α'
In the return type of a call of `convert'
In the second argument of `Abs', namely `(convert (Abs y e))'
In the first argument of `convert', namely
`(Abs x (convert (Abs y e)))'
So, what I have now is:
> convert $ Abs "x" $ Abs "y" $ App (Var "y") (Var "x")
*** Exception: :[
What I want is (hope I calculate it right):
> convert $ Abs "x" $ Abs "y" $ App (Var "y") (Var "x")
S :# (S (KS) (S (KK) I)) (S (KK) I)
Question:
If lambda term and combinatorial term have a different types of expression, how 5) could be formulated right?
Let's consider the equation T[λx.λy.E] => T[λx.T[λy.E]].
We know the result of T[λy.E] is an SKI expression. Since it has been produced by one of the cases 3, 4 or 6, it is either I or an application (:#).
Thus the outer T in T[λx.T[λy.E]] must be one of the cases 3 or 6. You can perform this case analysis in the code. I'm sorry but I don't have the time to write it out.
Here it's better to have a common data type for combinators and lambda expressions. Notice that your types already have significant overlap (Var, App), and it doesn't hurt to have combinators in lambda expressions.
The only possibility we want to eliminate is having lambda abstractions in combinator terms. We can forbid them using indexed types.
In the following code the type of a term is parameterised by the number of nested lambda abstractions in that term. The convert function returns Term Z a, where Z means zero, so there are no lambda abstractions in the returned term.
For more information about singleton types (which are used a bit here), see the paper Dependently Typed Programming with Singletons.
{-# LANGUAGE DataKinds, KindSignatures, TypeFamilies, GADTs, TypeOperators,
ScopedTypeVariables, MultiParamTypeClasses, FlexibleInstances #-}
data Nat = Z | Inc Nat
data SNat :: Nat -> * where
SZ :: SNat Z
SInc :: NatSingleton n => SNat n -> SNat (Inc n)
class NatSingleton (a :: Nat) where
sing :: SNat a
instance NatSingleton Z where sing = SZ
instance NatSingleton a => NatSingleton (Inc a) where sing = SInc sing
type family Max (a :: Nat) (b :: Nat) :: Nat
type instance Max Z a = a
type instance Max a Z = a
type instance Max (Inc a) (Inc b) = Inc (Max a b)
data Term (l :: Nat) a where
Var :: a -> Term Z a
Abs :: NatSingleton l => a -> Term l a -> Term (Inc l) a
App :: (NatSingleton l1, NatSingleton l2)
=> Term l1 a -> Term l2 a -> Term (Max l1 l2) a
I :: Term Z a
K :: Term Z a
S :: Term Z a
fv :: Eq a => Term l a -> [a]
fv (Var v) = [v]
fv (Abs x e) = filter (/= x) $ fv e
fv (App e1 e2) = fv e1 ++ fv e2
fv _ = []
eliminateLambda :: (Eq a, NatSingleton l) => Term (Inc l) a -> Term l a
eliminateLambda t =
case t of
Abs x t ->
case t of
Var y
| y == x -> I
| otherwise -> App K (Var y)
Abs {} -> Abs x $ eliminateLambda t
App a b -> S `App` (eliminateLambda $ Abs x a)
`App` (eliminateLambda $ Abs x b)
App a b -> eliminateLambdaApp a b
eliminateLambdaApp
:: forall a l1 l2 l .
(Eq a, Max l1 l2 ~ Inc l,
NatSingleton l1,
NatSingleton l2)
=> Term l1 a -> Term l2 a -> Term l a
eliminateLambdaApp a b =
case (sing :: SNat l1, sing :: SNat l2) of
(SInc _, SZ ) -> App (eliminateLambda a) b
(SZ , SInc _) -> App a (eliminateLambda b)
(SInc _, SInc _) -> App (eliminateLambda a) (eliminateLambda b)
convert :: forall a l . Eq a => NatSingleton l => Term l a -> Term Z a
convert t =
case sing :: SNat l of
SZ -> t
SInc _ -> convert $ eliminateLambda t
The key insight is that S, K and I are just constant Lam terms, in the same way that 1, 2 and 3 are constant Ints. It would be pretty easy to make rule 5 type-check by making an inverse to the 'convert' function:
nvert :: SKI a -> Lam a
nvert S = Abs "x" (Abs "y" (Abs "z" (App (App (Var "x") (Var "z")) (App (Var "y") (Var "z")))))
nvert K = Abs "x" (Abs "y" (Var "x"))
nvert I = Abs "x" (Var "x")
nvert (V x) = Var x
nvert (x :# y) = App (nvert x) (nvert y)
Now we can use 'nvert' to make rule 5 type-check:
convert (Abs x (Abs y e)) | x `elem` fv e = convert (Abs x (nvert (convert (Abs y e))))
We can see that the left and the right are identical (we'll ignore the guard), except that 'Abs y e' on the left is replaced by 'nvert (convert (Abs y e))' on the right. Since 'convert' and 'nvert' are each others' inverse, we can always replace any Lam 'x' with 'nvert (convert x)' and likewise we can always replace any SKI 'x' with 'convert (nvert x)', so this is a valid equation.
Unfortunately, while it's a valid equation it's not a useful function definition because it won't cause the computation to progress: we'll just convert 'Abs y e' back and forth forever!
To break this loop we can replace the call to 'nvert' with a 'reminder' that we should do it later. We do this by adding a new constructor to Lam:
data Lam a = Var a -- v
| Abs a (Lam a) -- \v . e1
| App (Lam a) (Lam a) -- e1 e2
| Com (SKI a) -- Reminder to COMe back later and nvert
deriving (Eq, Show)
Now rule 5 uses this reminder instead of 'nvert':
convert (Abs x (Abs y e)) | x `elem` fv e = convert (Abs x (Com (convert (Abs y e))))
Now we need to make good our promise to come back, by making a separate rule to replace reminders with actual calls to 'nvert', like this:
convert (Com c) = convert (nvert c)
Now we can finally break the loop: we know that 'convert (nvert c)' is always identical to 'c', so we can replace the above line with this:
convert (Com c) = c
Notice that our final definition of 'convert' doesn't actually use 'nvert' at all! It's still a handy function though, since other functions involving Lam can use it to handle the new 'Com' case.
You've probably noticed that I've actually named this constructor 'Com' because it's just a wrapped-up COMbinator, but I thought it would be more informative to take a slightly longer route than just saying "wrap up your SKIs in Lams" :)
If you're wondering why I called that function "nvert", see http://unapologetic.wordpress.com/2007/05/31/duality-terminology/ :)
Warbo is right, combinators are constant lambda terms, consequently the conversion function is
T[ ]:L -> C with L the set of lambda terms and C that of combinatory terms and with C ⊂ L .
So there is no typing problem for the rule T[λx.λy.E] => T[λx.T[λy.E]]
Here an implementation in Scala.
For example I want to make a type MyType of integer triples. But not just Cartesian product of three Integer, I want the type to represent all (x, y, z) such that x + y + z = 5.
How do I do that? Except of using just (x, y) since z = 5 - x - y.
And the same question if I have three constructors A, B, C and the type should be all (A x, B y, C z) such that x + y + z = 5.
I think the trick here is that you don't enforce it on the type-level, you use "smart constructors": i.e. only allow creation of such "tuples" via a function that generates such values:
module Test(MyType,x,y,z,createMyType) where
data MyType = MT { x :: Int, y :: Int, z :: Int }
createMyType :: Int -> Int -> MyType
createMyType myX myY = MT { x = myX, y = myY, z = 5 - myX - myY }
If you want to generate all possible such values, then you can write a function to do so, either with provided or specified bounds.
It may very well be possible to use type-level Church Numerals or some such so as to enforce creation of these, but it's almost definitely too much work for what you probably want/need.
This might not be what you want (i.e. "Except of using just (x, y) since z = 5 - x - y") but it makes more sense than trying to have some kind of enforced restriction on the type level for allowing valid values.
Types can ensure the correct "type" of value (no pun intended); to ensure validity of values you hide the constructor and only allow creation via approved functions that guarantee any invariants you require.
Yes, smart constructors or Agda are the way to go here, but if you really wanted to go crazy with the "dependent" approach, in Haskell:
{-# LANGUAGE GADTs, TypeFamilies, RankNTypes, StandaloneDeriving, UndecidableInstances, TypeOperators #-}
data Z = Z
data S n = S n
data Nat n where
Zero :: Nat Z
Suc :: Nat n -> Nat (S n)
deriving instance Show (Nat n)
type family (:+) a b :: *
type instance (:+) Z b = b
type instance (:+) (S a) b = S (a :+ b)
plus :: Nat x -> Nat y -> Nat (x :+ y)
plus Zero y = y
plus (Suc x) y = Suc (x `plus` y)
type family (:*) a b :: *
type instance (:*) Z b = Z
type instance (:*) (S a) b = b :+ (a :* b)
times :: Nat x -> Nat y -> Nat (x :* y)
times Zero y = Zero
times (Suc x) y = y `plus` (x `times` y)
data (:==) a b where
Refl :: a :== a
deriving instance Show (a :== b)
cong :: a :== b -> f a :== f b
cong Refl = Refl
data Triple where
Triple :: Nat x -> Nat y -> Nat z -> (z :== (x :+ y)) -> Triple
deriving instance Show Triple
-- Half a decision procedure
equal :: Nat x -> Nat y -> Maybe (x :== y)
equal Zero Zero = Just Refl
equal (Suc x) Zero = Nothing
equal Zero (Suc y) = Nothing
equal (Suc x) (Suc y) = cong `fmap` equal x y
triple' :: Nat x -> Nat y -> Nat z -> Maybe Triple
triple' x y z = fmap (Triple x y z) $ equal z (x `plus` y)
toNat :: (forall n. Nat n -> r) -> Integer -> r
toNat f n | n < 0 = error "why can't we have a natural type?"
toNat f 0 = f Zero
toNat f n = toNat (f . Suc) (n - 1)
triple :: Integer -> Integer -> Integer -> Maybe Triple
triple x y z = toNat (\x' -> toNat (\y' -> toNat (\z' -> triple' x' y' z') z) y) x
data Yatima where
Yatima :: Nat x -> Nat y -> Nat z -> ((x :* x) :+ (y :* y) :+ (z :* z) :== S (S (S (S (S Z))))) -> Yatima
deriving instance Show Yatima
yatima' :: Nat x -> Nat y -> Nat z -> Maybe Yatima
yatima' x y z =
fmap (Yatima x y z) $ equal ((x `times` x) `plus` (y `times` y) `plus` (z `times` z)) (Suc (Suc (Suc (Suc (Suc Zero)))))
yatima :: Integer -> Integer -> Integer -> Maybe Yatima
yatima x y z = toNat (\x' -> toNat (\y' -> toNat (\z' -> yatima' x' y' z') z) y) x
{-
λ> triple 3 4 5
Nothing
λ> triple 3 4 7
Just (Triple (Suc (Suc (Suc Zero))) (Suc (Suc (Suc (Suc Zero)))) Refl (Suc (Suc (Suc (Suc (Suc (Suc (Suc Zero))))))))
λ> yatima 0 1 2
Just (Yatima Zero (Suc Zero) (Suc (Suc Zero)) Refl)
λ> yatima 1 1 2
Nothing
-}
And bam, you have a statically checked invariant in your code! Except you can lie...
The normal dependently-typed way to do this would be to use a sigma (dependent product) type, for example in Agda:
open import Relation.Binary.PropositionalEquality (_≡_)
open import Data.Nat (ℕ; _+_)
open import Data.Product (Σ; ×; _,_)
FiveTriple : Set
FiveTriple = Σ (ℕ × ℕ × ℕ) (λ{ (x , y , z) → x + y + z ≡ 5 })
someFiveTriple : FiveTriple
someFiveTriple = (0 , 2 , 5) , refl
This is why Σ is often called an ‘existential’ type: it allows you to specify both some data and some property about that data.
I'm not an expert on this, but I don't think you can implement this in Haskell at the type level, as Haskell does not support dependent types. You might want to look at Agda.
Just elaborating on ivanm's answer:
data MyType = MT {x :: Int, y :: Int, z :: Int } deriving Show
createMyType :: Int -> Int -> Int -> Maybe MyType
createMyType a b c
| a + b + c == 5 = Just MT { x = a, y = b, z = c }
| otherwise = Nothing