I have a task of calculating the height of a logical expression (like a∧(b∨c)). I have an algorithm, however there is a mistake that causes 2 errors
this function application is partial
This expression has type int * int -> int * int
but an expression was expected of type int
I have no clue what I'm doing wrong? Below is the code snippet:
let height f g =
let rec aux acc = function
| Bot -> acc+1
| Top -> acc+1
| Atome x -> acc+1
| Imp(f, g) -> max(aux(acc+1)f, aux(acc+1)g)
| And(f, g) -> max(aux(acc+1)f, aux(acc+1)g)
| Or(f, g) -> max(aux(acc+1)f, aux(acc+1)g)
in
acc 0;;
Thank's a lot in advance.
As noted in comments, you're passing a tuple to max rather than two curried arguments.
let height f g =
let rec aux acc = function
| Bot -> acc+1
| Top -> acc+1
| Atome x -> acc+1
| Imp (f, g) -> max (aux (acc+1) f) (aux (acc+1) g)
| And (f, g) -> max (aux (acc+1) f) (aux (acc+1) g)
| Or (f, g) -> max (aux (acc+1) f) (aux (acc+1) g)
in
acc 0
While you can write functions that take multiple arguments as a single tuple, this is not idiomatic in OCaml.
let f x y = ...
Vs.
let f (x, y) = ...
Related
I am trying to understand the lambda calculus. However, I am a bit stuck on this expression: TRUE and TRUE. I can't figure out how you can get from
((\T F -> T) (\T F -> T))
to
(\F T F -> T)
, not
(\F -> (\T F -> T))
\ is lambda-signature
(\F T F -> T)
and
(\F -> (\T F -> T))
are the same thing.
https://en.wikipedia.org/wiki/Lambda_calculus_definition#Notation:
Outermost parentheses are dropped: M N instead of (M N)
[...]
The body of an abstraction extends as far right as possible: λx. M N means λx. (M N) and not (λx. M) N
A sequence of abstractions is contracted: λx. λy. λz. N is abbreviated as λxyz. N
In particular,
(\F -> (\T F -> T))
can be written
(\F -> \T F -> T)
because we can drop redundant parentheses and the body of the outer lambda extends as far right as possible, which can then be written
(\F -> \T -> \F -> T)
or
(\F T F -> T)
by the last rule (contraction).
This:
foldrRange :: (Int -> t -> t) -> t -> Int -> Int -> t
foldrRange cons nil a b = foldr cons nil [a..b-1]
Defines a function that folds over a list from a til b. This:
foldrRange :: (Int -> t -> t) -> t -> Int -> Int -> t
foldrRange cons nil a b = go (b-1) nil where
go b !r | b < a = r
| otherwise = go (b-1) (cons b r)
{-# INLINE foldrRange #-}
is a ~50x faster version due to proper strictness usage (we know the last element, so we can roll like foldl').
This:
foldrRange2D cons nil (ax,ay) (bx,by)
= foldr cons nil
$ do
y <- [ay..by-1]
x <- [ax..bx-1]
return (x,y)
Is a 2D version of foldrRange, i.e., it works over 2D rectangles so that foldrRange2d (:) [] (0,0) (2,2) == [(0,0),(1,0),(0,1),(1,1)]. This:
foldrRange2D :: ((Int,Int) -> t -> t) -> t -> (Int,Int) -> (Int,Int) -> t
foldrRange2D cons nil (ax,ay) (bx,by) = go (by-1) nil where
go by !r
| by < ay = r
| otherwise = go (by-1) (foldrRange (\ ax -> cons (ax,by)) r ax bx)
Is, again, an ~50x faster definition due to better strictness usage. Writing foldrRange3D, foldrRange4D, etc., would be cumbersome, so one can generalize it like so:
foldrRangeND :: forall t . ([Int] -> t -> t) -> t -> [Int] -> [Int] -> t
foldrRangeND cons nil as bs = foldr co ni (zip as bs) [] nil where
co (a,b) tail lis = foldrRange (\ h t -> tail (h:lis) . t) id a b
ni lis = cons lis
Unfortunately this definition is at around 120 times slower than foldrRange2D, as one can verify with this test:
main = do
let n = 2000
print $ foldrRange2D (\ (a,b) c -> a+b+c) 0 (0,0) (n,n)
print $ foldrRanges (\ [a,b] c -> a+b+c) 0 [0,0] [n,n]
I could probably use ST to get a faster foldrRanges, but is it possible to do so with recursion alone?
You have an efficient implementation of your algorithm which is inductive on the dimension of the input. Fortunately, you can do that in Haskell!
First, replace lists with type level Nat indexed vectors. This gives us a type to do induction on (it could probably be done with lists ... but this is much safer).
data Nat = Z | S Nat
infixl 5 :<
data Vec (n :: Nat) (a :: *) where
Nil :: Vec Z a
(:<) :: Vec n a -> a -> Vec (S n) a
instance Functor (Vec n) where
fmap _ Nil = Nil
fmap f (xs :< x) = fmap f xs :< f x
Then your desired function is just the same as the 2D case - just generalize the recursive call:
{-# INLINE foldrRangeN #-}
foldrRangeN :: (Vec n Int -> t -> t) -> t -> Vec n Int -> Vec n Int -> t
foldrRangeN f x Nil Nil = f Nil x
foldrRangeN cons nil (ax :< ay) (bx :< by) = go (by-1) nil where
go by !r
| by < ay = r
| otherwise = go (by-1) (foldrRangeN (\ ax -> cons (ax :< by)) r ax bx)
Although when I tested the performance, I was disappointed to see it couldn't keep up with the 2D version. The trick seems to be more inlining. By putting the function in a class, you can get it to inline at each 'dimension' (there must be a better way to do this...)
class FoldrRange n where
foldrRangeN' :: (Vec n Int -> t -> t) -> t -> Vec n Int -> Vec n Int -> t
instance FoldrRange Z where
{-# INLINE foldrRangeN' #-}
foldrRangeN' f x Nil Nil = f Nil x
instance FoldrRange n => FoldrRange (S n) where
{-# INLINE foldrRangeN' #-}
foldrRangeN' cons nil (ax :< ay) (bx :< by) = go (by-1) nil where
go by !r
| by < ay = r
| otherwise = go (by-1) (foldrRangeN' (\ ax -> cons (ax :< by)) r ax bx)
Tested as follows:
main = do
i:n':_ <- getArgs
let n = read n' :: Int
rs = [ foldrRange2D (\ (a,b) c -> a+b+c) 0 (0,0) (n,n)
, foldrRangeND (\ [a,b] c -> a+b+c) 0 [0,0] [n,n]
, foldrRangeN (\ (Nil :< a :< b) c -> a+b+c) 0 (Nil :< 0 :< 0) (Nil :< n :< n)
, foldrRangeN' (\ (Nil :< a :< b) c -> a+b+c) 0 (Nil :< 0 :< 0) (Nil :< n :< n)
]
print $ rs !! read i
and the results on my system
./test 0 4000 +RTS -s : 0.02s
./test 1 4000 +RTS -s : 7.63s
./test 2 4000 +RTS -s : 0.59s
./test 3 4000 +RTS -s : 0.03s
Some time ago, I've asked how to map back and forth from godel numbers to terms of a context-free language. While the answer solved the issue specificaly, I'm having trouble in actually programming it generically. So, this question is more generic: given a recursive algebraic data type with terminals, sums and products - such as
data Term = Prod Term Term | SumL Term | SumR Term | AtomA | AtomB
what is an algorithm that will map a term of this type to its godel number, and its inverse?
Edit: for example:
data Foo = A | B Foo | C Foo deriving Show
to :: Foo -> Int
to A = 1
to (B x) = to x * 2
to (C x) = to x * 2 + 1
from :: Int -> Foo
from 1 = A
from n = case mod n 2 of
0 -> B (from (div n 2))
1 -> C (from (div n 2))
Here, to and from do what I want for Foo. I'm just asking for a systematic way to derive those functions for any datatype.
In order to avoid dealing with a particular Goedel numbering, let's define a class that'll abstract the necessary operations (with some imports we'll need later):
{-# LANGUAGE TypeOperators, DefaultSignatures, FlexibleContexts, DeriveGeneric #-}
import Control.Applicative
import GHC.Generics
import Test.QuickCheck
import Test.QuickCheck.Gen
class GodelNum a where
fromInt :: Integer -> a
toInt :: a -> Maybe Integer
encode :: [a] -> a
decode :: a -> [a]
So we can inject natural numbers and encode sequences. Let's further create a canonical instance of this class that'll use throughout the code, which does no real Goedel encoding, just constructs a tree of terms.
data TermNum = Value Integer | Complex [TermNum]
deriving (Show)
instance GodelNum TermNum where
fromInt = Value
toInt (Value x) = Just x
toInt _ = Nothing
encode = Complex
decode (Complex xs) = xs
decode _ = []
For real encoding we'd use another implementation that'd use just one Integer, something like newtype SomeGoedelNumbering = SGN Integer.
Let's further create a class for types that we can encode/decode:
class GNum a where
gto :: (GodelNum g) => a -> g
gfrom :: (GodelNum g) => g -> Maybe a
default gto :: (Generic a, GodelNum g, GGNum (Rep a)) => a -> g
gto = ggto . from
default gfrom :: (Generic a, GodelNum g, GGNum (Rep a)) => g -> Maybe a
gfrom = liftA to . ggfrom
The last four lines define a generic implementation of gto and gfrom using GHC Generics and DefaultSignatures. The class GGNum that they use is a helper class which we'll use to define encoding for the atomic ADT operations - products, sums, etc.:
class GGNum f where
ggto :: (GodelNum g) => f a -> g
ggfrom :: (GodelNum g) => g -> Maybe (f a)
-- no-arg constructors
instance GGNum U1 where
ggto U1 = encode []
ggfrom _ = Just U1
-- products
instance (GGNum a, GGNum b) => GGNum (a :*: b) where
ggto (a :*: b) = encode [ggto a, ggto b]
ggfrom e | [x, y] <- decode e = liftA2 (:*:) (ggfrom x) (ggfrom y)
| otherwise = Nothing
-- sums
instance (GGNum a, GGNum b) => GGNum (a :+: b) where
ggto (L1 x) = encode [fromInt 0, ggto x]
ggto (R1 y) = encode [fromInt 1, ggto y]
ggfrom e | [n, x] <- decode e = case toInt n of
Just 0 -> L1 <$> ggfrom x
Just 1 -> R1 <$> ggfrom x
_ -> Nothing
-- metadata
instance (GGNum a) => GGNum (M1 i c a) where
ggto (M1 x) = ggto x
ggfrom e = M1 <$> ggfrom e
-- constants and recursion of kind *
instance (GNum a) => GGNum (K1 i a) where
ggto (K1 x) = gto x
ggfrom e = K1 <$> gfrom e
Having that, we can then define a data type like yours and just declare its GNum instance, everything else will be automatically derived.
data Term = Prod Term Term | SumL Term | SumR Term | AtomA | AtomB
deriving (Eq, Show, Generic)
instance GNum Term where
And just to be sure we've done everything right, let's use QuickCheck to verify that our gfrom is an inverse of gto:
instance Arbitrary Term where
arbitrary = oneof [ return AtomA
, return AtomB
, SumL <$> arbitrary
, SumR <$> arbitrary
, Prod <$> arbitrary <*> arbitrary
]
prop_enc_dec :: Term -> Property
prop_enc_dec x = Just x === gfrom (gto x :: TermNum)
main :: IO ()
main = quickCheck prop_enc_dec
Notes:
The same thing could be accomplished using Scrap Your Boilerplate, perhaps more efficiently, as it allows somewhat higher-level access - enumerating constructors and records, etc.
See also paper Efficient Bijective G¨odel Numberings for Term Algebras (I haven't read the paper yet, but seems related).
For fun, I decided to try the approach in the link you posted, and didn't get stuck anywhere. So here's my code, with no commentary (the explanation is the same as the last time). First, code stolen from the other answer:
{-# LANGUAGE TypeSynonymInstances #-}
import Control.Applicative
import Data.Universe.Helpers
type Nat = Integer
class Godel a where
to :: a -> Nat
from :: Nat -> a
instance Godel Nat where to = id; from = id
instance (Godel a, Godel b) => Godel (a, b) where
to (m_, n_) = (m + n) * (m + n + 1) `quot` 2 + m where
m = to m_
n = to n_
from p = (from m, from n) where
isqrt = floor . sqrt . fromIntegral
base = (isqrt (1 + 8 * p) - 1) `quot` 2
triangle = base * (base + 1) `quot` 2
m = p - triangle
n = base - m
And the code specific to your new type:
data Term = Prod Term Term | SumL Term | SumR Term | AtomA | AtomB
deriving (Eq, Ord, Read, Show)
ts = AtomA : AtomB : interleave [uncurry Prod <$> ts +*+ ts, SumL <$> ts, SumR <$> ts]
instance Godel Term where
to AtomA = 0
to AtomB = 1
to (Prod t1 t2) = 2 + 0 + 3 * to (t1, t2)
to (SumL t) = 2 + 1 + 3 * to t
to (SumR t) = 2 + 2 + 3 * to t
from 0 = AtomA
from 1 = AtomB
from n = case quotRem (n-2) 3 of
(q, 0) -> uncurry Prod (from q)
(q, 1) -> SumL (from q)
(q, 2) -> SumR (from q)
The same ghci test as last time:
*Main> take 30 (map from [0..]) == take 30 ts
True
I find an example build from preorder, how about how to build binary tree from post
order ?
i edit as following, is it correct
type BinaryTree =
| Nil
| Node of NodeType * BinaryTree * BinaryTree
let rec buildBSTfromPostOrder (l:NodeType list) =
match l with
| [] -> Nil
| [a] -> Node(a, Nil, Nil)
| h::t ->
let b = Node(h, buildBSTfromPostOrder(t), buildBSTfromPostOrder(t))
let smaller =
t
|> Seq.takeWhile (fun n -> n < h)
|> Seq.toList
let bigger =
t
|> Seq.skipWhile (fun n -> n < h)
|> Seq.toList
b
let input = [10; 1; 2; 2; 1; 50]
You can't, if you want reconstruct some binary tree from streams (lists) must use at least two.
There is a Haskell version (very closed to F#)
post [] _ = []
post (x:xs) ys = post (take q xs) (take q ys) ++ -- left
post (drop q xs) (drop (q + 1) ys) ++ -- right
[x] -- node
where (Just q) = elemIndex x ys
That function reconstruct post order from pre and in order. Can be adapted to other versions.
(The keys should be uniques too)
If your tree is ordered (BST) then, simply populate tree with keys.
To populate your BST, you can write
let rec insert tree n =
match tree with
| Nil -> Node(n, Nil, Nil)
| Node(x, left, right) -> if n < x then Node(x, insert left n, right)
else Node(x, left, insert right n)
let populate xs = Seq.fold insert Nil xs
example
let rec show tree =
match tree with
| Nil -> printf ""
| Node(x, left, right) -> do printf "[%d;" x
show left
printf ";"
show right
printf "]"
do show <| populate [|1;6;4;8;2;|]
According to this paper differentiation works on data structures.
According to this answer:
Differentiation, the derivative of a data type D (given as D') is the type of D-structures with a single “hole”, that is, a distinguished location not containing any data. That amazingly satisfy the same rules as for differentiation in calculus.
The rules are:
1 = 0
X′ = 1
(F + G)′ = F' + G′
(F • G)′ = F • G′ + F′ • G
(F ◦ G)′ = (F′ ◦ G) • G′
The referenced paper is a bit too complex for me to get an intuition.
What does this this mean in practice? A concrete example would be fantastic.
What's a one hole context for an X in an X? There's no choice: it's (-), representable by the unit type.
What's a one hole context for an X in an X*X? It's something like (-,x2) or (x1,-), so it's representable by X+X (or 2*X, if you like).
What's a one hole context for an X in an X*X*X? It's something like (-,x2,x3) or (x1,-,x3) or (x1,x2,-), representable by X*X + X*X + X*X, or (3*X^2, if you like).
More generally, an F*G with a hole is either an F with a hole and a G intact, or an F intact and a G with a hole.
Recursive datatypes are often defined as fixpoints of polynomials.
data Tree = Leaf | Node Tree Tree
is really saying Tree = 1 + Tree*Tree. Differentiating the polynomial tells you the contexts for immediate subtrees: no subtrees in a Leaf; in a Node, it's either hole on the left, tree on the right, or tree on the left, hole on the right.
data Tree' = NodeLeft () Tree | NodeRight Tree ()
That's the polynomial differentiated and rendered as a type. A context for a subtree in a tree is thus a list of those Tree' steps.
type TreeCtxt = [Tree']
type TreeZipper = (Tree, TreeCtxt)
Here, for example, is a function (untried code) which searches a tree for subtrees passing a given test subtree.
search :: (Tree -> Bool) -> Tree -> [TreeZipper]
search p t = go (t, []) where
go :: TreeZipper -> [TreeZipper]
go z = here z ++ below z
here :: TreeZipper -> [TreeZipper]
here z#(t, _) | p t = [z]
| otherwise = []
below (Leaf, _) = []
below (Node l r, cs) = go (l, NodeLeft () r : cs) ++ go (r, NodeRight l () : cs)
The role of "below" is to generate the inhabitants of Tree' relevant to the given Tree.
Differentiation of datatypes is a good way make programs like "search" generic.
My interpretation is that, the derivative (zipper) of T is the type of all instances that resembles the "shape" of T, but with exactly 1 element replaced by a "hole".
For instance, a list is
List t = 1 []
+ t [a]
+ t^2 [a,b]
+ t^3 [a,b,c]
+ t^4 [a,b,c,d]
+ ... [a,b,c,d,...]
if we replace any of those 'a', 'b', 'c' etc by a hole (represented as #), we'll get
List' t = 0 empty list doesn't have hole
+ 1 [#]
+ 2*t [#,b] or [a,#]
+ 3*t^2 [#,b,c] or [a,#,c] or [a,b,#]
+ 4*t^3 [#,b,c,d] or [a,#,c,d] or [a,b,#,d] or [a,b,c,#]
+ ...
Another example, a binary tree is
data Tree t = TEmpty | TNode t (Tree t) (Tree t)
-- Tree t = 1 + t (Tree t)^2
so adding a hole generates the type:
{-
Tree' t = 0 empty tree doesn't have hole
+ (Tree X)^2 the root is a hole, followed by 2 normal trees
+ t*(Tree' t)*(Tree t) the left tree has a hole, the right is normal
+ t*(Tree t)*(Tree' t) the left tree is normal, the right has a hole
# or x or x
/ \ / \ / \
a b #? b a #?
/\ /\ / \ /\ /\ /\
c d e f #? #? e f c d #? #?
-}
data Tree' t = THit (Tree t) (Tree t)
| TLeft t (Tree' t) (Tree t)
| TRight t (Tree t) (Tree' t)
A third example which illustrates the chain rule is the rose tree (variadic tree):
data Rose t = RNode t [Rose t]
-- R t = t*List(R t)
the derivative says R' t = List(R t) + t * List'(R t) * R' t, which means
{-
R' t = List (R t) the root is a hole
+ t we have a normal root node,
* List' (R t) and a list that has a hole,
* R' t and we put a holed rose tree at the list's hole
x
|
[a,b,c,...,p,#?,r,...]
|
[#?,...]
-}
data Rose' t = RHit [Rose t] | RChild t (List' (Rose t)) (Rose' t)
Note that data List' t = LHit [t] | LTail t (List' t).
(These may be different from the conventional types where a zipper is a list of "directions", but they are isomorphic.)
The derivative is a systematic way to record how to encode a location in a structure, e.g. we can search with: (not quite optimized)
locateL :: (t -> Bool) -> [t] -> Maybe (t, List' t)
locateL _ [] = Nothing
locateL f (x:xs) | f x = Just (x, LHit xs)
| otherwise = do
(el, ctx) <- locateL f xs
return (el, LTail x ctx)
locateR :: (t -> Bool) -> Rose t -> Maybe (t, Rose' t)
locateR f (RNode a child)
| f a = Just (a, RHit child)
| otherwise = do
(whichChild, listCtx) <- locateL (isJust . locateR f) child
(el, ctx) <- locateR f whichChild
return (el, RChild a listCtx ctx)
and mutate (plug in the hole) using the context info:
updateL :: t -> List' t -> [t]
updateL x (LHit xs) = x:xs
updateL x (LTail a ctx) = a : updateL x ctx
updateR :: t -> Rose' t -> Rose t
updateR x (RHit child) = RNode x child
updateR x (RChild a listCtx ctx) = RNode a (updateL (updateR x ctx) listCtx)