How to add two rational in agda? - algebra

How to add two rational.. I was trying this but this is not correct. As I am unable to prove that coprime part.
open import Data.Rational
open import Data.Integer
open import Data.Nat
_add_ : ℚ -> ℚ -> ℚ
x add y = (nx Data.Integer.* dy Data.Integer.+ dx Data.Integer.* ny) ÷
(dx′ Data.Nat.* dy′)
where
nx = ℚ.numerator x
dx = ℚ.denominator x
dx′ = ℕ.suc (ℚ.denominator-1 x)
ny = ℚ.numerator y
dy = ℚ.denominator y
dy′ = ℕ.suc (ℚ.denominator-1 y)

You need to simplify (nx * dy + dx * ny) / (dx * dy) to ensure its numerator and denominator are coprimes.
The following code shows you the core of the solution by simplifying a pair of natural numbers x and suc y-1 (i.e. a non-zero y). Extending it to handle the signs of the numerator should be an easy exercise. The heavy lifting is done by Data.Nat.Coprimality.Bézout-coprime.
open import Data.Nat
open import Data.Nat.GCD
open import Data.Nat.Coprimality hiding (sym)
open import Relation.Binary.PropositionalEquality
open import Data.Product
open import Data.Nat.Divisibility
open import Data.Empty
record Simp (x : ℕ) (y : ℕ) : Set where
constructor MkSimp
field
x′ y′ : ℕ
eq-prf : x * y′ ≡ x′ * y
coprime-prf : Coprime x′ y′
1+≢*0 : ∀ x y → suc x ≢ y * 0
1+≢*0 x zero ()
1+≢*0 x (suc y) = 1+≢*0 x y
simp : ∀ x y-1 → Simp x (suc y-1)
simp x y-1 with Bézout.lemma x (suc y-1)
simp x y-1 | Bézout.result 0 (GCD.is (_ , divides y′ y-eq) _) _ = ⊥-elim (1+≢*0 y-1 y′ y-eq)
simp x y-1 | Bézout.result (suc d-1) (GCD.is (divides x′ x-eq , divides y′ y-eq) _) bézout = MkSimp x′ y′ eq-prf (Bézout-coprime bézout′)
where
y = suc y-1
d = suc d-1
bézout′ : Bézout.Identity d (x′ * d) (y′ * d)
bézout′ = subst₂ (Bézout.Identity d) x-eq y-eq bézout
open Relation.Binary.PropositionalEquality.≡-Reasoning
open import Data.Nat.Properties.Simple
eq-prf : x * y′ ≡ x′ * y
eq-prf = begin
x * y′ ≡⟨ cong (λ z → z * y′) x-eq ⟩
x′ * d * y′ ≡⟨ *-assoc x′ d y′ ⟩
x′ * (d * y′) ≡⟨ sym (cong (_*_ x′) (*-comm y′ d)) ⟩
x′ * (y′ * d) ≡⟨ sym (cong (_*_ x′) y-eq) ⟩
x′ * y ∎

Related

How to perform multiple exists-eliminations that all share a single multivariate universally-quantified hypothesis?

The Lean documentation shows the following two examples with just a single variable:
from Theorem Proving in Lean: Existential Quantifiers:
variables (α : Type) (p q : α → Prop)
example (h : ∃ x, p x ∧ q x) : ∃ x, q x ∧ p x :=
exists.elim h
(assume w,
assume hw : p w ∧ q w, -- this is ∀ w, p w ∧ q w
show ∃ x, q x ∧ p x, from ⟨w, hw.right, hw.left⟩)
from Logic and Proof: Using the Existential Quantifier ***:
variables (U : Type) (P : U → Prop) (Q : Prop)
example (h1 : ∃ x, P x) (h2 : ∀ x, P x → Q) : Q :=
exists.elim h1
(assume (y : U) (h : P y),
have h3 : P y → Q, from h2 y,
show Q, from h3 h)
In both cases the universal hypothesis (h2 in the former example, hw in the latter) only depends on one variable.
Now suppose that we got (I paraphrase the original problem):
variables (U : Type) (P R: U → Prop)(Q : Prop)
example (h1a : ∃ x, P x) (h1b : ∃ x, R x) (h2 : ∀ x y, P x → R y → Q) : Q := sorry
In h2, imagine that P and R are like nat.is_even, and Q is like "x,y form a pair of even numbers".
The interior derivation that exists.elim needs, I imagine, would go like:
(assume (y z : U) (ha : P y) (hb : R z),
have h3 : P y → R z → Q, from h2 y z,
show Q, from h4 h1a h1b)
But I'm not sure how to use it with exists elimination - since essentially two eliminations need to be done at once. exists.elim h1a (exists.elim h1b (assume ... show Q, from ...)) doesn't work it seems.
This works for me
example (h1a : ∃ x, P x) (h1b : ∃ x, R x) (h2 : ∀ x y, P x → R y → Q) : Q :=
exists.elim h1a (exists.elim h1b (assume (x : U) (hRx : R x) (y : U) (hPy : P y), _))
There are other ways of doing this. One is to use let
example (h1a : ∃ x, P x) (h1b : ∃ x, R x) (h2 : ∀ x y, P x → R y → Q) : Q :=
let ⟨x, hPx⟩ := h1a in
let ⟨y, hRy⟩ := h1b in
_
Another way is to use the cases tactic in tactic mode
example (h1a : ∃ x, P x) (h1b : ∃ x, R x) (h2 : ∀ x y, P x → R y → Q) : Q :=
begin
cases h1a with x hPx,
cases h1b with y hRy,
end

How do I prove the simplified Chinese Remainder Theorem?

I've managed to prove
Theorem modulo_inv : forall m n : Z, rel_prime m n -> exists x : Z, (m * x == 1 [n]). Admitted.
My question is how to finish the following proof (maybe using the modulo_inv theorem?):
Variables m n : Z.
Hypothesis co_prime : rel_prime m n.
Theorem SimpleChineseRemainder :
forall a b : Z, exists x : Z, (x == a [m]) /\ (x == b [n]).
Here is what I tried, but I don't know whether it is correct or not.
Proof.
intros a b.
exists ((a * n) * (n ^ (-1) mod m) + (b * m) * (m ^ (-1) mod n)).
refine (conj _ _).
(* case : ((a * n) * (n ^ (-1) mod m) + (b * m) * (m ^ (-1) mod n) == a [m]) *)
red.
rewrite Z.add_sub_swap.
apply Z.divide_add_r.
(* case : ((a * n) * (n ^ (-1) mod m) + (b * m) * (m ^ (-1) mod n) == b [n]) *)
Can anybody provide any suggestions?
Code-golfing Anton's answer, I was hoping that ring would be clever enough to use the Eq information, and that the proof would simply be
Theorem SimpleChineseRemainder' a b : exists x : Z, (x == a [m]) /\ (x == b [n]).
Proof.
destruct (rel_prime_bezout _ _ co_prime) as [u v Eq];
exists (a * v * n + b * u * m); split ; [ exists ((b-a)*u) | exists ((a-b)*v)]; ring.
Qed.
Unfortunately it didn't automatically exploit that u * m + v * n = 1 -> u * m = 1 - v * n. So until we have a stronger tactic, I guess that has to be added manually, like so:
Theorem SimpleChineseRemainder' a b : exists x : Z, (x == a [m]) /\ (x == b [n]).
Proof.
destruct (rel_prime_bezout _ _ co_prime) as [u v Eq].
exists (a * (v * n) + b * (u * m)); split ; [ exists ((b-a)*u) | exists ((a-b)*v)].
- replace (v*n) with (1-u*m) by (rewrite <- Eq; ring); ring.
- replace (u*m) with (1-v*n) by (rewrite <- Eq; ring); ring.
Qed.
EDIT: The nsatz tactic is able to solve the equation system. However, it introduces a notation for [ ... ] that conflicts with the notation introduced above, and I don't know how to handle that. However, by changing the notation to i.e. [[ ... ]], the proof becomes just two lines:
Require Import Nsatz.
Theorem SimpleChineseRemainder' a b :
exists x : Z, (x == a [[m]]) /\ (x == b [[n]]).
Proof.
destruct (rel_prime_bezout _ _ co_prime) as [u v Eq];
exists (a * v * n + b * u * m); split ; [ exists ((b-a)*u) | exists ((a-b)*v)]; nsatz.
Qed.
Reusing the proof from Wikipedia which is based on Bézout's lemma, we get the following:
From Coq Require Import ZArith Znumtheory.
Import Z.
Definition modulo (a b n : Z) : Prop := (n | (a - b)).
Notation "a == b [ n ]" := (modulo a b n) (at level 50).
Section SimpleChineseRemainder.
Variables m n : Z.
Hypothesis co_prime : rel_prime m n.
Theorem SimpleChineseRemainder a b : exists x : Z, (x == a [[m]]) /\ (x == b [[n]]).
Proof.
destruct (rel_prime_bezout _ _ co_prime) as [u v Eq].
exists (a * v * n + b * u * m); split; [| rewrite add_comm in *];
match goal with |- _ == ?c [_] => replace c with (c * 1) at 2 by apply mul_1_r end;
rewrite <-Eq, mul_add_distr_l, !mul_assoc;
now eexists; rewrite add_add_simpl_l_r, <-mul_sub_distr_r.
Qed.
End SimpleChineseRemainder.

Coq: Insufficient Justification error

I am new to Coq and am getting an Insufficient Justification error for hypothesis H3. I tried rewriting it several times but the error persists. Could someone please explain why? Thanks.
Section GroupTheory.
Variable G: Set.
Variable operation: G -> G -> G.
Variable e : G.
Variable inv : G -> G.
Infix "*" := operation.
Hypothesis associativity : forall x y z : G, (x * y) * z = x * (y * z).
Hypothesis identity : forall x : G, exists e : G, (x * e = x) /\ (e * x = x).
Hypothesis inverse : forall x : G, (x * inv x = e) /\ (inv x * x = e).
Theorem latin_square_property :
forall a b : G, exists x : G, a * x = b.
proof.
let a : G, b : G.
take (inv a * b).
have H1:(a * (inv a * b) = (a * inv a) * b) by associativity.
have H2:(a * inv a = e) by inverse.
have H3:(e * b = b) by identity.
have (a * (inv a * b) = (a * inv a) * b) by H1.
~= (e * b) by H2.
~= (b) by H3.
hence thesis.
end proof.
Qed.
End GroupTheory.
The reason is that your identity axiom is independent of the unit e, defined in the section, because you've bound e with the existential quantifier in the definition of the identity axiom.
We can amend identity, getting rid of exists e in the definition:
Hypothesis identity : forall x : G, (x * e = x) /\ (e * x = x).
After that you'll be able to finish your proof.

How to prove x + y - z = x + (y - z) in Coq

I want to prove this :
1 subgoals
x : nat
y : nat
z : nat
______________________________________(1/1)
x + y - z = x + (y - z)
It looks trivial, but it confuse me a lot, and I need it for another proof.
Thanks.
What you're trying to prove doesn't hold if y <= z, because with nat a-b is zero if a <= b.
Omega is a useful tactic to use for inequalities and simple arithmetic over nat.
Require Import Omega.
Theorem foo:
forall x y z:nat, (x = 0 \/ z <= y) <-> x + y - z = x + (y - z).
intros; omega.
Qed.
However, your identity of course holds for the integers Z.
Require Import ZArith.
Open Scope Z.
Theorem fooZ:
forall x y z:Z, x + y - z = x + (y - z).
intros; omega.
Qed.

Isabelle: this lemma about polynomials is only provable for idoms

In short: I have only a backgroung in computer science and not mathematics. I have proven a lemma in Isabelle for idoms and concluded that it cannot be proven for polynomials of rings 'a::comm_ring_1 poly. But I am not fully sure.
In the Isabelle library, there is the following lemma:
Polynomial.coeff_mult_degree_sum:
coeff (p * q) (degree p + degree q) = coeff p (degree p) * coeff q (degree q)
(where (p∷?'a∷comm_semiring_0 poly) and (q∷?'a∷comm_semiring_0 poly); the lemma is from HOL/Library/Polynomial.thy)
I have proven the following lemma in Isabelle (product/sum of polynomials):
lemma coeff_mult_setprod_setsum:
fixes S :: "'b::idom poly set"
shows "finite S ⟹ coeff (setprod (λx. x) S) (setsum (λx. degree x) S) = setprod (λ x. coeff x (degree x)) S"
by (induct rule: finite_induct, simp, simp_all add: coeff_setprod_setsum_induct_step)
My question:
Is it true that the above lemma requires idoms (i.e., without zero divisors) and cannot be proven for S :: "'a::comm_ring_1 poly set"?
..
..
Here is the full proof:
(* tested with Isabelle2013-2 *)
theory Notepad
imports
Main
"~~/src/HOL/Library/Polynomial"
begin
lemma degree_product_setsum:
fixes S :: "('a::comm_ring_1) poly set"
assumes "finite S"
shows "degree (∏S) ≤ setsum degree S"
using `finite S`
proof-
(* Sledgehammer proof *)
have th1: "⋀x⇩1 x⇩2 x⇩3. degree ((x⇩1∷'a poly) * x⇩2) ≤ degree x⇩1 + x⇩3 ∨ ¬ degree x⇩2 ≤ x⇩3"
by (metis add_le_cancel_right degree_mult_le dual_order.trans nat_add_commute)
show ?thesis using `finite S`
apply(induct)
apply(simp)
by (metis (full_types) th1 setprod.insert setsum.insert)
qed
lemma coeff_setprod_setsum_induct_step:
fixes x :: "'b::idom poly" and F :: "'b::idom poly set"
assumes a1: "finite F"
and a2: "x ∉ F"
and a3: "coeff (∏F) (setsum degree F) = (∏x∷'b poly∈F. coeff x (degree x))"
shows "coeff (x * ∏F) (degree x + setsum degree F) = coeff x (degree x) * (∏x∈F. coeff x (degree x))"
proof-
from coeff_mult_degree_sum[of x "∏F"]
have 1: "coeff (x * ∏F) (degree x + degree (∏F)) = coeff x (degree x) * coeff (∏F) (degree (∏F))" by fast
from a1
have 3: "degree (∏F) ≤ setsum degree F" using degree_product_setsum by fast
(** BEWARE SLEDGEHAMMER PROOF! (don't care at the moment about it) *)
show ?thesis
proof -
have "(∏R∈F. coeff R (degree R)) = 0 ∨ setsum degree F ≤ degree (∏F)"
by (metis a3 le_degree)
hence f1: "setsum degree F = degree (∏F) ∨ (∏R∈F. coeff R (degree R)) = 0"
by (metis "3" le_antisym)
have f2: "setsum degree F = degree (∏F) ∨ ¬ setsum degree F ≤ degree (∏F)"
by (metis "3" le_antisym)
hence "coeff (∏F) (degree (∏F)) = (∏R∈F. coeff R (degree R)) ⟶ coeff x (degree x) * (∏R∈F. coeff R (degree R)) = coeff (x * ∏F) (degree (x * ∏F))"
by (metis (full_types) "1" degree_mult_eq leading_coeff_0_iff mult_eq_0_iff)
moreover
{ assume "coeff (∏F) (degree (∏F)) ≠ (∏R∈F. coeff R (degree R))"
hence "setsum degree F ≠ degree (∏F)"
using a3 by force }
moreover
{ assume "coeff x (degree x) * (∏R∈F. coeff R (degree R)) = coeff (x * ∏F) (degree (x * ∏F))"
hence "setsum degree F = degree (∏F) ⟶ coeff (x * ∏F) (degree x + setsum degree F) = coeff x (degree x) * (∏R∈F. coeff R (degree R))"
by (metis (lifting, no_types) "1" calculation(2))}
ultimately have "setsum degree F = degree (∏F) ⟶ coeff (x * ∏F) (degree x + setsum degree F) = coeff x (degree x) * (∏R∈F. coeff R (degree R))"
by fastforce
hence "setsum degree F ≠ degree (∏F) ∧ ¬ degree x + setsum degree F ≤ degree x + degree (∏F) ∨ coeff (x * ∏F) (degree x + setsum degree F) = coeff x (degree x) * (∏R∈F. coeff R (degree R))"
using f2 add_le_cancel_left by blast
hence "setsum degree F ≠ degree (∏F) ∧ coeff (x * ∏F) (degree x + setsum degree F) = 0 ∨ coeff (x * ∏F) (degree x + setsum degree F) = coeff x (degree x) * (∏R∈F. coeff R (degree R))"
by (metis (full_types) coeff_0 degree_mult_eq le_degree mult_eq_0_iff)
thus "coeff (x * ∏F) (degree x + setsum degree F) = coeff x (degree x) * (∏x∈F. coeff x (degree x))"
using f1 by force
qed
qed
lemma coeff_setprod_setsum:
fixes S :: "'b::idom poly set" (* lemma is not true for S :: "'a::comm_ring_1 poly set"*)
shows "finite S ⟹ coeff (setprod (λx. x) S) (setsum (λx. degree x) S) = setprod (λ x. coeff x (degree x)) S"
by (induct rule: finite_induct, simp, simp_all add: coeff_setprod_setsum_induct_step)
Looking at three polynomials, the problem is visible:
notepad
begin
fix p q r :: "'a::comm_ring_1 poly"
have "coeff (p * q * r) (degree (p * q) + degree r) = coeff (p * q) (degree (p * q)) * coeff r (degree r)"
using Polynomial.coeff_mult_degree_sum[of "p * q" r] by fast
end
However, it is impossible to imply that degree (p * q) is equal to degree p + degree q for the type 'a::comm_ring_1 poly.
Consider this lemma that requires idoms:
Polynomial.degree_mult_eq: (?p∷?'a∷idom poly) ≠ (0∷?'a∷idom poly) ⟹ (?q∷?'a∷idom poly) ≠ (0∷?'a∷idom poly) ⟹
degree (?p * ?q) = degree ?p + degree ?q
..
..
..
Solution from Brian Huffman
lemma degree_setprod_le: "degree (∏i∈S. f i) ≤ (∑i∈S. degree (f i))"
apply(cases "finite S", simp_all, induct rule: finite_induct, simp_all)
by (metis (lifting) degree_mult_le dual_order.trans nat_add_left_cancel_le)
lemma coeff_mult_sum: "degree p ≤ m ⟹ degree q ≤ n ⟹ coeff (p * q) (m + n) = coeff p m * coeff q n"
apply(cases "degree p = m ∧ degree q = n")
apply(insert coeff_mult_degree_sum[of p q], simp) [1]
apply(cases "degree p < m", cases "degree q < n")
by(insert coeff_eq_0[of q n] coeff_eq_0[of p m] degree_mult_le[of p q] coeff_eq_0[of "p*q" "m + n"], simp_all)
lemma coeff_mult_setprod_setsum:
"coeff (setprod (λx. x) S) (setsum (λx. degree x) S) = setprod (λ x. coeff x (degree x)) S"
by(cases "finite S", induct rule: finite_induct, simp_all add: coeff_mult_sum degree_setprod_le)
Yes, your lemma coeff_mult_setprod_setsum is in fact provable for arbitrary comm_ring_1 types. The reason it works without the idom class constraint is that you are never actually computing the degree of the result of a polynomial multiplication, you only are using the degrees of the factors.
I was able to prove this by induction on S using the following two lemmas:
lemma degree_setprod_le: "degree (∏i∈S. f i) ≤ (∑i∈S. degree (f i))" Proof is by cases on whether S is finite, followed by induction on S, and using library lemma degree_mult_le to solve the inductive step.
lemma coeff_mult_sum: "degree p ≤ m ⟹ degree q ≤ n ⟹ coeff (p * q) (m + n) = coeff p m * coeff q n" Proof is by case analysis on whether degree p < m or degree p = m (similarly for q and n). In the less-than cases, library lemma coeff_eq_0 shows that both sides are zero; the final case follows from library lemma coeff_mult_degree_sum.
The problem is, quite simply, that if you don't have an integral domain, coefficients might become zero when multiplying two polynomials, in fact, even the entire polynomial can become zero. For example, consider the commutative ring ℤ/4ℤ, i.e. integers modulo 4. Then the polynomial 2X has degree 1, but 2X · 2X = 4X² = 0 has degree -∞ (or 0, by Isabelle convention).
You need the fact that there are no zero divisors for something like this.
On a related note: it is called “idom”, for “integral domain”, not “ideom”.