I have defined my propositional formulas as follows:
Inductive propForm : Set :=
| top : propForm
| bot : propForm
| var : propVar -> propForm
| orp : propForm -> propForm -> propForm
| andp : propForm -> propForm -> propForm.
I am trying to define a function for transforming a propositional formula into one in DNF. For this, I have defined a function which distributes terms using the distributive law:
Fixpoint distribute (f:propForm) : propForm -> propForm :=
fix distribute1 (g:propForm) : propForm :=
match f with
| f1 \/p f2 => match g with
| g1 \/p g2 => distribute1 g1 \/p distribute1 g2
| _ => distribute f1 g \/p distribute f2 g
end
| _ => match g with
| g1 \/p g2 => distribute1 g1 \/p distribute1 g2
| _ => f /\p g
end
end.
This function works fine. However, I still need to define a function which transforms the propositional formula to DNF. The following function would do what I want, however it is not accepted by Coq because the function is not structurally decreasing in f' for the last case. Any hints and tips would be appreciated.
Fixpoint toDNF (f':propForm):propForm :=
match f' with
| top => f'
| bot => f'
| var _ => f'
| f1 \/p f2 => toDNF f1 \/p toDNF f2
| f1 /\p f2 => toDNF (distribute f1 f2)
end.
Your function is a special case of normalizing an expression from a semi-ring. I wrote a post explaining how to do that in the case of arithmetic expressions, using the Ssreflect and MathComp libraries, but I'll include a more direct answer here.
One idea is to use lists of lists to represent formulas in DNF: after all, they are just a conjunction of a list of disjunctions, which are just lists of literals. You can then reuse the list library to write your function:
Module Sol1.
Require Import Coq.Lists.List.
Import ListNotations.
Notation propVar := nat.
Inductive propAtom :=
| top | bot | var :> propVar -> propAtom.
Inductive propForm : Set :=
| atom :> propAtom -> propForm
| orp : propForm -> propForm -> propForm
| andp : propForm -> propForm -> propForm.
Definition dnfForm := list (list propAtom).
Fixpoint andd (f1 f2 : dnfForm) : dnfForm :=
match f1 with
| [] =>
(* false && f2 = false *)
[]
| cf :: f1 =>
(* (cf || f1) && f2 = cf && f2 || f1 && f2 *)
map (app cf) f2 ++ andd f1 f2
end.
Fixpoint toDNF (f : propForm) : dnfForm :=
match f with
| atom a => [[a]]
| orp f1 f2 => toDNF f1 ++ toDNF f2
| andp f1 f2 => andd (toDNF f1) (toDNF f2)
end.
Compute (toDNF (andp (orp 3 4) (orp 1 2))).
End Sol1.
There are two things to note here. First, I factored variables and constants as a separate propAtom type, and I have called distribute andd, because you can think of it as computing the AND of two expressions in DNF.
Here's another solution that is based on your original code. It seems that your distribute function preserves the invariant of being in DNF; that is, if f1 and f2 are in DNF, then so is distribute f1 f2. Thus, you can just flip the order of the calls:
Module Sol2.
Notation propVar := nat.
Inductive propForm : Set :=
| top : propForm
| bot : propForm
| var :> propVar -> propForm
| orp : propForm -> propForm -> propForm
| andp : propForm -> propForm -> propForm.
Fixpoint distribute (f:propForm) : propForm -> propForm :=
fix distribute1 (g:propForm) : propForm :=
match f with
| orp f1 f2 => match g with
| orp g1 g2 => orp (distribute1 g1) (distribute1 g2)
| _ => orp (distribute f1 g) (distribute f2 g)
end
| _ => match g with
| orp g1 g2 => orp (distribute1 g1) (distribute1 g2)
| _ => andp f g
end
end.
Fixpoint toDNF (f':propForm):propForm :=
match f' with
| top => f'
| bot => f'
| var _ => f'
| orp f1 f2 => orp (toDNF f1) (toDNF f2)
| andp f1 f2 => distribute (toDNF f1) (toDNF f2)
end.
Compute (toDNF (andp (orp 3 4) (orp 1 2))).
End Sol2.
Related
Hello I have a been given the problem:
Write an F# function toString: aexpr -> string to format expressions
as strings, with the binary operators written in infix format. For
instance, it may format Sub(Var "x", CstI 34) as the string "x -
34". For simplicity, put parentheses around any subexpressions, even
when they are superfluous according to the standard precedence rules
for arithmetic operators. Use the predefined function string to convert
an integer value to its string representation.
Hint: toString has very much the same structure as an eval function,
although it needs no environment argument because it uses variables
names, not variable values.
yes this is a HW problem. Any help would greatly be appreciated with explanations. Below I included an eval function
These are data types we have been using:
type oper1 = Neg | Not
type oper2 = Add | Mul | Sub | Less | Eq | And
type aexpr =
| C of int
| V of string
| Op1 of oper1 * aexpr
| Op2 of oper2 * aexpr * aexpr
let rec eval e (env : (string * int) list) : int =
match e with
| CstI i -> i
| Var x -> lookup env x
| Prim("+", e1, e2) -> (eval e1 env) + (eval e2 env)
| Prim("*", e1, e2) -> (eval e1 env) * (eval e2 env)
| Prim("-", e1, e2) -> (eval e1 env) - (eval e2 env)
| Prim _ -> failwith "unknown primitive"
| Let(x, e1, e2) -> eval e2 ((x, eval e1 env) :: env)
So for the given problem I have written:
let rec toString e (env : (string * int) list) : string
match e with
| Prim("+", e1, e2) -> "e1 + e2"
| Prim("*", e1, e2) -> "e1 - e2"
| Prim("-", e1, e2) -> "e1 * e2"
this may look foolish, or am I on the right track? Fairly new to F#
The problem states:
[...] although it needs no environment argument [...]
so your function toString should look something like this:
let rec toString e =
match e with
| CstI i -> sprintf "%i" i // format number as string
| Var x -> x // already a string
| Prim("+", e1, e2) -> sprintf "(%s + %s)" (toString e1) (toString e2)
| Prim("*", e1, e2) -> sprintf "(%s * %s)" (toString e1) (toString e2)
| Prim("-", e1, e2) -> sprintf "(%s - %s)" (toString e1) (toString e2)
For nested expressions toString is called on the subexpressions first. The resulting strings are then plugged into %s in sprintf.
I am trying to use a fixpoint style function in the context of a type class instance but it doesn't seem to work. Is there something extra I have to do to make this work? For the time being I've used a hack of moving the function outside the type class and explicitly declaring it Fixpoint. This seems awful, however.
Here's the short example:
Inductive cexp : Type :=
| CAnd : cexp -> cexp -> cexp
| COr : cexp -> cexp -> cexp
| CProp : bool -> cexp.
Class Propable ( A : Type ) := { compile : A -> Prop }.
Instance: Propable cexp :=
{ compile c :=
match c with
| CAnd x y => (compile x) /\ (compile y)
| COr x y => (compile x) \/ (compile y)
| CProp _ => False
end
}.
This fails with:
Error: Unable to satisfy the following constraints:
In environment:
c, x, y : cexp
?Propable : "Propable cexp"
What does one have to do to make this work?
You can use fix to do that:
Instance: Propable cexp :=
{ compile := fix compile c :=
match c with
| CAnd x y => (compile x) /\ (compile y)
| COr x y => (compile x) \/ (compile y)
| CProp _ => False
end
}.
Let me illustrate how one can come up with it. Let's take the following piece of code:
Fixpoint silly n :=
match n with
| 0 => 0
| S n => silly n
end.
Fixpoint here is a vernacular command which makes the definition a little bit easier on the eyes, but it conceals what is going on here. It turns out that what Coq actually does is something like this:
Definition silly' :=
fix self n :=
match n with
| 0 => 0
| S n => self n
end.
You can verify it by using Print silly. after the definition.
I am trying to define lexicographic ordering on strings over posets, but I'm not completely sure how to use the PartialOrder typeclass.
Require Import List RelationClasses.
Fail Inductive lex_leq {A : Type} `{po : PartialOrder A} : list A -> list A -> Prop :=
| lnil: forall l, lex_leq nil l
| lcons:
forall (hd1 hd2 : A) (tl1 tl2 : list A),
hd1 <= hd2 -> (* error *)
(hd1 = hd2 -> lex_leq tl1 tl2) ->
lex_leq (hd1 :: tl1) (hd2 :: tl2).
Partial output:
The term "hd1" has type "A" while it is expected to have type "nat".
Clearly <= is the wrong notation to use here; I'm wondering how I can obtain an ordering relation from my po instance.
One can bind the names explicitly to make things more obvious. Before we can do this we need to tell Coq not to complain about unbound variables using the Generalizable Variables command:
From Coq Require Import List RelationClasses.
Generalizable Variables A eqA R.
Inductive lex_leq `{PartialOrder A eqA R} : list A -> list A -> Prop :=
| lnil: forall l, lex_leq nil l
| lcons:
forall (hd1 hd2 : A) (tl1 tl2 : list A),
R hd1 hd2 ->
(hd1 = hd2 -> lex_leq tl1 tl2) ->
lex_leq (hd1 :: tl1) (hd2 :: tl2).
You can find more information in the manual (here).
let rec merge = function
| ([], ys) -> ys
| (xs, []) -> xs
| (x::xs, y::ys) -> if x < y then x :: merge (xs, y::ys)
else y :: merge (x::xs, ys)
let rec split = function
| [] -> ([], [])
| [a] -> ([a], [])
| a::b::cs -> let (M,N) = split cs
(a::M, b::N)
let rec mergesort = function
| [] -> []
| L -> let (M, N) = split L
merge (mergesort M, mergesort N)
mergesort [5;3;2;1] // Will throw an error.
I took this code from here StackOverflow Question but when I run the mergesort with a list I get an error:
stdin(192,1): error FS0030: Value restriction. The value 'it' has been inferred to have generic type
val it : '_a list when '_a : comparison
How would I fix this problem? What is the problem? The more information, the better (so I can learn :) )
Your mergesort function is missing a case causing the signature to be inferred by the compiler to be 'a list -> 'b list instead of 'a list -> 'a list which it should be. The reason it should be 'a list -> 'a list is that you're not looking to changing the type of the list in mergesort.
Try changing your mergesort function to this, that should fix the problem:
let rec mergesort = function
| [] -> []
| [a] -> [a]
| L -> let (M, N) = split L
merge (mergesort M, mergesort N)
Another problem with your code however is that neither merge nor split is tail recursive and you will therefore get stack overflow exceptions on large lists (try to call the corrected mergesort like this mergesort [for i in 1000000..-1..1 -> i]).
You can make your split and merge functions tail recursive by using the accumulator pattern
let split list =
let rec aux l acc1 acc2 =
match l with
| [] -> (acc1,acc2)
| [x] -> (x::acc1,acc2)
| x::y::tail ->
aux tail (x::acc1) (y::acc2)
aux list [] []
let merge l1 l2 =
let rec aux l1 l2 result =
match l1, l2 with
| [], [] -> result
| [], h :: t | h :: t, [] -> aux [] t (h :: result)
| h1 :: t1, h2 :: t2 ->
if h1 < h2 then aux t1 l2 (h1 :: result)
else aux l1 t2 (h2 :: result)
List.rev (aux l1 l2 [])
You can read more about the accumulator pattern here; the examples are in lisp but it's a general pattern that works in any language that provides tail call optimization.
I was running a example of an interpreter made with Continuations, and it fails in Mono JIT compiler version 4.3.0 with a stackoverflow error despite the Tail Call optimization enabled. The same code works fine in Windows (.NET 4.6).
This is the code:
open System
open System.Runtime
let print x = printfn "%A" x
type 'data env = (string * 'data) list
let rec lookup env x =
match env with
| [] -> failwith (x + " not found")
| (y, v)::yr -> if x=y then v else lookup yr x
(* Abstract syntax of functional language with exceptions *)
type exn =
| Exn of string
type expr =
| CstI of int
| CstB of bool
| Var of string
| Let of string * expr * expr
| Prim of string * expr * expr
| If of expr * expr * expr
| Letfun of string * string * expr * expr (* (f, x, fbody, ebody) *)
| Call of string * expr
| Raise of exn
| TryWith of expr * exn * expr (* try e1 with exn -> e2 *)
type value =
| Int of int
| Closure of string * string * expr * value env (* (f, x, fBody, fDeclEnv) *)
type answer =
| Result of int
| Abort of string
let rec coEval2 (e : expr) (env : value env) (cont : int -> answer)
(econt : exn -> answer) : answer =
match e with
| CstI i -> cont i
| CstB b -> cont (if b then 1 else 0)
| Var x ->
match lookup env x with
| Int i -> cont i
| _ -> Abort "coEval2 Var"
| Prim(ope, e1, e2) ->
coEval2 e1 env
(fun i1 ->
coEval2 e2 env
(fun i2 ->
match ope with
| "*" -> cont(i1 * i2)
| "+" -> cont(i1 + i2)
| "-" -> cont(i1 - i2)
| "=" -> cont(if i1 = i2 then 1 else 0)
| "<" -> cont(if i1 < i2 then 1 else 0)
| _ -> Abort "unknown primitive") econt) econt
| Let(x, eRhs, letBody) ->
coEval2 eRhs env (fun xVal ->
let bodyEnv = (x, Int xVal) :: env
coEval2 letBody bodyEnv cont econt)
econt
| If(e1, e2, e3) ->
coEval2 e1 env (fun b ->
if b<>0 then coEval2 e2 env cont econt
else coEval2 e3 env cont econt) econt
| Letfun(f, x, fBody, letBody) ->
let bodyEnv = (f, Closure(f, x, fBody, env)) :: env
coEval2 letBody bodyEnv cont econt
| Call(f, eArg) ->
let fClosure = lookup env f
match fClosure with
| Closure (f, x, fBody, fDeclEnv) ->
coEval2 eArg env
(fun xVal ->
let fBodyEnv = (x, Int xVal) :: (f, fClosure) :: fDeclEnv
coEval2 fBody fBodyEnv cont econt)
econt
| _ -> raise (Failure "eval Call: not a function")
| Raise exn -> econt exn
| TryWith (e1, exn, e2) ->
let econt1 thrown =
if thrown = exn then coEval2 e2 env cont econt
else econt thrown
coEval2 e1 env cont econt1
(* The top-level error continuation returns the continuation,
adding the text Uncaught exception *)
let eval2 e env =
coEval2 e env
(fun v -> Result v)
(fun (Exn s) -> Abort ("Uncaught exception: " + s))
let run2 e = eval2 e []
(* Example: deep recursion to check for constant-space tail recursion *)
let exdeep = Letfun("deep", "x",
If(Prim("=", Var "x", CstI 0),
CstI 1,
Call("deep", Prim("-", Var "x", CstI 1))),
Call("deep", Var "n"));
let rundeep n = eval2 exdeep [("n", Int n)];
[<EntryPoint>]
let main argv =
rundeep 10000 |> ignore
"All fine!" |> print
0
I found that this is a problem with MONO but I wonder if there exists a way to work around this (I wish to do CSP to implement several features for the interpreter)
It is also notable that disabling the tail call optimization triggers the stackoverflow error way faster on windows than on mono/osx.
I reimplemented coEval2 using a trampoline. This function I cleverly called coEval3. coEval2 crashes for me in Debug and works in Release as expected. coEval3 seemed to work for me in both Debug and Release.
// After "jumping" the trampoline we either have a result (Done)
// or we need to "jump" again (Next)
type result<'T> =
| Done of 'T
| Next of (unit -> result<'T>)
let coEval3 (e : expr) (env : value env) (cont : int -> answer) (econt : exn -> answer) : answer =
// "Jumps" once producing either a result or a new "jump"
let rec jump (e : expr) (env : value env) (cont : int -> result<answer>) (econt : exn -> result<answer>) () : result<answer> =
match e with
| CstI i -> cont i
| CstB b -> cont (if b then 1 else 0)
| Var x ->
match lookup env x with
| Int i -> cont i
| _ -> Abort "coEval2 Var" |> Done
| Prim(ope, e1, e2) ->
jump e1 env
(fun i1 ->
jump e2 env
(fun i2 ->
match ope with
| "*" -> cont(i1 * i2)
| "+" -> cont(i1 + i2)
| "-" -> cont(i1 - i2)
| "=" -> cont(if i1 = i2 then 1 else 0)
| "<" -> cont(if i1 < i2 then 1 else 0)
| _ -> Abort "unknown primitive" |> Done) econt |> Next) econt |> Next
| Let(x, eRhs, letBody) ->
jump eRhs env (fun xVal ->
let bodyEnv = (x, Int xVal) :: env
jump letBody bodyEnv cont econt |> Next)
econt |> Next
| If(e1, e2, e3) ->
jump e1 env (fun b ->
if b<>0 then jump e2 env cont econt |> Next
else jump e3 env cont econt |> Next) econt |> Next
| Letfun(f, x, fBody, letBody) ->
let bodyEnv = (f, Closure(f, x, fBody, env)) :: env
jump letBody bodyEnv cont econt |> Next
| Call(f, eArg) ->
let fClosure = lookup env f
match fClosure with
| Closure (f, x, fBody, fDeclEnv) ->
jump eArg env
(fun xVal ->
let fBodyEnv = (x, Int xVal) :: (f, fClosure) :: fDeclEnv
jump fBody fBodyEnv cont econt |> Next)
econt |> Next
| _ -> raise (Failure "eval Call: not a function")
| Raise exn -> econt exn
| TryWith (e1, exn, e2) ->
let econt1 thrown =
if thrown = exn then jump e2 env cont econt |> Next
else econt thrown
jump e1 env cont econt1 |> Next
(* The top-level error continuation returns the continuation,
adding the text Uncaught exception *)
// If trampoline is tail-recursive F# will implement this as a loop,
// this is important for us as this means that the recursion is essentially
// turned into a loop
let rec trampoline j =
match j () with
| Done v -> v
| Next jj -> trampoline jj
let inline lift f v = f v |> Done
trampoline (jump e env (lift cont) (lift econt))
Hope this is somewhat useful