lean2/tests/lean/run/vector.lean
2014-11-30 13:53:02 -08:00

119 lines
4.2 KiB
Text
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

import logic data.nat.basic data.prod data.unit
open nat prod
inductive vector (A : Type) : nat → Type :=
vnil {} : vector A zero,
vcons : Π {n : nat}, A → vector A n → vector A (succ n)
namespace vector
print definition no_confusion
infixr `::` := vcons
theorem vcons.inj₁ {A : Type} {n : nat} (a₁ a₂ : A) (v₁ v₂ : vector A n) : vcons a₁ v₁ = vcons a₂ v₂ → a₁ = a₂ :=
begin
intro h, apply (no_confusion h), intros, assumption
end
theorem vcons.inj₂ {A : Type} {n : nat} (a₁ a₂ : A) (v₁ v₂ : vector A n) : vcons a₁ v₁ = vcons a₂ v₂ → v₁ = v₂ :=
begin
intro h, apply heq.to_eq, apply (no_confusion h), intros, eassumption,
end
section
universe variables l₁ l₂
variable {A : Type.{l₁}}
variable {C : Π (n : nat), vector A n → Type.{l₂+1}}
definition brec_on {n : nat} (v : vector A n) (H : Π (n : nat) (v : vector A n), @below A C n v → C n v) : C n v :=
have general : C n v × @below A C n v, from
rec_on v
(pair (H zero vnil unit.star) unit.star)
(λ (n₁ : nat) (a₁ : A) (v₁ : vector A n₁) (r₁ : C n₁ v₁ × @below A C n₁ v₁),
have b : @below A C _ (vcons a₁ v₁), from
r₁,
have c : C (succ n₁) (vcons a₁ v₁), from
H (succ n₁) (vcons a₁ v₁) b,
pair c b),
pr₁ general
end
check brec_on
definition bw := @below
definition sum {n : nat} (v : vector nat n) : nat :=
brec_on v (λ (n : nat) (v : vector nat n),
cases_on v
(λ (B : bw vnil), zero)
(λ (n₁ : nat) (a : nat) (v₁ : vector nat n₁) (B : bw (vcons a v₁)),
a + pr₁ B))
example : sum (10 :: 20 :: vnil) = 30 :=
rfl
definition addk {n : nat} (v : vector nat n) (k : nat) : vector nat n :=
brec_on v (λ (n : nat) (v : vector nat n),
cases_on v
(λ (B : bw vnil), vnil)
(λ (n₁ : nat) (a₁ : nat) (v₁ : vector nat n₁) (B : bw (vcons a₁ v₁)),
vcons (a₁+k) (pr₁ B)))
example : addk (1 :: 2 :: vnil) 3 = 4 :: 5 :: vnil :=
rfl
definition append.{l} {A : Type.{l+1}} {n m : nat} (w : vector A m) (v : vector A n) : vector A (n + m) :=
brec_on w (λ (n : nat) (w : vector A n),
cases_on w
(λ (B : bw vnil), v)
(λ (n₁ : nat) (a₁ : A) (v₁ : vector A n₁) (B : bw (vcons a₁ v₁)),
vcons a₁ (pr₁ B)))
example : append (1 :: 2 :: vnil) (3 :: vnil) = 1 :: 2 :: 3 :: vnil :=
rfl
definition head {A : Type} {n : nat} (v : vector A (succ n)) : A :=
cases_on v
(λ H : succ n = 0, nat.no_confusion H)
(λn' h t (H : succ n = succ n'), h)
rfl
definition tail {A : Type} {n : nat} (v : vector A (succ n)) : vector A n :=
@cases_on A (λn' v, succ n = n' → vector A (pred n')) (succ n) v
(λ H : succ n = 0, nat.no_confusion H)
(λ (n' : nat) (h : A) (t : vector A n') (H : succ n = succ n'),
t)
rfl
definition add {n : nat} (w v : vector nat n) : vector nat n :=
@brec_on nat (λ (n : nat) (v : vector nat n), vector nat n → vector nat n) n w
(λ (n : nat) (w : vector nat n),
cases_on w
(λ (B : bw vnil) (w : vector nat zero), vnil)
(λ (n₁ : nat) (a₁ : nat) (v₁ : vector nat n₁) (B : bw (vcons a₁ v₁)) (v : vector nat (succ n₁)),
vcons (a₁ + head v) (pr₁ B (tail v)))) v
example : add (1 :: 2 :: vnil) (3 :: 5 :: vnil) = 4 :: 7 :: vnil :=
rfl
definition map {A B C : Type} {n : nat} (f : A → B → C) (w : vector A n) (v : vector B n) : vector C n :=
let P := λ (n : nat) (v : vector A n), vector B n → vector C n in
@brec_on A P n w
(λ (n : nat) (w : vector A n),
begin
cases w with (n₁, h₁, t₁),
show @below A P zero vnil → vector B zero → vector C zero, from
λ b v, vnil,
show @below A P (succ n₁) (h₁ :: t₁) → vector B (succ n₁) → vector C (succ n₁), from
λ b v,
begin
cases v with (n₂, h₂, t₂),
have r : vector B n₂ → vector C n₂, from pr₁ b,
(f h₁ h₂) :: r t₂,
end
end) v
example : map nat.add (1 :: 2 :: vnil) (3 :: 5 :: vnil) = 4 :: 7 :: vnil :=
rfl
print definition map
end vector