Lecture 6: Inductive Relations

Require Import String.[Loading ML file ring_plugin.cmxs (using legacy method) ... done]
Open Scope string_scope.
Require Import List.
Import ListNotations.
Open Scope list_scope. 
Require Import Lia.[Loading ML file zify_plugin.cmxs (using legacy method) ... done]
[Loading ML file micromega_plugin.cmxs (using legacy method) ... done]

Recap: arithmetic expressions

Inductive expr : Type :=
  | Const : nat -> expr
  | Var : string -> expr
  | Plus : expr -> expr -> expr
  | Mult : expr -> expr -> expr.

Fixpoint eval (env : string -> nat) (e : expr) : nat :=
  match e with
  | Const n => n
  | Var x => env x
  | Plus e1 e2 => eval env e1 + eval env e2
  | Mult e1 e2 => eval env e1 * eval env e2
  end.

Imperative programming

A simple imperative programming language

Inductive stmt :=
  | Assign : string -> expr -> stmt
  | Seq : stmt -> stmt -> stmt
  | If : expr -> stmt -> stmt -> stmt
  | Repeat : expr -> stmt -> stmt.

Iterate a function n times

Fixpoint iter {A} (f : A -> A) (n : nat) (x : A) : A :=
  match n with
  | 0 => x
  | S n => f (iter f n x)
  end.

Evaluate a statement

Fixpoint eval_stmt (env : string -> nat) (stmt : stmt) : string -> nat :=
  match stmt with
  | Assign x e => 
    let v := eval env e in
    fun var => if String.eqb x var then v else env var
  | Seq s1 s2 => 
    let env' := eval_stmt env s1 in
    eval_stmt env' s2
  | If e stmt1 stmt2 => 
    let v := eval env e in
    if Nat.eqb v 0 then eval_stmt env stmt1 else eval_stmt env stmt2
  | Repeat e body => 
    let v := eval env e in
    iter (fun env => eval_stmt env body) v env
  end.

Example

Definition s := Repeat (Var "x") (Repeat (Var "x") (Assign "y" (Plus (Var "y") (Const 1)))).
Compute (eval_stmt (fun x => match x with "x" => 10 | "y" => 0 | _ => 0 end) s) "y".= 100
: nat

Now we try and add While loops

Inductive stmt' :=
  | Assign' : string -> expr -> stmt'
  | Seq' : stmt' -> stmt' -> stmt'
  | If' : expr -> stmt' -> stmt' -> stmt'
  | Repeat' : expr -> stmt' -> stmt'
  | While' : expr -> stmt' -> stmt'.

Fixpoint eval_stmt' (env : string -> nat) (stmt : stmt') : string -> nat :=
  match stmt with
  | Assign' x e => 
    let v := eval env e in
    fun var => if String.eqb x var then v else env var
  | Seq' s1 s2 => 
    let env' := eval_stmt' env s1 in
    eval_stmt' env' s2
  | If' e stmt1 stmt2 => 
    let v := eval env e in
    if Nat.eqb v 0 then eval_stmt' env stmt1 else eval_stmt' env stmt2
  | Repeat' e body => 
    let v := eval env e in
    iter (fun env => eval_stmt' env body) v env
  | While' e body => 
    let v := eval env e in
    if Nat.eqb v 0 then env else 
    let env' := eval_stmt' env body in 
    env' (* Want: eval_stmt' env' (While' e body) *)
  end.

Adding while loops breaks the termination checker. Indeed, while loops don't always terminate! We need a different approach for defining the semantics of while loops. We'll use inductive relations.

Inductive Relations

Fixpoint is_even (n:nat) : Prop :=
  match n with
  | 0 => True
  | S n' =>
      match n' with
      | 0 => False
      | S n'' => is_even n''
      end
  end.

Lemma four_even : is_even 16.is_even 16
Proof.is_even 16
  constructor.
Qed.  

Inductive even : nat -> Prop :=
  | even_0 : even 0
  | even_SS : forall n, even n -> even (S (S n)).

Lemma four_is_even : even 4.even 4
Proof.even 4
  apply even_SS.even 2
  apply even_SS.even 0
  apply even_0.
Qed.

Lemma even_plus_four n : even n -> even (4 + n).n: nat
even n -> even (4 + n)
Proof.n: nat
even n -> even (4 + n)
  intros H.n: nat
H: even n
even (4 + n)
  apply even_SS.n: nat
H: even n
even (S (S n))
  apply even_SS.n: nat
H: even n
even n
  apply H.
Qed.

Lemma even_minus_two n : even (S (S n)) -> even n.n: nat
even (S (S n)) -> even n
Proof.n: nat
even (S (S n)) -> even n
  intros H.n: nat
H: even (S (S n))
even n
  inversion H.n: nat
H: even (S (S n))
n0: nat
H1: even n
H0: n0 = n
even n
  apply H1.
Qed.

Lemma one_is_not_even : ~ even 1.~ even 1
Proof.~ even 1
  intros H.H: even 1
False
  inversion H.
Qed.

Lemma three_is_not_even : ~ even 3.~ even 3
Proof.~ even 3
  intros H.H: even 3
False
  inversion H.H: even 3
n: nat
H1: even 1
H0: n = 1
False
  apply one_is_not_even.H: even 3
n: nat
H1: even 1
H0: n = 1
even 1
  apply H1.
Qed.

Require Import Arith.
Require Import Lia.

Lemma double_even n : even (2 * n).n: nat
even (2 * n)
Proof.n: nat
even (2 * n)
  induction n.even (2 * 0)
n: nat
IHn: even (2 * n)
even (2 * S n)
  -even (2 * 0) apply even_0.
  -n: nat
IHn: even (2 * n)
even (2 * S n) replace (2 * S n) with (2 + 2 * n) by lia.n: nat
IHn: even (2 * n)
even (2 + 2 * n)
    apply even_SS.n: nat
IHn: even (2 * n)
even (2 * n)
    apply IHn.
Qed.

Lemma even_double n : even n -> exists k, n = 2 * k.n: nat
even n -> exists k : nat, n = 2 * k
Proof.n: nat
even n -> exists k : nat, n = 2 * k
  intros H.n: nat
H: even n
exists k : nat, n = 2 * k
  induction n.H: even 0
exists k : nat, 0 = 2 * k
n: nat
H: even (S n)
IHn: even n -> exists k : nat, n = 2 * k
exists k : nat, S n = 2 * k
  -H: even 0
exists k : nat, 0 = 2 * k exists 0.H: even 0
0 = 2 * 0 reflexivity.
  -n: nat
H: even (S n)
IHn: even n -> exists k : nat, n = 2 * k
exists k : nat, S n = 2 * k (* We're stuck: we need `even n` to use the IHn, 
       but we have `even (S n)`, so n is not even! *)
Abort.

Lemma even_double_2 n : even n -> exists k, n = 2 * k.n: nat
even n -> exists k : nat, n = 2 * k
Proof.n: nat
even n -> exists k : nat, n = 2 * k
  (* We use strong induction. *)
  intros H.n: nat
H: even n
exists k : nat, n = 2 * k
  induction n using lt_wf_ind.n: nat
H: even n
H0: forall m : nat,
m < n -> even m -> exists k : nat, m = 2 * k
exists k : nat, n = 2 * k
  destruct n.H: even 0
H0: forall m : nat,
m < 0 -> even m -> exists k : nat, m = 2 * k
exists k : nat, 0 = 2 * k
n: nat
H: even (S n)
H0: forall m : nat,
m < S n -> even m -> exists k : nat, m = 2 * k
exists k : nat, S n = 2 * k
  - (* n = 0 *)H: even 0
H0: forall m : nat,
m < 0 -> even m -> exists k : nat, m = 2 * k
exists k : nat, 0 = 2 * k
    exists 0.H: even 0
H0: forall m : nat,
m < 0 -> even m -> exists k : nat, m = 2 * k
0 = 2 * 0 reflexivity.
  -n: nat
H: even (S n)
H0: forall m : nat,
m < S n -> even m -> exists k : nat, m = 2 * k
exists k : nat, S n = 2 * k destruct n.H: even 1
H0: forall m : nat,
m < 1 -> even m -> exists k : nat, m = 2 * k
exists k : nat, 1 = 2 * k
n: nat
H: even (S (S n))
H0: forall m : nat,
m < S (S n) ->
even m -> exists k : nat, m = 2 * k
exists k : nat, S (S n) = 2 * k 
    + (* n = 1 *)H: even 1
H0: forall m : nat,
m < 1 -> even m -> exists k : nat, m = 2 * k
exists k : nat, 1 = 2 * k inversion H.
    + (* n = S (S n') *)n: nat
H: even (S (S n))
H0: forall m : nat,
m < S (S n) ->
even m -> exists k : nat, m = 2 * k
exists k : nat, S (S n) = 2 * k
      inversion H.n: nat
H: even (S (S n))
H0: forall m : nat,
m < S (S n) ->
even m -> exists k : nat, m = 2 * k
n0: nat
H2: even n
H1: n0 = n
exists k : nat, S (S n) = 2 * k subst.n: nat
H: even (S (S n))
H0: forall m : nat,
m < S (S n) ->
even m -> exists k : nat, m = 2 * k
H2: even n
exists k : nat, S (S n) = 2 * k clear H.n: nat
H0: forall m : nat,
m < S (S n) ->
even m -> exists k : nat, m = 2 * k
H2: even n
exists k : nat, S (S n) = 2 * k
      destruct (H0 n).n: nat
H0: forall m : nat,
m < S (S n) ->
even m -> exists k : nat, m = 2 * k
H2: even n
n < S (S n)
n: nat
H0: forall m : nat,
m < S (S n) ->
even m -> exists k : nat, m = 2 * k
H2: even n
even n
n: nat
H0: forall m : nat,
m < S (S n) ->
even m -> exists k : nat, m = 2 * k
H2: even n
x: nat
H: n = 2 * x
exists k : nat, S (S n) = 2 * k
      *n: nat
H0: forall m : nat,
m < S (S n) ->
even m -> exists k : nat, m = 2 * k
H2: even n
n < S (S n) lia.
      *n: nat
H0: forall m : nat,
m < S (S n) ->
even m -> exists k : nat, m = 2 * k
H2: even n
even n apply H2.
      *n: nat
H0: forall m : nat,
m < S (S n) ->
even m -> exists k : nat, m = 2 * k
H2: even n
x: nat
H: n = 2 * x
exists k : nat, S (S n) = 2 * k subst.x: nat
H2: even (2 * x)
H0: forall m : nat,
m < S (S (2 * x)) ->
even m -> exists k : nat, m = 2 * k
exists k : nat, S (S (2 * x)) = 2 * k exists (S x).x: nat
H2: even (2 * x)
H0: forall m : nat,
m < S (S (2 * x)) ->
even m -> exists k : nat, m = 2 * k
S (S (2 * x)) = 2 * S x simpl.x: nat
H2: even (2 * x)
H0: forall m : nat,
m < S (S (2 * x)) ->
even m -> exists k : nat, m = 2 * k
S (S (x + (x + 0))) = S (x + S (x + 0)) lia.
Qed.

There is a much better way to prove this theorem: induction on even n!

Lemma even_double_3 n : even n -> exists k, n = 2 * k.n: nat
even n -> exists k : nat, n = 2 * k
Proof.n: nat
even n -> exists k : nat, n = 2 * k
  intros H.n: nat
H: even n
exists k : nat, n = 2 * k
  induction H.exists k : nat, 0 = 2 * k
n: nat
H: even n
IHeven: exists k : nat, n = 2 * k
exists k : nat, S (S n) = 2 * k
  -exists k : nat, 0 = 2 * k exists 0.0 = 2 * 0 reflexivity.
  -n: nat
H: even n
IHeven: exists k : nat, n = 2 * k
exists k : nat, S (S n) = 2 * k destruct IHeven.n: nat
H: even n
x: nat
H0: n = 2 * x
exists k : nat, S (S n) = 2 * k subst.x: nat
H: even (2 * x)
exists k : nat, S (S (2 * x)) = 2 * k
    exists (S x).x: nat
H: even (2 * x)
S (S (2 * x)) = 2 * S x lia.
Qed.

Inductive relations without Inductive

Just like we can define the connectives without Inductives, by only using forall and implication, we can also define inductive relations without using Inductive. The above exists k, n = 2 * k is an example of of that, but there is a systematic way to do this.

We first define a higher-order predicate supereven P that says that P is a superset of the even numbers:

Definition supereven P := P 0 /\ forall m, P m -> P (S (S m)).

That is, a predicate P is a superset of the even numbers, if

P 0 holds

if P m holds, then P (S (S m)) holds

Note that these two conjuncts correspond exactly to the two clauses in the Inductive definition of even.

We can now define the even' predicate as the intersection of all supersets of even numbers.

Definition even' n := forall p, supereven p -> p n.

We can now prove that even' is equivalent to even.

Lemma even_alt_iff_even n : even' n <-> even n.n: nat
even' n <-> even n
Proof.n: nat
even' n <-> even n
  split.n: nat
even' n -> even n
n: nat
even n -> even' n
  -n: nat
even' n -> even n intros H.n: nat
H: even' n
even n apply H.n: nat
H: even' n
supereven (fun n : nat => even n)
    unfold supereven.n: nat
H: even' n
even 0 /\ (forall m : nat, even m -> even (S (S m))) split.n: nat
H: even' n
even 0
n: nat
H: even' n
forall m : nat, even m -> even (S (S m))
    +n: nat
H: even' n
even 0 apply even_0.
    +n: nat
H: even' n
forall m : nat, even m -> even (S (S m)) intros m Hm.n: nat
H: even' n
m: nat
Hm: even m
even (S (S m)) apply even_SS.n: nat
H: even' n
m: nat
Hm: even m
even m apply Hm.
  -n: nat
even n -> even' n intros H.n: nat
H: even n
even' n induction H.even' 0
n: nat
H: even n
IHeven: even' n
even' (S (S n))
    +even' 0 unfold even'.forall p : nat -> Prop, supereven p -> p 0 intros p Hp.p: nat -> Prop
Hp: supereven p
p 0
      unfold supereven in Hp.p: nat -> Prop
Hp: p 0 /\ (forall m : nat, p m -> p (S (S m)))
p 0 destruct Hp.p: nat -> Prop
H: p 0
H0: forall m : nat, p m -> p (S (S m))
p 0 apply H.
    +n: nat
H: even n
IHeven: even' n
even' (S (S n)) unfold even' in *.n: nat
H: even n
IHeven: forall p : nat -> Prop, supereven p -> p n
forall p : nat -> Prop, supereven p -> p (S (S n)) intros p Hp.n: nat
H: even n
IHeven: forall p : nat -> Prop, supereven p -> p n
p: nat -> Prop
Hp: supereven p
p (S (S n))
      apply IHeven.n: nat
H: even n
IHeven: forall p : nat -> Prop, supereven p -> p n
p: nat -> Prop
Hp: supereven p
supereven (fun n : nat => p (S (S n))) unfold supereven in *.n: nat
H: even n
IHeven: forall p : nat -> Prop,
p 0 /\ (forall m : nat, p m -> p (S (S m))) ->
p n
p: nat -> Prop
Hp: p 0 /\ (forall m : nat, p m -> p (S (S m)))
p 2 /\
(forall m : nat, p (S (S m)) -> p (S (S (S (S m)))))
      destruct Hp.n: nat
H: even n
IHeven: forall p : nat -> Prop,
p 0 /\ (forall m : nat, p m -> p (S (S m))) ->
p n
p: nat -> Prop
H0: p 0
H1: forall m : nat, p m -> p (S (S m))
p 2 /\
(forall m : nat, p (S (S m)) -> p (S (S (S (S m))))) split.n: nat
H: even n
IHeven: forall p : nat -> Prop,
p 0 /\ (forall m : nat, p m -> p (S (S m))) ->
p n
p: nat -> Prop
H0: p 0
H1: forall m : nat, p m -> p (S (S m))
p 2
n: nat
H: even n
IHeven: forall p : nat -> Prop,
p 0 /\ (forall m : nat, p m -> p (S (S m))) ->
p n
p: nat -> Prop
H0: p 0
H1: forall m : nat, p m -> p (S (S m))
forall m : nat, p (S (S m)) -> p (S (S (S (S m))))
      *n: nat
H: even n
IHeven: forall p : nat -> Prop,
p 0 /\ (forall m : nat, p m -> p (S (S m))) ->
p n
p: nat -> Prop
H0: p 0
H1: forall m : nat, p m -> p (S (S m))
p 2 apply H1.n: nat
H: even n
IHeven: forall p : nat -> Prop,
p 0 /\ (forall m : nat, p m -> p (S (S m))) ->
p n
p: nat -> Prop
H0: p 0
H1: forall m : nat, p m -> p (S (S m))
p 0 apply H0.
      *n: nat
H: even n
IHeven: forall p : nat -> Prop,
p 0 /\ (forall m : nat, p m -> p (S (S m))) ->
p n
p: nat -> Prop
H0: p 0
H1: forall m : nat, p m -> p (S (S m))
forall m : nat, p (S (S m)) -> p (S (S (S (S m)))) intros m Hm.n: nat
H: even n
IHeven: forall p : nat -> Prop,
p 0 /\ (forall m : nat, p m -> p (S (S m))) ->
p n
p: nat -> Prop
H0: p 0
H1: forall m : nat, p m -> p (S (S m))
m: nat
Hm: p (S (S m))
p (S (S (S (S m)))) apply H1.n: nat
H: even n
IHeven: forall p : nat -> Prop,
p 0 /\ (forall m : nat, p m -> p (S (S m))) ->
p n
p: nat -> Prop
H0: p 0
H1: forall m : nat, p m -> p (S (S m))
m: nat
Hm: p (S (S m))
p (S (S m)) apply Hm.
Qed.