-- To be able to run the code download and install Agda with the standard 
-- library from: 
--
--    http://wiki.portal.chalmers.se/agda/pmwiki.php
--
module GuestLecture where

open import Data.Nat
open import Relation.Binary.PropositionalEquality as PropEq hiding ([_]) 
open PropEq.≡-Reasoning

infixr 5 _∷_ _++_ _^_

data String Σ : Set where
  ε   : String Σ
  _∷_ : Σ → String Σ → String Σ

exℕ : String ℕ
exℕ = 1 ∷ 2 ∷ 3 ∷ ε

-- concatenation
_++_ : ∀ {Σ} → String Σ -> String Σ -> String Σ 
ε ++ ys        = ys
(x ∷ xs) ++ ys = x ∷ xs ++ ys

-- length
∣_∣ : ∀ {Σ} → String Σ → ℕ
∣ ε ∣      = 0
∣ x ∷ xs ∣ = 1 + ∣ xs ∣

-- power
_^_ : ∀ {Σ} → String Σ → ℕ → String Σ
xs ^ 0     = ε
xs ^ suc n = xs ++ xs ^ n

-- properties 
length-concat : ∀ {Σ} (xs ys : String Σ) → ∣ xs ++ ys ∣ ≡ ∣ xs ∣ + ∣ ys ∣ 
length-concat ε ys        = refl
length-concat (x ∷ xs) ys = cong suc (length-concat xs ys)

length-power : ∀ {Σ} (xs : String Σ) (n : ℕ) → ∣ xs ^ n ∣ ≡ n * ∣ xs ∣
length-power xs zero    = refl
length-power xs (suc n) = begin 
  ∣ xs ++ xs ^ n ∣    ≡⟨ length-concat xs (xs ^ n) ⟩ 
  ∣ xs ∣ + ∣ xs ^ n ∣ ≡⟨ cong (_+_ ∣ xs ∣) (length-power xs n) ⟩ 
  ∣ xs ∣ + n * ∣ xs ∣ ∎

-- This can be done with rewrite by:
-- rewrite length-concat xs (xs ^ n) | length-power xs n = refl

-- singleton
[_] : ∀ {Σ} → Σ → String Σ
[ x ] = x ∷ ε

-- reverse 
rev : ∀ {Σ} → String Σ → String Σ
rev ε        = ε
rev (x ∷ xs) = rev xs ++ [ x ]

concat-assoc : ∀ {Σ} (xs ys zs : String Σ) → xs ++ (ys ++ zs) ≡ (xs ++ ys) ++ zs
concat-assoc ε ys zs        = refl
concat-assoc (x ∷ xs) ys zs = cong (_∷_ x) (concat-assoc xs ys zs)

concat-nil : ∀ {Σ} (xs : String Σ) → xs ++ ε ≡ xs
concat-nil ε        = refl
concat-nil (x ∷ xs) = cong (_∷_ x) (concat-nil xs)

rev-concat : ∀ {Σ} → (xs ys : String Σ) → rev (xs ++ ys) ≡ rev ys ++ rev xs
rev-concat ε ys        = sym (concat-nil _)
rev-concat (x ∷ xs) ys = begin 
  rev (xs ++ ys) ++ x ∷ ε     ≡⟨ cong (λ z → z ++ x ∷ ε) (rev-concat xs ys) ⟩ 
  (rev ys ++ rev xs) ++ x ∷ ε ≡⟨ sym (concat-assoc (rev ys) (rev xs) (x ∷ ε)) ⟩ 
  rev ys ++ rev xs ++ x ∷ ε ∎

-- rewrite rev-concat xs ys = sym (concat-assoc (rev ys) (rev xs) (x ∷ ε))

rev-rev : ∀ {Σ} → (xs : String Σ) → rev (rev xs) ≡ xs
rev-rev ε        = refl
rev-rev (x ∷ xs) = begin 
  rev (rev xs ++ x ∷ ε) ≡⟨ rev-concat (rev xs) (x ∷ ε) ⟩ 
  x ∷ rev (rev xs)      ≡⟨ cong (_∷_ x) (rev-rev xs) ⟩ 
  x ∷ xs ∎


-- Fibonacci:
-- fib 30
fib : ℕ → ℕ
fib 0 = 0
fib 1 = 1 
fib (suc (suc n)) = fib n + fib (suc n)

-- tail-recursive version:
f : ℕ → ℕ → ℕ → ℕ
f 0 a b       = a
f (suc n) a b = f n b (a + b)

-- fast_fib 30
fast_fib : ℕ → ℕ
fast_fib n = f n 0 1

n+0≡n : ∀ n → n + 0 ≡ n
n+0≡n 0       = refl
n+0≡n (suc n) = cong suc (n+0≡n n)

1+m+n≡m+1+n : ∀ m n → suc (m + n) ≡ m + suc n
1+m+n≡m+1+n 0 _       = refl
1+m+n≡m+1+n (suc m) n = cong suc (1+m+n≡m+1+n m n)

key-lemma : ∀ n k → f n (fib k) (fib (suc k)) ≡ fib (k + n)
key-lemma 0 k       = sym (cong fib (n+0≡n k))
key-lemma (suc n) k = begin 
  f n (fib (suc k)) (fib k + fib (suc k)) ≡⟨ key-lemma n (suc k) ⟩ 
  fib (suc (k + n))                       ≡⟨ cong fib (1+m+n≡m+1+n k n) ⟩ 
  fib (k + suc n) ∎

fast_fib_correct : ∀ n → fast_fib n ≡ fib n
fast_fib_correct n = key-lemma n 0