I am trying to use marices in Coq. I found la library that does exactly what I need, but being very new in Coq, I can't figure out a way to prove meaningful properties.
The library is SQIRE, and it defines a matrix as such :
Definition Matrix (m n : nat) := nat -> nat -> C.
Now, There are some working examples in the project such as:
Definition V0 : Vector 2 :=
fun x y => match x, y with
| 0, 0 => C1
| 1, 0 => C0
| _, _ => C0
end.
(so V0 is the column vector (1,0) )
Definition I (n : nat) : Matrix n n :=
(fun x y => if (x =? y) && (x <? n) then C1 else C0).
and
Lemma Mmult00 : Mmult (adjoint V0) V0 = I 1. Proof. solve_matrix. Qed.
So first thing I tried is this :
Definition test : Matrix 2 2 :=
fun x y => match x, y with
| 0, 0 => 0
| 0, 1 => 1
| 1, 0 => 2
| 1, 1 => 3
| _, _ => 0
end.
Definition test2 : Matrix 2 2 :=
fun x y => match x, y with
| 0, 0 => 0
| 0, 1 => 2
| 1, 0 => 4
| 1, 1 => 6
| _, _ => 0
end.
Lemma double : test2 = 2 .* test. Proof. solve_matrix. Qed.
And no luck Here. So I then tried no enumerate the cases :
Lemma testouille : test2 = 2 .* test.
Proof.
autounfold with U_db.
prep_matrix_equality.
assert (x = 0 \/ x = 1 \/ x >= 2)%nat as X.
omega.
destruct X as [X|X].
- { (* x = 0 *)
subst.
assert (y = 0 \/ y = 1 \/ y >= 2)%nat as Y.
omega.
destruct Y as [Y|Y].
- { (* y = 0 *)
subst.
simpl.
field.
}
- {
destruct Y as [Y|Y].
- { (* y = 1 *)
subst.
simpl.
field.
}
- { (* y >= 2 *)
subst. (* I can't operate for each y, recursions ?*)
simpl.
field.
}
}
}
- {
destruct X as [X|X].
- { (* x = 1 *)
subst.
assert (y = 0 \/ y = 1 \/ y >= 2)%nat as Y.
omega.
destruct Y as [Y|Y].
- { (* y = 0 *)
subst.
simpl.
field.
}
- {
destruct Y as [Y|Y].
- { (* y = 1 *)
subst.
simpl.
field.
}
- { (* y >= 2 *)
subst. (* I can't operate for each y, recursions ?*)
simpl.
field.
}
}
}
- { (* x >= 2, I can't operate for each x, recursions ?*)
subst.
simpl.
field.
}
}
Qed.
But this didn't work either, Coq seems to be unable to guess that if x is greater than 1, then test x y is zero. And at this point, I'm a bit short on ideas. Can somebody come to my rescue ?
It looks like solve_matrix just doesn't know what test and test2 are to unfold them.
Here are two possible solutions:
Lemma double : test2 = 2 .* test. Proof. unfold test, test2. solve_matrix. Qed.
Hint Unfold test test2 : U_db.
Lemma double' : test2 = 2 .* test. Proof. solve_matrix. Qed.
For the longer proof, you're going to have to actually destruct y twice so Coq can pattern match on it (you can use omega to solve the other cases). There's also a tactic called destruct_m_eq that will do the work of breaking things down into cases for you. Here's a shorter manual proof of your lemma:
Lemma testouille : test2 = 2 .* test.
Proof.
autounfold with U_db.
prep_matrix_equality.
unfold test, test2.
destruct_m_eq.
all: lca.
Qed.
Relatedly, I recommend the tactics lia and lra for solving integer and real equalities, and the derived tactic lca for complex number equalities. (field seemed to fail in a few instance in your proof.)
For a lighter introduction to QWIRE's matrix library (used by SQIR), I recommend Verified Quantum Computing, though it does make some changes not reflected in the main branch of QWIRE.
Related
I have a haskell assignment in which i have to create a function lastDigit x y of 2 arguments that calculates the sum of all [x^x | (0..x)], mine is too slow and i need to speed it up. Anyone has any ideas??
list :: Integral x=>x->[x]
list 0 = []
list x = list(div x 10) ++ [(mod x 10)]
sqrall :: Integer->[Integer]
sqrall x y = [mod (mod x 10^y)^x 10^y | x <- [1..x]]
lastDigits :: Integer -> Int -> [Integer]
lastDigits x y = drop (length((list(sum (sqrall x y))))-y) (list(sum (sqrall x)))
The main reason this will take too long is because you calculate the entire number of x^x, which scales super exponentially. This means that even for very small x, it will still take a considerable amount of time.
The point is however that you do not need to calculate the entire number. Indeed, you can make use of the fact that x×y mod n = (x mod n) × (y mod n) mod n. For example Haskell's arithmoi package makes use of this [src]:
powMod :: (Integral a, Integral b) => a -> b -> a -> a
powMod x y m
| m <= 0 = error "powModInt: non-positive modulo"
| y < 0 = error "powModInt: negative exponent"
| otherwise = f (x `rem` m) y 1 `mod` m
where
f _ 0 acc = acc
f b e acc = f (b * b `rem` m) (e `quot` 2)
(if odd e then (b * acc `rem` m) else acc)
We can make a specific version for modulo 10 with:
pow10 :: Integral i => i -> i
pow10 x = go x x
where go 0 _ = 1
go i j | odd i = rec * j `mod` 10
| otherwise = rec
where rec = go (div i 2) ((j*j) `mod` 10)
This then matches x^x `mod` 10, except that we do not need to calculate the entire number:
Prelude> map pow10 [1 .. 20]
[1,4,7,6,5,6,3,6,9,0,1,6,3,6,5,6,7,4,9,0]
Prelude> [x^x `mod` 10 | x <- [1..20]]
[1,4,7,6,5,6,3,6,9,0,1,6,3,6,5,6,7,4,9,0]
Now that we have that, we can also calculate the the sum of the two last digits with integers that range to at most 18:
sum10 :: Int -> Int -> Int
sum10 x y = (x + y) `mod` 10
we thus can calculate the last digit with:
import Data.List(foldl')
lastdigit :: Int -> Int
lastdigit x = foldl' sum10 0 (map pow10 [0 .. x])
For example for x = 26, we get:
Prelude Data.List> lastdigit 26
4
Prelude Data.List> sum [ x^x | x <- [0 .. 26] ]
6246292385799360560872647730684286774
I keep it as an exercise to generalize the above to calculate it for the last y digits. As long as y is relatively small, this will be efficient, since then the numbers never take huge amounts of memory. Furthermore if the numbers have an upper bound, addition, multiplication, etc. are done in constant time. If you however use an Integer, then the numbers can be arbitrary large, and thus operations like addition are not constant.
Here is a definition of polymorphic binary trees I am using in a Coq project.
Inductive tree { X : Type } : Type :=
| t_a : X -> tree
| t_m : tree -> tree -> tree.
A binary tree of natural numbers ( 1 ( ( 2 3 ) 4 ) ), declared using this definition, would be:
t_m ( t_a 1 ) ( t_m ( t_m ( t_a 2 ) ( t_a 3 ) ) ( t_a 4 ) )
As you can see, the definition becomes unusable very quickly with increasing number of leaves. What I want to do is define an Unlambda-style notation for trees so that I can replace the above with
' 1 ' ' 2 3 4
Is this possible?
I tried to get a solution that used only Coq notations, but couldn't get it to work. I suspect that Coq's extensible parser is not powerful enough to understand the notation you want. There is, however, a poor man's solution that involves dependent types. The idea is to write a parser for that notation and use that parser's type to encode the parser state. The type says that the parser "reads" some token (actually, takes that token as an argument to a function call), and goes into some next state that depends on the token it just read.
There's a small subtlety, though, which is that one cannot write that type using just regular Coq function types, because the number of arguments that function would take would depend on all the arguments it is being applied to. One solution is to use a coinductive type to encode this behavior, declaring a coercion to make it look like a function:
Inductive tree (X : Type) : Type :=
| t_a : X -> tree X
| t_m : tree X -> tree X -> tree X.
Arguments t_a {X} _.
Arguments t_m {X} _ _.
CoInductive tree_builder X : nat -> Type :=
| TbDone : tree X -> tree_builder X 0
| TbRead : forall n, (forall o : option X, tree_builder X match o with
| Some x => n
| None => S (S n)
end) ->
tree_builder X (S n).
Arguments TbDone {X} _.
Arguments TbRead {X} _ _.
(* Destructors for tree_builder *)
Definition case0 {X} (x : tree_builder X 0) : tree X :=
match x with
| TbDone t => t
end.
Definition caseS {X n} (x : tree_builder X (S n)) :
forall o : option X, tree_builder X match o with
| Some x => n
| None => S (S n)
end :=
match x with
| TbRead _ f => f
end.
Definition tb X n := tree_builder X (S n).
(* force is what does the magic here: it takes a tb and coerces it to a
function that may produce another tb, depending on what it is applied to. *)
Definition force X n (x : tb X n) : forall o : option X,
match o with
| Some x =>
match n with
| 0 => tree X
| S n' => tb X n'
end
| None =>
tb X (S n)
end :=
fun o =>
match o return tree_builder X match o with
| Some x => n
| None => S (S n)
end ->
match o with
| Some x => match n with
| 0 => tree X
| S n' => tb X n'
end
| None => tb X (S n)
end
with
| Some x => match n return tree_builder X n -> match n with
| 0 => tree X
| S n' => tb X n'
end
with
| 0 => fun t => case0 t
| S _ => fun t => t
end
| None => fun t => t
end (caseS x o).
Coercion force : tb >-> Funclass.
Our parser, then, is just a term of type tb X 0. As it is usually done, it has to be written in continuation-passing style because of the variable number of arguments.
Fixpoint parser_cont_type X (n : nat) : Type :=
match n with
| 0 => tree X
| S n' => tree X -> parser_cont_type X n'
end.
CoFixpoint parser X n : parser_cont_type X n -> tree_builder X n :=
match n with
| 0 => fun k => TbDone k
| S n' => fun k : tree X -> parser_cont_type X n' =>
TbRead n' (fun o => match o return tree_builder X match o with
| Some _ => n'
| None => S (S n')
end
with
| Some x => parser X n' (k (t_a x))
| None => parser X (S (S n')) (fun (t1 t2 : tree X) => k (t_m t1 t2))
end)
end.
Definition parser' X : tb X 0 :=
parser X 1 (fun t => t).
Next, we can define some extra notation to make this easier to use:
Notation "[ x ]" := (Some x) (at level 0).
Notation "''" := None (at level 0).
Notation "!" := (parser' _) (at level 20).
Here's how one could write your example tree, for instance:
Definition my_tree : tree nat := Eval hnf in ! '' [1] '' '' [2] [3] [4].
Notice the initial ! to start a call to the parser, and the [] that are needed to mark the leaves. I also couldn't get Coq's parser to accept ' as a token on its own. Besides these minor details, however, it is fairly close to what you had.
One problem is that, because the parser is defined using Coq functions, one needs to do a little bit of simplification to get a term that is exactly like the one you had originally. This is why I added the Eval call on the definition. This is probably not as practical as a real notation, and the definition is admittedly a bit tricky, but it could be pretty useful for some cases.
Here's a gist with the entire .v file.
UPDATE: I've written a post with a much simplified version of this technique made more generic.
A friend of mine showed me a home exercise in a C++ course which he attend. Since I already know C++, but just started learning Haskell I tried to solve the exercise in the "Haskell way".
These are the exercise instructions (I translated from our native language so please comment if the instructions aren't clear):
Write a program which reads non-zero coefficients (A,B,C,D) from the user and places them in the following equation:
A*x + B*y + C*z = D
The program should also read from the user N, which represents a range. The program should find all possible integral solutions for the equation in the range -N/2 to N/2.
For example:
Input: A = 2,B = -3,C = -1, D = 5, N = 4
Output: (-1,-2,-1), (0,-2, 1), (0,-1,-2), (1,-1, 0), (2,-1,2), (2,0, -1)
The most straight-forward algorithm is to try all possibilities by brute force. I implemented it in Haskell in the following way:
triSolve :: Integer -> Integer -> Integer -> Integer -> Integer -> [(Integer,Integer,Integer)]
triSolve a b c d n =
let equation x y z = (a * x + b * y + c * z) == d
minN = div (-n) 2
maxN = div n 2
in [(x,y,z) | x <- [minN..maxN], y <- [minN..maxN], z <- [minN..maxN], equation x y z]
So far so good, but the exercise instructions note that a more efficient algorithm can be implemented, so I thought how to make it better. Since the equation is linear, based on the assumption that Z is always the first to be incremented, once a solution has been found there's no point to increment Z. Instead, I should increment Y, set Z to the minimum value of the range and keep going. This way I can save redundant executions.
Since there are no loops in Haskell (to my understanding at least) I realized that such algorithm should be implemented by using a recursion. I implemented the algorithm in the following way:
solutions :: (Integer -> Integer -> Integer -> Bool) -> Integer -> Integer -> Integer -> Integer -> Integer -> [(Integer,Integer,Integer)]
solutions f maxN minN x y z
| solved = (x,y,z):nextCall x (y + 1) minN
| x >= maxN && y >= maxN && z >= maxN = []
| z >= maxN && y >= maxN = nextCall (x + 1) minN minN
| z >= maxN = nextCall x (y + 1) minN
| otherwise = nextCall x y (z + 1)
where solved = f x y z
nextCall = solutions f maxN minN
triSolve' :: Integer -> Integer -> Integer -> Integer -> Integer -> [(Integer,Integer,Integer)]
triSolve' a b c d n =
let equation x y z = (a * x + b * y + c * z) == d
minN = div (-n) 2
maxN = div n 2
in solutions equation maxN minN minN minN minN
Both yield the same results. However, trying to measure the execution time yielded the following results:
*Main> length $ triSolve' 2 (-3) (-1) 5 100
3398
(2.81 secs, 971648320 bytes)
*Main> length $ triSolve 2 (-3) (-1) 5 100
3398
(1.73 secs, 621862528 bytes)
Meaning that the dumb algorithm actually preforms better than the more sophisticated one. Based on the assumption that my algorithm was correct (which I hope won't turn as wrong :) ), I assume that the second algorithm suffers from an overhead created by the recursion, which the first algorithm isn't since it's implemented using a list comprehension.
Is there a way to implement in Haskell a better algorithm than the dumb one?
(Also, I'll be glad to receive general feedbacks about my coding style)
Of course there is. We have:
a*x + b*y + c*z = d
and as soon as we assume values for x and y, we have that
a*x + b*y = n
where n is a number we know.
Hence
c*z = d - n
z = (d - n) / c
And we keep only integral zs.
It's worth noticing that list comprehensions are given special treatment by GHC, and are generally very fast. This could explain why your triSolve (which uses a list comprehension) is faster than triSolve' (which doesn't).
For example, the solution
solve :: Integer -> Integer -> Integer -> Integer -> Integer -> [(Integer,Integer,Integer)]
-- "Buffalo buffalo buffalo buffalo Buffalo buffalo buffalo..."
solve a b c d n =
[(x,y,z) | x <- vals, y <- vals
, let p = a*x +b*y
, let z = (d - p) `div` c
, z >= minN, z <= maxN, c * z == d - p ]
where
minN = negate (n `div` 2)
maxN = (n `div` 2)
vals = [minN..maxN]
runs fast on my machine:
> length $ solve 2 (-3) (-1) 5 100
3398
(0.03 secs, 4111220 bytes)
whereas the equivalent code written using do notation:
solveM :: Integer -> Integer -> Integer -> Integer -> Integer -> [(Integer,Integer,Integer)]
solveM a b c d n = do
x <- vals
y <- vals
let p = a * x + b * y
z = (d - p) `div` c
guard $ z >= minN
guard $ z <= maxN
guard $ z * c == d - p
return (x,y,z)
where
minN = negate (n `div` 2)
maxN = (n `div` 2)
vals = [minN..maxN]
takes twice as long to run and uses twice as much memory:
> length $ solveM 2 (-3) (-1) 5 100
3398
(0.06 secs, 6639244 bytes)
Usual caveats about testing within GHCI apply -- if you really want to see the difference, you need to compile the code with -O2 and use a decent benchmarking library (like Criterion).
I have to write a function which returns a list of all pairs (x,y) where x,
y ∈ N , and:
x is the product of two natural numbers (x = a • b, where a, b ∈ N) and
x is really bigger than 5 but really smaller than 500, and
y is a square number (y = c² where c ∈ N) NOT greater than 1000, and
x is a divisor of y.
My attempt:
listPairs :: [(Int, Int)]
listPairs = [(a*b, y) | y <- [0..], a <- [0..], b <- [0..],
(a*b) > 5, (a*b) < 500, (y*y) < 1001,
mod y (a*b) == 0]
But it doesn't return anything and the computer works a lot on it.
However if I choose a smaller range for a, b and y e. g. [0..400], it takes up to a minute but it returns the right result.
So how could I solve the performance issue?
So, of course nested list comprehensions on infinite lists do not terminate.
Fortunately, your lists are not infinite. There's a limit. If x = a*b < 500, then we know that it must be a < 500 and b < 500. Also, c = y*y < 1001 is just y < 32. So,
listPairs :: [(Int, Int)]
listPairs =
[(x, c*c) | c <- [1..31], a <- [1..499], -- a*b < 500 ==> b<500/a ,
b <- [a..min 499 (div 500 a)], -- a*b==b*a ==> b >= a
let x = a*b, x > 5,
-- (a*b) < 500, (c*c) < 1001, -- no need to test this
rem (c*c) x == 0]
mod 0 n == 0 trivially holds, so I'm excluding 0 from "natural numbers" here.
There are still some duplicates produced here, even though we've limited the b value to b >= a in x=a*b, because x can have several representations (e.g. 1*6 == 2*3).
You can use Data.List.nub to get rid of them.
I'm trying to implement the following recursive definition for addition in F#
m + 0 := m
m + (n + 1) := (m + n) + 1
I can't seem to get the syntax correct, The closest I've come is
let rec plus x y =
match y with
| 0 -> x;
| succ(y) -> succ( plus(x y) );
Where succ n = n + 1. It throws an error on pattern matching for succ.
I'm not sure what succ means in your example, but it is not a pattern defined in the standard F# library. Using just the basic functionality, you'll need to use a pattern that matches any number and then subtract one (and add one in the body):
let rec plus x y =
match y with
| 0 -> x
| y -> 1 + (plus x (y - 1))
In F# (unlike e.g. in Prolog), you can't use your own functions inside patterns. However, you can define active patterns that specify how to decompose input into various cases. The following takes an integer and returns either Zero (for zero) or Succ y for value y + 1:
let (|Zero|Succ|) n =
if n < 0 then failwith "Unexpected!"
if n = 0 then Zero else Succ(n - 1)
Then you can write code that is closer to your original version:
let rec plus x y =
match y with
| Zero -> x
| Succ y -> 1 + (plus x y)
As Tomas said, you can't use succ like this without declaring it. What you can do is to create a discriminated union that represents a number:
type Number =
| Zero
| Succ of Number
And then use that in the plus function:
let rec plus x y =
match y with
| Zero -> x
| Succ(y1) -> Succ (plus x y1)
Or you could declare it as the + operator:
let rec (+) x y =
match y with
| Zero -> x
| Succ(y1) -> Succ (x + y1)
If you kept y where I have y1, the code would work, because the second y would hide the first one. But I think doing so makes the code confusing.
type N = Zero | Succ of N
let rec NtoInt n =
match n with
| Zero -> 0
| Succ x -> 1 + NtoInt x
let rec plus x y =
match x with
| Zero -> y
| Succ n -> Succ (plus n y)
DEMO:
> plus (Succ (Succ Zero)) Zero |> NtoInt ;;
val it : int = 2
> plus (Succ (Succ Zero)) (Succ Zero) |> NtoInt ;;
val it : int = 3
let rec plus x y =
match y with
| 0 -> x
| _ -> plus (x+1) (y-1)