Question

我有一个（明显的）陈述的证据，即在矩阵的展平表示中查找元素作为m * n长度向量与向量矢量表示相同。但我的证据很笨拙。 [我不会在这里给出证据，因为这样做会使搜索偏向！]。为了使这个问题自成一体，我在下面给出了一个包含一些有用的lemma的自包含Agda模块。 [其中一些引理可能应该在标准库中，但不是。]

基本上，我正在寻找一种优雅的方法来填补底部的洞，lookup∘concat的证明。如果你能使我的外表更优雅，那就随意吧！

module NNN where

open import Data.Nat
open import Data.Nat.Properties.Simple
open import Data.Nat.Properties
open import Data.Vec
open import Data.Fin using (Fin; inject≤; fromℕ; toℕ)
open import Data.Fin.Properties using (bounded)
open import Data.Product using (_×_; _,_)
open import Relation.Binary.PropositionalEquality

-- some useful lemmas
cong+r≤ : ∀ {i j} → i ≤ j → (k : ℕ) → i + k ≤ j + k
cong+r≤ {0}     {j}     z≤n       k = n≤m+n j k
cong+r≤ {suc i} {0}     ()        k -- absurd
cong+r≤ {suc i} {suc j} (s≤s i≤j) k = s≤s (cong+r≤ {i} {j} i≤j k)

cong+l≤ : ∀ {i j} → i ≤ j → (k : ℕ) → k + i ≤ k + j
cong+l≤ {i} {j} i≤j k =
  begin (k + i
           ≡⟨ +-comm k i ⟩ 
         i + k
           ≤⟨ cong+r≤ i≤j k ⟩ 
         j + k
           ≡⟨ +-comm j k ⟩ 
         k + j ∎)
  where open ≤-Reasoning

cong*r≤ : ∀ {i j} → i ≤ j → (k : ℕ) → i * k ≤ j * k
cong*r≤ {0}     {j}     z≤n       k = z≤n
cong*r≤ {suc i} {0}     ()        k -- absurd
cong*r≤ {suc i} {suc j} (s≤s i≤j) k = cong+l≤ (cong*r≤ i≤j k) k 

sinj≤ : ∀ {i j} → suc i ≤ suc j → i ≤ j
sinj≤ {0}     {j}     _        = z≤n
sinj≤ {suc i} {0}     (s≤s ()) -- absurd
sinj≤ {suc i} {suc j} (s≤s p)  = p

i*n+k≤m*n : ∀ {m n} → (i : Fin m) → (k : Fin n) → 
            (suc (toℕ i * n + toℕ k) ≤ m * n)
i*n+k≤m*n {0} {_} () _
i*n+k≤m*n {_} {0} _ ()
i*n+k≤m*n {suc m} {suc n} i k = 
  begin (suc (toℕ i * suc n + toℕ k) 
           ≡⟨  cong suc (+-comm (toℕ i * suc n) (toℕ k))  ⟩
         suc (toℕ k + toℕ i * suc n)
           ≡⟨ refl ⟩
         suc (toℕ k) + (toℕ i * suc n)
           ≤⟨ cong+r≤ (bounded k) (toℕ i * suc n) ⟩ 
         suc n + (toℕ i * suc n)
           ≤⟨ cong+l≤ (cong*r≤ (sinj≤ (bounded i)) (suc n)) (suc n) ⟩
         suc n + (m * suc n) 
           ≡⟨ refl ⟩
         suc m * suc n ∎)
  where open ≤-Reasoning

fwd : {m n : ℕ} → (Fin m × Fin n) → Fin (m * n)
fwd {m} {n} (i , k) = inject≤ (fromℕ (toℕ i * n + toℕ k)) (i*n+k≤m*n i k)

lookup∘concat : ∀ {m n} {A : Set} (i : Fin m) (j : Fin n) 
  (xss : Vec (Vec A n) m) → 
  lookup (fwd (i , j)) (concat xss) ≡ lookup j (lookup i xss)
lookup∘concat i j xss = {!!}

Answer 1

最好通过归纳来定义fwd，然后是其余的。

open import Data.Nat.Base
open import Data.Fin hiding (_+_)
open import Data.Vec
open import Data.Vec.Properties
open import Relation.Binary.PropositionalEquality

fwd : ∀ {m n} -> Fin m -> Fin n -> Fin (m * n)
fwd {suc m} {n}  zero   j = inject+ (m * n) j
fwd     {n = n} (suc i) j = raise n (fwd i j)

-- This should be in the standard library.
lookup-++-raise : ∀ {m n} {A : Set} (j : Fin n) (xs : Vec A m) (ys : Vec A n)
                -> lookup (raise m j) (xs ++ ys) ≡ lookup j ys
lookup-++-raise j  []      ys = refl
lookup-++-raise j (x ∷ xs) ys = lookup-++-raise j xs ys

lookup∘concat : ∀ {m n} {A : Set} i j (xss : Vec (Vec A n) m) 
              -> lookup (fwd i j) (concat xss) ≡ lookup j (lookup i xss)
lookup∘concat  zero   j (xs ∷ xss) = lookup-++-inject+ xs (concat xss) j
lookup∘concat (suc i) j (xs ∷ xss)
  rewrite lookup-++-raise (fwd i j) xs (concat xss) = lookup∘concat i j xss

fwd的健全性证明：

module Soundness where
  open import Data.Nat.Properties.Simple
  open import Data.Fin.Properties

  soundness : ∀ {m n} (i : Fin m) (j : Fin n) -> toℕ (fwd i j) ≡ toℕ i * n + toℕ j
  soundness {suc m} {n}  zero   j = sym (inject+-lemma (m * n) j)
  soundness     {n = n} (suc i) j rewrite toℕ-raise n (fwd i j)
                                        | soundness i j
                                        = sym (+-assoc n (toℕ i * n) (toℕ j))

扁平矩阵与2D矩阵查找等价（证明） - 寻求更优雅

1 个答案: