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.
Related
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 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.)
Okasaki describes persistent real-time queues which can be realized in Haskell using the type
data Queue a = forall x . Queue
{ front :: [a]
, rear :: [a]
, schedule :: [x]
}
where incremental rotations maintain the invariant
length schedule = length front - length rear
More details
If you're familiar with the queues involved, you can skip this section.
The rotation function looks like
rotate :: [a] -> [a] -> [a] -> [a]
rotate [] (y : _) a = y : a
rotate (x : xs) (y : ys) a =
x : rotate xs ys (y : a)
and it's called by a smart constructor
exec :: [a] -> [a] -> [x] -> Queue a
exec f r (_ : s) = Queue f r s
exec f r [] = Queue f' [] f' where
f' = rotate f r []
after each queue operation. The smart constructor is always called when length s = length f - length r + 1, ensuring that the pattern match in rotate will succeed.
The problem
I hate partial functions! I'd love to find a way to express the structural invariant in the types. The usual dependent vector seems a likely choice:
data Nat = Z | S Nat
data Vec n a where
Nil :: Vec 'Z a
Cons :: a -> Vec n a -> Vec ('S n) a
and then (perhaps)
data Queue a = forall x rl sl . Queue
{ front :: Vec (sl :+ rl) a
, rear :: Vec rl a
, schedule :: Vec sl x
}
The trouble is that I haven't been able to figure out how to juggle the types. It seems extremely likely that some amount of unsafeCoerce will be needed to make this efficient. However, I haven't been able to come up with an approach that's even vaguely manageable. Is it possible to do this nicely in Haskell?
Here is what I got:
open import Function
open import Data.Nat.Base
open import Data.Vec
grotate : ∀ {n m} {A : Set}
-> (B : ℕ -> Set)
-> (∀ {n} -> A -> B n -> B (suc n))
-> Vec A n
-> Vec A (suc n + m)
-> B m
-> B (suc n + m)
grotate B cons [] (y ∷ ys) a = cons y a
grotate B cons (x ∷ xs) (y ∷ ys) a = grotate (B ∘ suc) cons xs ys (cons y a)
rotate : ∀ {n m} {A : Set} -> Vec A n -> Vec A (suc n + m) -> Vec A m -> Vec A (suc n + m)
rotate = grotate (Vec _) _∷_
record Queue (A : Set) : Set₁ where
constructor queue
field
{X} : Set
{n m} : ℕ
front : Vec A (n + m)
rear : Vec A m
schedule : Vec X n
open import Relation.Binary.PropositionalEquality
open import Data.Nat.Properties.Simple
exec : ∀ {m n A} -> Vec A (n + m) -> Vec A (suc m) -> Vec A n -> Queue A
exec {m} {suc n} f r (_ ∷ s) = queue (subst (Vec _) (sym (+-suc n m)) f) r s
exec {m} f r [] = queue (with-zero f') [] f' where
with-zero = subst (Vec _ ∘ suc) (sym (+-right-identity m))
without-zero = subst (Vec _ ∘ suc) (+-right-identity m)
f' = without-zero (rotate f (with-zero r) [])
rotate is defined in terms of grotate for the same reason reverse is defined in terms of foldl (or enumerate in terms of genumerate): because Vec A (suc n + m) is not definitionally Vec A (n + suc m), while (B ∘ suc) m is definitionally B (suc m).
exec has the same implementation as you provided (modulo those substs), but I'm not sure about the types: is it OK that r must be non-empty?
The other answer is super clever (please take a moment to upvote it), but as someone not familiar with Agda, how this would be implemented in Haskell was not obvious to me. Here's a full Haskell version. We'll need a whole slew of extensions, as well as Data.Type.Equality (since we will need to do some limited amount of type-proofs).
{-# LANGUAGE GADTs, ScopedTypeVariables,RankNTypes,
TypeInType, TypeFamilies, TypeOperators #-}
import Data.Type.Equality
Defining Nat, Vec, and Queue
Next, we define the usual type-level natural numbers (this looks like just a regular data definition, but because we have TypeInType enabled, it will get automatically promoted when we use it in a type) and a type function (a type family) for addition. Note that although there are multiple ways of defining +, our choice here will impact what follows. We'll also define the usual Vec which is very much like a list except that it encodes its length in the phantom type n. With that, we can go ahead and define the type of our queue.
data Nat = Z | S Nat
type family n + m where
Z + m = m
S n + m = S (n + m)
data Vec a n where
Nil :: Vec a Z
(:::) :: a -> Vec a n -> Vec a (S n)
data Queue a where
Queue :: { front :: Vec a (n + m)
, rear :: Vec a m
, schedule :: Vec x n } -> Queue a
Defining rotate
Now, things start to get hairier. We want to define a function rotate that has type rotate :: Vec a n -> Vec a (S n + m) -> Vec a m -> Vec a (S n + m), but you quickly run into a variety of proof related problems with just defining this recursively. The solution is instead to define a slightly more general grotate, which can be defined recursively, and for which rotate is a special case.
The point of Bump is to circumvent the fact that there is no such thing as type level composition in Haskell. There is no way of writing things an operator like (∘) such that (S ∘ S) x is S (S x). The workaround is to continuously wrap/unwrap with Bump/lower.
newtype Bump p n = Bump { lower :: p (S n) }
grotate :: forall p n m a.
(forall n. a -> p n -> p (S n)) ->
Vec a n ->
Vec a (S n + m) ->
p m ->
p (S n + m)
grotate cons Nil (y ::: _) zs = cons y zs
grotate cons (x ::: xs) (y ::: ys) zs = lower (grotate consS xs ys (Bump (cons y zs)))
where
consS :: forall n. a -> Bump p n -> Bump p (S n)
consS = \a -> Bump . cons a . lower
rotate :: Vec a n -> Vec a (S n + m) -> Vec a m -> Vec a (S n + m)
rotate = grotate (:::)
We need explicit foralls here to make it very clear which type variables are getting captured and which aren't, as well as to denote higher-rank types.
Singleton natural numbers SNat
Before we proceed to exec, we set up some machinery that will allow us to prove some type-level arithmetic claims (which we need to get exec to typecheck). We start by making an SNat type (which is a singleton type corresponding to Nat). SNat reflects its value in a phantom type variable.
data SNat n where
SZero :: SNat Z
SSucc :: SNat n -> SNat (S n)
We can then make a couple useful functions to do things with SNat.
sub1 :: SNat (S n) -> SNat n
sub1 (SSucc x) = x
size :: Vec a n -> SNat n
size Nil = SZero
size (_ ::: xs) = SSucc (size xs)
Finally, we are prepared to prove some arithmetic, namely that n + S m ~ S (n + m) and n + Z ~ n.
plusSucc :: (SNat n) -> (SNat m) -> (n + S m) :~: S (n + m)
plusSucc SZero _ = Refl
plusSucc (SSucc n) m = gcastWith (plusSucc n m) Refl
plusZero :: SNat n -> (n + Z) :~: n
plusZero SZero = Refl
plusZero (SSucc n) = gcastWith (plusZero n) Refl
Defining exec
Now that we have rotate, we can define exec. This definition looks almost identical to the one in the question (with lists), except annotated with gcastWith <some-proof>.
exec :: Vec a (n + m) -> Vec a (S m) -> Vec a n -> Queue a
exec f r (_ ::: s) = gcastWith (plusSucc (size s) (sub1 (size r))) $ Queue f r s
exec f r Nil = gcastWith (plusZero (sub1 (size r))) $
let f' = rotate f r Nil in (Queue f' Nil f')
It is probably worth noting that we can get some stuff for free by using singletons. With the right extensions enabled, the following more readable code
import Data.Singletons.TH
singletons [d|
data Nat = Z | S Nat
(+) :: Nat -> Nat -> Nat
Z + n = n
S m + n = S (m + n)
|]
defines, Nat, the type family :+ (equivalent to my +), and the singleton type SNat (with constructors SZ and SS equivalent to my SZero and SSucc) all in one.
So far I have the definitions for n-1 and n+1 with suc and inc respectively
add x y | y > 0 = add (inc x) (suc y)
add x y | y < 0 = add (suc x) (inc y)
add x 0 = x
add 0 y = y
How can I use this in my multiplication function using only recursion, if-then and no +, -, etc
I know that the result of x * y is equal to adding y to the result of (x-1) * y
But I just don't know how I can put it into the code. Thanks.
If we define the natural numbers as:
data Nat where
Zero :: Nat -- 0
Succ :: Nat -> Nat -- \n -> n + 1
Then, we can define add as follows:
add :: Nat -> Nat -> Nat
add n Zero = n -- n + 0 = n
add n (Succ m) = Succ (add n m) -- n + (m + 1) = (n + m) + 1
Next, we can define mul in terms of add:
mul :: Nat -> Nat -> Nat
mul n Zero = Zero -- n * 0 = 0
mul n (Succ m) = add (mul n m) n -- n * (m + 1) = (n * m) + n
Similarly, we can define exp in terms of mul:
exp :: Nat -> Nat -> Nat
exp n Zero = Succ Zero -- n ^ 0 = 1
exp n (Succ m) = mul (exp n m) n -- n ^ (m + 1) = (n ^ m) * n
Notice a pattern here? This is known as primitive recursion.
The basic implementation is:
mul x 0 = 0
mul x y = add x (mul x (y - 1))
you would need to replace y - 1 with your decrement function (which is oddly named suc). Also this does not work for negative multipliers, but you can play with it.
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