lean2/tests/lean/run/vector.lean

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₂}
    definition below {n : nat} (v : vector A n) :=
    rec_on v unit.{max 1 l₂} (λ (n₁ : nat) (a₁ : A) (v₁ : vector A n₁) (r₁ : Type.{max 1 l₂}), C n₁ v₁ × r₁)

   definition bw {n : nat} {A : Type} {C : Π (n : nat), vector A n → Type} (v : vector A n) := @below A C n v
  end

  section
    universe variables l₁ l₂
    variable {A : Type.{l₁}}
    variable {C : Π (n : nat), vector A n → Type.{l₂}}
    definition brec_on {n : nat} (v : vector A n) (H : Π (n : nat) (v : vector A n), below C v → C n v) : C n v :=
    have general : C n v × below C 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 C v₁),
          have b : below 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 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 {A : Type} {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

end vector