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).
Related
How does Haskell's * work? Does it create a series of + operators, or does it do something else?
This is the Num type class
type Num :: Type -> Constraint
class Num a where
(+) :: a -> a -> a
(*) :: a -> a -> a
-- .. I'm omitting the other methods
This is how Num is defined for Int (src)
instance Num Int where
(+) :: Int -> Int -> Int
I# x + I# y = I# (x +# y)
(*) :: Int -> Int -> Int
I# x * I# y = I# (x *# y)
-- ..
This is how it's defined for Float (src)
instance Num Float where
(+) :: Float -> Float -> Float
F# x + F# y = F# (plusFloat# x y)
(*) :: Float -> Float -> Float
F# x * F# y = F# (timesFloat# x y)
Maybe not enlightening but you can see that (for those instances) they are defined in terms of primitive operations like (+#) or timesFloat#. If you define your own number you can define multiplication in terms of repeated addition but the operations are not fundamentally defined that way.
type N :: Type
data N = O | S N
instance Num N where
(+) :: N -> N -> N
O + m = m
S n + m = S (n + m)
(*) :: N -> N -> N
O * _ = O
S n * m = m + (n * m)
You can define a "default" multiplication function that is defined in terms of repeated additions
-- >> timesViaPlus #Int #Int 10 20
-- 200
-- >> timesViaPlus #Integer #Integer 10 20
-- 200
timesViaPlus :: Integral n => Num m => n -> m -> m
timesViaPlus n m = sum (fromIntegral n `replicate` m)
or you could specialize it to N and use it to define (*) #N.
replicateN :: N -> a -> [a]
replicateN O _ = []
replicateN (S n) a = a : replicateN n a
timesViaPlusN :: Num n => N -> n -> n
timesViaPlusN n m = sum (n `replicateN` m)
instance Num N where
(+) :: N -> N -> N
O + m = m
S n + m = S (n + m)
(*) :: N -> N -> N
(*) = timesViaPlusN
I started reading Chapter 6 of "Type-driven development with Idris" and attempted to write a smart constructor for a tupled vector.
TupleVect : Nat -> Type -> Type
TupleVect Z _ = ()
TupleVect (S k) a = (a, TupleVect k a)
someValue : TupleVect 4 Nat
someValue = (1,2,3,4,())
TupleVectConstructorType : Nat -> Type -> Type
TupleVectConstructorType n typ = helper n
where
helper : Nat -> Type
helper Z = TupleVect n typ
helper (S k) = typ -> helper k
tupleVect : (n : Nat) -> (a : Type) -> TupleVectConstructorType n a
tupleVect Z a = ()
tupleVect (S Z) a = \val => (val, ())
tupleVect (S (S Z)) a = \val2 => \val1 => (val2, val1, ())
-- ??? how to create tupleVect (S k) a
How to create a constructor for an arbitrary k?
Basically #Matthias Berndt's idea. Counting down the arrows to be added, while making the final tuple longer. For this we need to access the more permissive helper from TupleVectType.
TupleVectType' : Nat -> Nat -> Type -> Type
TupleVectType' Z n a = TupleVect n a
TupleVectType' (S k) n a = a -> TupleVectType' k (S n) a
TupleVectType : Nat -> Type -> Type
TupleVectType n = TupleVectType' n Z
tupleVect : (n : Nat) -> (a : Type) -> TupleVectType n a
tupleVect n a = helper n Z a ()
where
helper : (k, n : Nat) -> (a : Type) -> (acc : TupleVect n a)
-> TupleVectType' k n a
helper Z n a acc = acc
helper (S k) n a acc = \x => helper k (S n) a (x, acc)
someValue2 : TupleVect 4 Nat
someValue2 = (tupleVect 4 Nat) 4 3 2 1
Though note that this will result in \v2 => \v1 => (v1, v2, ()) and not \v2 => \v1 => (v2, v1, ()) as the former fits the recursive definition of TupleVect (S k) a = (a, TupleVect k a) better.
I know almost nothing about Idris except that it's a dependently-typed, Haskell-like language. But I find this problem intriguing, so I gave it a shot.
Clearly you need a recursive solution here. My idea is to use an additional parameter f which accumulates the val1..val_n parameters that the function has eaten so far. When the base case is reached, f is returned.
tupleVectHelper Z a f = f
tupleVectHelper (S n) a f = \val => tupleVectHelper n a (val, f)
tupleVect n a = tupleVectHelper n a ()
I have no idea if this works, and I haven't yet figured out how to write the type of tupleVectHelper, but I've tried doing the substitutions manually for n = 3 and it does seem to work out on paper, though the resulting tuple is backwards. But I think that shouldn't be too hard to fix.
Hope this helps!
I ran into the following error in Haskell:
"Type signatures are only allowed in patterns with ScopedTypeVariables"
How should I re-use the defined variables. Thanks in advance
sum :: (Double -> Double) -> (Double -> Double) -> Int ->
(Double -> Double)
sum f g n = (\x -> helper f g n x)
where
helper :: (Double -> Double) -> (Double -> Double) -> Int -> Double ->
Double
|n == 0 = 0
|mod n 2 == 1 = f(x) + helper f g n-1 f(x)
|otherwise = g(x) + helper f g n-1 g(x)
This actually looks more like a syntactical error: you never defined a function body for helper, indeed you defined the signature of helper, followed by guards (the | ... part), but you should again state helper f g n x = ....
Furthermore I don't think it is useful to define helper here with a variable for f, an g, since these remain fixed throughout the recursion.
You can probably define the function as:
sumfg :: (Double -> Double) -> (Double -> Double) -> Int -> Double -> Double
sumfg f g = helperf
where helperf 0 _ = 0
helperf i x = let fx = f x in fx + helperg (i-1) fx
helperg 0 _ = 0
helperg i x = let gx = g x in gx + helperf (i-1) gx
We here defined two "helper" functions helperf and helperg, helperf will sum up f x with helperg (i-1) (f x), and helperg does the same, except that we use g instead of f. We here thus use mutual recursion to solve the problem.
We can however solve this problem more elegantly, by making use of scanl :: (b -> a -> b) -> b -> [a] -> [b], take :: Int -> [a] and sum :: Num a => [a] -> a:
sumfg :: Num a => (a -> a) -> (a -> a) -> Int -> a -> a
sumfg f g n x = sum (take n (scanl (flip ($)) (f x) (cycle [g, f])))
Here we thus make an infinite list of g and f, like [g, f, g, f, g, f, ...] with cycle [f, g]. We then use scanl (flip ($)) to each time apply the accumulator to one of the functions, and yield that element. We take the first n items of that list with take n, and finally we use sum to sum up these values.
For example:
Prelude> sumfg (2+) (3*) 5 1
91
Since (2+1) + (3*(2+1)) + (2+(3*(2+1))) + (3*(2+(3*(2+1)))) + (2+(3*(2+(3*(2+1))))) is 91.
We also generalized the signature: we can now work with any numerical type a, with the two functions f and g of type f, g :: a -> a.
This question is a sequel to the following question. Refer to it first:
Overlapping instances via Nat-kind
Now it's time to make the instance of Group Symmetric. After some savage math, I've come up to an instance that works in principle, but actually doesn't:
sIndex :: forall n. KnownNat n => Symmetric n -> Integer -> Integer
sIndex xs m = sIndex_ xs (m `mod` n)
where
n = toInteger (natVal (Proxy :: Proxy n))
sIndex_ :: Symmetric m -> Integer -> Integer
sIndex_ S1 _ = 0
sIndex_ (x :. _) 0 = cIndex x
sIndex_ (x :. xs) m = let
i = cIndex x + sIndex_ xs (m-1)
in if i < n then i else i - n
instance KnownNat n => Semigroup (Symmetric n) where
x <> y = go [] n where
n = toInteger (natVal (Proxy :: Proxy n))
go :: forall m. [(Integer,Integer)] -> Integer -> Symmetric m
go j m
| 0 == m = S1
| otherwise = let
i = sIndex y (sIndex x (n-m))
ix = foldr f i j
in cyclic ix :. go ((ix,m) :j) (m-1)
f (j,m) i = (i - j) `mod` m - 1
The go function inside the Semigroup instance should build the result by having recursion though Symmetric n, Symmetric (n-1), and so on until Symmetric 1. But GHC doesn't know how to do it and outputs the following error message:
Group_Symmetric.hs:89:24: error:
• Couldn't match type ‘m’ with ‘1’
‘m’ is a rigid type variable bound by
the type signature for:
go :: forall (m :: Nat).
[(Integer, Integer)] -> Integer -> Symmetric m
at Group_Symmetric.hs:87:9-69
Expected type: Symmetric m
Actual type: Symmetric 1
So what would the workaround be? Is it possible for go to be able to return any instantation of Symmetric m (m from 1 to n)?
A slight change of go and f solved the problem:
instance KnownNat n => Semigroup (Symmetric n) where
x <> y = go y [] n where
n = toInteger (natVal (Proxy :: Proxy n))
go :: forall m. Symmetric m -> [(Integer,Integer)] -> Integer -> Symmetric m
go S1 _ _ = S1
go (_ :. xs) j m = let
i = sIndex y (sIndex x (n-m))
ix = foldr f i j
in Cyclic ix :. go xs ((ix,m) :j) (m-1)
f (j,m) i = let
ix = (i - j) `mod` m - 1
in if 0 <= ix then ix else ix + m
The key idea is to introduce a dummy parameter. Also note that Cyclic was used instead of cyclic.
Unfortunately, it turns out that I did some math wrong. It is to be corrected.
EDIT: Here is the corrected sIndex, which completes the instance:
sIndex :: forall n. KnownNat n => Symmetric n -> Integer -> Integer
sIndex xs m = let
n = toInteger (natVal (Proxy :: Proxy n))
in sIndex_ xs (m `mod` n) n
where
sIndex_ :: Symmetric m -> Integer -> Integer -> Integer
sIndex_ S1 _ _ = 0
sIndex_ (x :. _) 0 _ = cIndex x
sIndex_ (x :. xs) m n = let
i = cIndex x + sIndex_ xs (m-1) (n-1) + 1
in if n <= i then i - n else i
I tried all possible type declarations but I can't make this code even compile. The trick is in handling types for division. I tried Num a, Fractional a, Float a etc.
cube x = x * x * x
sum' term a next b =
if a > b
then 0
else term a + sum' term (next a) next b
integral f a b n = (h / 3) * (sum' term 0 succ n) where
h = (b - a) / n
y k = f $ a + (k * h)
term k
| k == 0 || k == n = y k
| odd k = 4 * y k
| even k = 2 * y k
main = do
print $ integral cube 0 1 100 -- 0.25
print $ (\x -> 3 * x * x) 1 3 100 -- 26
I isolated problem by deleting (/) function. This code compiles without any type declaration at all:
cube x = x * x * x
sum' term a next b =
if a > b
then 0
else term a + sum' term (next a) next b
integral f a b n = (sum' term 0 succ n) where
h = (b - a)
y k = f $ a + (k * h)
term k
| k == 0 || k == n = y k
| odd k = 4 * y k
| even k = 2 * y k
main = do
print $ integral cube 0 1 100
Another question is how to debug cases like this? Haskell's error messages doesn't help much, it's kind of hard to understand something like The type variable a0 is ambiguous or Could not deduce (a1 ~ a).
P. S. It's ex. 1.29 from SICP.
Update
Final answer is:
cube :: Num a => a -> a
cube x = x * x * x
sum' :: (Int -> Double) -> Int -> (Int -> Int) -> Int -> Double
sum' term a next b =
if a > b
then 0
else term a + sum' term (next a) next b
integral :: (Double -> Double) -> Double -> Double -> Int -> Double
integral f a b n = (h / 3) * sum' term 0 (+1) n where
h = (b - a) / n' where n' = fromIntegral n
y k = f $ a + (k * h)
term k
| k == 0 || k == n = y k'
| odd k = 4 * y k'
| even k = 2 * y k'
where k' = fromIntegral k
main = do
print $ integral cube 0 1 100 -- 0.25
print $ integral cube 0 1 1000 -- 0.25
print $ integral (\x -> 3 * x * x) 1 3 100 -- 26
/ is only used for types that are instances of Fractional, for Integral types use quot. You can use quot as an infix operator using backticks:
h = (b - a) `quot` n
The types of the two are
(/) :: Fractional a => a -> a -> a
quot :: Integral a => a -> a -> a
There are no types that are instances of both Fractional and Integral, which is why none of the type signatures would work. Unfortunately GHC doesn't know that it's impossible for a type to be an instance of both classes, so the error messages are not very intuitive. You get used to the style of GHC error messages though, and the detail they give helps a lot.
Also, as was suggested in the comments, I completely agree that all top level definitions should be given type signatures (including main). It makes error messages a lot easier to read.
Edit: Based on the comments below, it looks like what you want is something more like this (type signature-wise)
cube :: Num a => a -> a
sum' :: (Int -> Double) -> Int -> (Int -> Int) -> Int -> Double
integral :: (Double -> Double) -> Double -> Double -> Int -> Double
You will need to use fromIntegral to convert from Int to Double in h and in k. The type errors should be at least a bit more readable with these type signatures though.