Is a homomorphism between two groups proper? Here are my definitions for groups and homomorphisms:
Definition associative {ty : Type} (f : ty -> ty -> ty) (eq : ty -> ty -> Prop) :=
forall a b c, eq (f (f a b) c) (f a (f b c)).
Definition identity {ty : Type} (f : ty -> ty -> ty) (eq : ty -> ty -> Prop) (e : ty) :=
forall a, eq (f a e) a /\ eq (f e a) a.
Definition op_inverse {ty : Type} (f : ty -> ty -> ty) (eq : ty -> ty -> Prop) (e a a' : ty) :=
eq (f a a') e /\ eq (f a' a) e.
Definition op_invertible {ty : Type} (f : ty -> ty -> ty) (eq : ty -> ty -> Prop) (e : ty) :=
forall a, exists a', op_inverse f eq e a a'.
Record Group : Type := Group'
{ ty :> Type
; op : ty -> ty -> ty
; eqr : ty -> ty -> Prop
; e : ty
; eq_rel :> Equivalence eqr
; prop_op :> Proper (eqr ==> eqr ==> eqr) op
; assoc_op : associative op eqr
; id_op : identity op eqr e
; inv_op : op_invertible op eqr e
}.
Notation "A <.> B" := ((op _) A B) (at level 50).
Notation "A =.= B" := ((eqr _) A B) (at level 50).
Definition homomorphism {G H : Group} (f : G -> H) :=
forall x y, f (x <.> y) =.= (f x <.> f y).
I want to prove:
Lemma homo_is_proper : forall {G H : Group} (f : ty G -> ty H),
homomorphism f -> Proper (eqr G ==> eqr H) f.
Is this necessarily true?
It's not true.
Let H be a non-trivial group (e.g., Z/2Z), define G as the quotient of H under the total relation eqr := fun _ _ => True (G is thus isomorphic to the trivial group), and f : ty G -> ty H is the identity function. f satisfies homomorphism but it's not proper.
In general, to reflect common mathematical practice, when working with setoids, properness is a basic fact that must be proved from first principles, and that the rest of a theory rests upon. Arguably, homo_is_proper is not a natural question to ask, because all theorems and properties (such as homomorphism) should really be parameterized only by proper functions in the first place.
Related
I tried to implement the following Coq code:
Set Implicit Arguments.
Inductive fun_eq A B (f : A -> B) : forall C D, (C -> D) -> Prop :=
fun_eqrefl : forall g : A -> B, f = g -> fun_eq f g.
Lemma fun_eq0 A B (f g : A -> B) : fun_eq f g -> f = g.
Proof. intros H. destruct H.
But destruct H. fails with an error message:
Abstracting over the terms "A", "B" and "g" leads to a term
fun (A0 B0 : Type) (g0 : A0 -> B0) => f = g0 which is ill-typed.
Reason is: Illegal application:
The term "#eq" of type "forall A : Type, A -> A -> Prop" cannot be applied to the terms
"A0 -> B0" : "Type"
"f" : "A -> B"
"g0" : "A0 -> B0"
The 2nd term has type "A -> B" which should be coercible to
"A0 -> B0".
I think there would be two workarounds for this kind of error, neither of which worked in this case.
One is to admit the proof_irrelevance. However, it is impossible to construct an alternating proof for fun_eq f g because the argument of fun_eqrefl is what we want.
Another way is to provide an exact term using refine, but I couldn't come up with such a term. Also, if there were such a term (it would involve match statement), I suspect my previous question could be solved in a similar way.
Is it possible to prove fun_eq0? If so, how can it be done?
You can prove it using UIP (special case of proof irrelevance for eq).
The trick is to rewrite one side of the equality f to cast eq_refl f, where cast : A = B -> A -> B, and use UIP/proof irrelevance to replace eq_refl with an equality proof obtained from the H : fun_eq f g assumption. That way, when you destruct H, the type of the LHS changes simultaneously with the type of the RHS.
Set Implicit Arguments.
From Coq Require Import ProofIrrelevance.
Inductive fun_eq A B (f : A -> B) : forall C D, (C -> D) -> Prop :=
fun_eqrefl : forall g : A -> B, f = g -> fun_eq f g.
(* Extract the equality on types *)
Definition fun_eq_tyeq {A B C D} (f : A -> B) (g : C -> D) (H : fun_eq f g) : (A -> B) = (C -> D) :=
match H with
| fun_eqrefl _ => eq_refl
end.
Definition cast A B (e : A = B) (x : A) : B := eq_rect A (fun T => T) x B e.
Lemma fun_eq0 A B (f g : A -> B) : fun_eq f g -> f = g.
Proof.
intros H.
change (cast eq_refl f = g).
replace eq_refl with (fun_eq_tyeq H) by apply UIP.
destruct H.
cbn.
auto.
Qed.
I'm trying to define first-order logic in Coq and beginning at terms.
Supposing that c1 and c2 are two constant symbols, variables are nat and f1 and f2 are two function symbols whose arities are 1 and 2 respectively, I wrote the following code.
Definition var := nat.
Inductive const : Type :=
| c1
| c2.
Inductive term : Type :=
| Con : const -> term
| Var : var -> term
| F1 : term -> term
| F2 : term -> term -> term.
Then, I got a desired induction.
Check term_ind.
(* ==> term_ind
: forall P : term -> Prop,
(forall c : const, P (Con c)) ->
(forall v : var, P (Var v)) ->
(forall t : term, P t -> P (F1 t)) ->
(forall t : term, P t -> forall t0 : term, P t0 -> P (F2 t t0)) ->
forall t : term, P t *)
Then I wanted to separate functions from the definition of term, so I rewrote the above.
(*Idea A*)
Inductive funct {X : Type} : Type :=
| f1 : X -> funct
| f2 : X -> X -> funct.
Inductive term : Type :=
| Con : const -> term
| Var : var -> term
| Fun : #funct term -> term.
Check term_ind.
(* ==> term_ind
: forall P : term -> Prop,
(forall c : const, P (Con c)) ->
(forall v : var, P (Var v)) ->
(forall f1 : funct, P (Fun f1)) ->
forall t : term, P t *)
Check funct_ind term.
(* ==> funct_ind term
: forall P : funct -> Prop,
(forall x : term, P (f1 x)) ->
(forall x x0 : term, P (f2 x x0)) ->
forall f1 : funct, P f1 *)
(*Idea B*)
Inductive term : Type :=
| Con : const -> term
| Var : var -> term
| Fun : funct -> term
with funct : Type :=
| f1 : term -> funct
| f2 : term -> term -> funct.
Check term_ind.
(* ==> term_ind
: forall P : term -> Prop,
(forall c : const, P (Con c)) ->
(forall v : var, P (Var v)) ->
(forall f1 : funct, P (Fun f1)) ->
forall t : term, P t *)
Check funct_ind.
(* ==> funct_ind
: forall P : funct -> Prop,
(forall t : term, P (f1 t)) ->
(forall t t0 : term, P (f2 t t0)) ->
forall f1 : funct, P f1 *)
However, both ways seem not to generate the desired induction because they don't have induction hypotheses.
How can I construct term with functions separated from the definition of term without loss of proper induction?
Thanks.
This is a common issue with Coq: the induction principles generated for mutually inductive types and for types with complex recursive occurrences are too weak. Fortunately, this can be fixed by defining the induction principles by hand. In your case, the simplest approach is to use the mutually inductive definition, since Coq can lend us a hand for proving the principle.
First, let ask Coq not to generate its weak default induction principle:
Unset Elimination Schemes.
Inductive term : Type :=
| Con : const -> term
| Var : var -> term
| Fun : funct -> term
with funct : Type :=
| f1 : term -> funct
| f2 : term -> term -> funct.
Set Elimination Schemes.
(This is not strictly necessary, but it helps keeping the global namespace clean.)
Now, let us use the Scheme command to generate a mutual induction principle for these types:
Scheme term_ind' := Induction for term Sort Prop
with funct_ind' := Induction for funct Sort Prop.
(*
term_ind'
: forall (P : term -> Prop) (P0 : funct -> Prop),
(forall c : const, P (Con c)) ->
(forall v : var, P (Var v)) ->
(forall f1 : funct, P0 f1 -> P (Fun f1)) ->
(forall t : term, P t -> P0 (f1 t)) ->
(forall t : term, P t -> forall t0 : term, P t0 -> P0 (f2 t t0)) ->
forall t : term, P t
*)
This principle is already powerful enough for us to prove properties of term, but it is a bit awkward to use, since it requires us to specify a property that we want to prove about the funct type as well (the P0 predicate). We can simplify it a bit to avoid mentioning this auxiliary predicate: all we need to know is that the terms inside the function calls satisfy the predicate that we want to prove.
Definition lift_pred (P : term -> Prop) (f : funct) : Prop :=
match f with
| f1 t => P t
| f2 t1 t2 => P t1 /\ P t2
end.
Lemma term_ind (P : term -> Prop) :
(forall c, P (Con c)) ->
(forall v, P (Var v)) ->
(forall f, lift_pred P f -> P (Fun f)) ->
forall t, P t.
Proof.
intros HCon HVar HFun.
apply (term_ind' P (lift_pred P)); trivial.
now intros t1 IH1 t2 IH2; split.
Qed.
If you prefer, you can also rewrite this to look more like the original induction principle:
Reset term_ind.
Lemma term_ind (P : term -> Prop) :
(forall c, P (Con c)) ->
(forall v, P (Var v)) ->
(forall t, P t -> P (Fun (f1 t))) ->
(forall t1, P t1 -> forall t2, P t2 -> P (Fun (f2 t1 t2))) ->
forall t, P t.
Proof.
intros HCon HVar HFun_f1 HFun_f2.
apply (term_ind' P (lift_pred P)); trivial.
- now intros [t|t1 t2]; simpl; intuition.
- now simpl; intuition.
Qed.
Edit
To get an induction principle for your other approach, you have to write a proof term by hand:
Definition var := nat.
Inductive const : Type :=
| c1
| c2.
Inductive funct (X : Type) : Type :=
| f1 : X -> funct X
| f2 : X -> X -> funct X.
Arguments f1 {X} _.
Arguments f2 {X} _ _.
Unset Elimination Schemes.
Inductive term : Type :=
| Con : const -> term
| Var : var -> term
| Fun : funct term -> term.
Set Elimination Schemes.
Definition term_ind (P : term -> Type)
(HCon : forall c, P (Con c))
(HVar : forall v, P (Var v))
(HF1 : forall t, P t -> P (Fun (f1 t)))
(HF2 : forall t1, P t1 -> forall t2, P t2 -> P (Fun (f2 t1 t2))) :
forall t, P t :=
fix loop (t : term) : P t :=
match t with
| Con c => HCon c
| Var v => HVar v
| Fun (f1 t) => HF1 t (loop t)
| Fun (f2 t1 t2) => HF2 t1 (loop t1) t2 (loop t2)
end.
The main problem is I cannot define such an Inductive proposition:
Inductive forces : nat -> Prop :=
| KM_cond (n : nat) : ~ forces 0 ->
forces n.
In fact, I am trying to define the Kripke Semantics for Intuitionistic Logic
Inductive forces (M : Kripke_model) (x : world) : prop -> Prop :=
| KM_cond (A B : prop) : set_In x (worlds M) ->
(forall y, (rel M) x y -> (~ forces M y A \/ forces M y B)) ->
forces M x (A then B).
but I get the following error
Non strictly positive occurrence of "forces"
If I just remove the negation, the problem goes away
Inductive forces (M : Kripke_model) (x : world) : prop -> Prop :=
| KM_cond (A B : prop) : set_In x (worlds M) ->
(forall y, (rel M) x y -> (forces M y A \/ forces M y B)) ->
forces M x (A then B).
but the problem exists with -> also
Inductive forces (M : Kripke_model) (x : world) : prop -> Prop :=
| KM_cond (A B : prop) : set_In x (worlds M) ->
(forall y, (rel M) x y -> (forces M y A -> forces M y B)) ->
forces M x (A then B).
I cannot understand what would possibly go wrong if I define this Inductive thing, and I cannot think of any other way to achieve this definition.
UPDATE:
These are the needed definitions:
From Coq Require Import Lists.List.
From Coq Require Import Lists.ListSet.
From Coq Require Import Relations.
Import ListNotations.
Definition var := nat.
Inductive prop : Type :=
| bot
| atom (p : var)
| conj (A B : prop)
| disj (A B : prop)
| cond (A B : prop).
Notation "A 'and' B" := (conj A B) (at level 50, left associativity).
Notation "A 'or' B" := (disj A B) (at level 50, left associativity).
Notation "A 'then' B" := (cond A B) (at level 60, no associativity).
Definition world := nat.
Definition preorder {X : Type} (R : relation X) : Prop :=
(forall x : X, R x x) /\ (forall x y z : X, R x y -> R y z -> R x z).
Inductive Kripke_model : Type :=
| Kripke (W : set world) (R : relation world) (v : var -> world -> bool)
(HW : W <> empty_set world)
(HR : preorder R)
(Hv : forall x y p, In x W -> In y W ->
R x y -> (v p x) = true -> (v p y) = true).
Definition worlds (M : Kripke_model) :=
match M with
| Kripke W _ _ _ _ _ => W
end.
Definition rel (M : Kripke_model) :=
match M with
| Kripke _ R _ _ _ _ => R
end.
Definition val (M : Kripke_model) :=
match M with
| Kripke _ _ v _ _ _ => v
end.
You cannot define this relation as an inductive predicate, but you can define it by recursion on the formula:
Fixpoint forces (M : Kripke_model) (x : world) (p : prop) : Prop :=
match p with
| bot => False
| atom p => val M p x = true
| conj p q => forces M x p /\ forces M x q
| disj p q => forces M x p \/ forces M x q
| cond p q => forall y, rel M x y -> forces M y p -> forces M y q
end.
This trick does not work if the definition is not well-founded with respect to the formula structure, but it might be enough for your use case.
I need to apply FixL_Accumulate to prove the goal, but the unification fails due to the let statements and internal "if-then-else". The question is about how to match the shapes here?
Require Import ZArith.
Inductive branch (A B C : Prop) : Prop :=
| Then: A -> B -> branch A B C
| Else: not A -> C -> branch A B C
.
Definition itep (A B C : Prop) := (A -> B) /\ (~A -> C).
Axiom ite_then : forall A B C : Prop, itep A B C -> A -> B.
Axiom ite_else : forall A B C : Prop, itep A B C -> ~A -> C.
Axiom ite_both : forall A B C : Prop, itep A B C -> (B \/ C).
Axiom contrap: forall P Q : Prop, (P -> Q) -> ~Q -> ~P.
Parameter L_Accumulate : Z -> Z -> Z.
Hypothesis FixL_Accumulate: forall (n c: Z),
let x := ((L_Accumulate n c))%Z in
let x_1 := (n - 1%Z)%Z in itep ((n <= 0)%Z) ((x = c)%Z)
(((n + ((L_Accumulate x_1 c%Z))) = x)%Z).
Goal
forall (i c : Z),
(i > 0)%Z ->
((((L_Accumulate i%Z c%Z)) = ((i + ((L_Accumulate (i - 1%Z)%Z c%Z))))%Z)).
Proof.
intros.
(* something like: apply (#FixL_Accumulate i c). *)
Qed.
I've found the solution. The issue was because of the symmetry. Thus the question was incorrect.
Proof.
intros.
symmetry.
apply (#FixL_Accumulate i c).
intuition.
Qed.
I made a question before, but i think that question was bad formalized so...
I am facing some problems with this specific definition to prove their properties:
I have a definition of a list :
Inductive list (A : Type) (f : A -> A -> A) : A -> Type :=
|Acons : forall {x : A} (y' : A) (cons' : list f x), list f (f x y')
|Anil : forall (x: A) (y : A), list f (f x y).
And that's definitions :
Definition t_list (T : Type) := (T -> T -> T) -> T -> T.
Definition nil {A : Type} (f : A -> A -> A) (d : A) := d.
Definition cons {A : Type} (v' : A) (c_cons : t_list _) (f : A -> A -> A) (v'' : A) :=
f (c_cons f v'') v'.
Fixpoint list_correspodence (A : Type) (v' : A) (z : A -> A -> A) (xs : list func v'):=
let fix curry_list {y : A} {z' : A -> A -> A} (l : list z' y) :=
match l with
|Acons x y => cons x (curry_list y)
|Anil _ _ y => cons y nil
end in (#curry_list _ _ xs) z (let fix minimal_case {y' : A} {functor : A -> A -> A} (a : list functor y') {struct a} :=
match a with
|Acons x y => minimal_case y
|Anil _ x _ => x
end in minimal_case xs).
Theorem z_next_list_coorresp : forall {A} (z : A -> A -> A) (x y' : A) (x' : list z x), z (list_correspodence x') y' = list_correspodence (Acons y' x').
intros.
generalize (Acons y' x').
intros.
unfold list_correspodence.
(*reflexivity should works ?*)
Qed.
z_next_list_coorres is actually a lemma i need to prove a goal in another theory (v'_list x = (list_correspodence x)).
I have been trying with some limited scopes to prove list_correspodence and works well, seems that definitions are equal, but for coq not.
Here list_correspondence is a spurious Fixpoint (i.e., fix) (it makes no recursive calls), and this gets in the way of reduction.
You can force reduction of a fix by destructing its decreasing argument:
destruct x'.
- reflexivity.
- reflexivity.
Or you can avoid using Fixpoint in the first place. Use Definition instead.
You may run into a strange bug here with implicit arguments, which is avoided by adding a type signature (as below), or by not marking implicit the arguments of the local function curry_list:
Definition list_correspodence (A : Type) (v' : A) (func : A -> A -> A) (xs : list func v')
: A :=
(* ^ add this *)