[Agda] example with insertion to list

Sergei Meshveliani mechvel at botik.ru
Tue Feb 7 13:20:08 CET 2017


Please,

can anybody fix the proof for  lemma2  in the attached code 
(about 140 lines) ?

It is about a certain insertion of a natural into a decreasingly ordered
list of naturals. Such a list is called  Pol.
Insertion of  e  into  es  is according to _>_, and it is without
copying, that is when  es  contains any  e' ≡ e,  the result is  es.

Insertion is called  mon+. 
lemma1 and lemma2  are certain two very simple statements about
insertion of  e  into  (e' ∷ es)  for  e < e'.

lemma1  is for the case of  es = [].  And it is proved trivially.

And a similar proof for  lemma2  is not type-checked (in Agda 2.5.2).
Moreover, I do not find any proof to satisfy Agda.

Maybe, this is a bug in Agda?

Thanks,

------
Sergei

-------------- next part --------------
{-
Can anybody, please, fix the proof for  lemma2  
in the attached code (about 140 lines) ?

It is about a certain insertion of a natural into a decreasingly ordered 
list of naturals. Such a list is called  Pol.
Insertion of  e  into  es  is according to _>_, and it is without copying, 
that is when  es  contains any  e' ≡ e,  the result is  es.

Insertion is called  mon+. 
lemma1 and lemma2  are certain two very simple statements about insertion 
of  e  into  (e' ∷ es)  for  e < e'.

lemma1  is for the case of  es = [].  And it is proved trivially.

But a similar proof for  lemma2  is not type-checked (in Agda 2.5.2).
Moreover, I do not find any proof to satisfy Agda.

Maybe, this is a bug in Agda?

Thanks,

------
Sergei
-}

open import Function using (_∘_; case_of_)
open import Algebra.FunctionProperties using (Op₂)
open import Relation.Binary using (Rel; Tri; DecTotalOrder; StrictTotalOrder)
open import Relation.Binary.PropositionalEquality as PE using (_≡_)
open import Data.Empty   using (⊥-elim) 
open import Data.Sum     using (_⊎_)
open import Data.Product using (_×_; _,_; proj₁; proj₂; ∃)
open import Data.List    using (List; []; _∷_) 
open import Data.List.All as AllM using (All) 
open import Data.Nat as Nat       using (ℕ; suc; _≤_; _<_; _>_) 
open import Data.Nat.Properties as NatProp using ()


--****************************************************************************
postulate anything : ∀ {a} {A : Set a} → A   -- for debug 

natSTO = NatProp.strictTotalOrder 
open StrictTotalOrder natSTO using (compare) 

record Max (x y : ℕ) :  Set 
       where
       constructor max′
       field
         it      : ℕ
         x-or-y  : it ≡ x ⊎ it ≡ y
         both≤it : x ≤ it × y ≤ it

postulate  extMax :  (x y : ℕ) → Max x y

_⊔_ : Op₂ ℕ
_⊔_ x =  Max.it ∘ extMax x

both≤⊔ :  ∀ x y → x ≤ x ⊔ y × y ≤ x ⊔ y
both≤⊔ x =
           Max.both≤it ∘ extMax x

------------------------------------------------------------------------------
data DecrOrdered :  List ℕ → Set 
     where
     nil    : DecrOrdered []
     single : (x : ℕ) → DecrOrdered (x ∷ [])
     prep2  : (x y : ℕ) → (xs : List ℕ) → x > y → DecrOrdered (y ∷ xs) →
                                                  DecrOrdered (x ∷ y ∷ xs)

tailDecrOrdered :  ∀ {x xs} → DecrOrdered (x ∷ xs) → DecrOrdered xs
tailDecrOrdered (single _)                = nil
tailDecrOrdered (prep2 x y xs _ ord-y:xs) = ord-y:xs


------------------------------------------------------------------------------
E : Set 
E = ℕ 

record Pol :  Set where
                  constructor pol′

                  field  exps    : List E
                         ordered : DecrOrdered exps   -- e1 > ... > en 

monPol : E → Pol
monPol e =  pol′ (e ∷ []) (DecrOrdered.single e)

hdExp' : List E → ℕ
hdExp' []      = 0
hdExp' (e ∷ _) = suc e
   
deg' : Pol → ℕ
deg' = hdExp' ∘ Pol.exps

------------------------------------------------------------------------------
open Tri 

------------------------------------------------------------------------------
extMon+ : (e : E) → (f : Pol) → (∃ \h → deg' h ≤ (suc e) ⊔ (deg' f)) 

extMon+ e (pol′ es ord) =  aux es ord 
  where
  se = suc e

  aux : (es0 : List E) → DecrOrdered es0 → (∃ \h → deg' h ≤ se ⊔ (hdExp' es0)) 

  aux []        _        = (monPol e , leq)  where
                                             leq : se ≤ se ⊔ 0  
                                             leq = proj₁ (both≤⊔ se 0)
  aux (e' ∷ es) ord-e'es  with compare e e'
  ... 
      | tri> _ _ e>e' =  (pol′ (e ∷ e' ∷ es) ord-ee'se , leq)
                         where
                         leq : se ≤ se ⊔ (suc e')
                         leq = proj₁ (both≤⊔ se (suc e'))

                         postulate  ord-ee'se : DecrOrdered (e ∷ e' ∷ es)

  ... | tri< e<e' _ _ =  (pol′ (e' ∷ esG) ord-e'esG , leq)
                         where
                         ord-es : DecrOrdered es
                         ord-es = tailDecrOrdered ord-e'es

                         esG = Pol.exps (proj₁ (aux es ord-es))  

                         leq :  (suc e') ≤ se ⊔ (suc e') 
                         leq =  proj₂ (both≤⊔ se (suc e'))
 
                         postulate  ord-e'esG : DecrOrdered (e' ∷ esG)

  ... | tri≈ _ e≡e' _ =  (pol′ (e ∷ es) ord-ees , leq) 
                         -- here  e  is contrived 
                         where
                         e'es≡ees : e' ∷ es ≡ e ∷ es 
                         e'es≡ees = PE.cong (_∷ es) (PE.sym e≡e')

                         ord-ees : DecrOrdered (e ∷ es)
                         ord-ees = PE.subst DecrOrdered e'es≡ees ord-e'es 
                                
                         leq : se ≤ se ⊔ (suc e')
                         leq = proj₁ (both≤⊔ se (suc e'))


------------------------------------------------------------------------------
mon+ : E → Pol → Pol 
mon+ e =  proj₁ ∘ extMon+ e


------------------------------------------------------------------------------
lemma1 : ∀ e e' → e < e' →  Pol.exps (mon+ e (monPol e')) ≡ e' ∷ e ∷ []

lemma1 e e' e<e'  with compare e e'
...               | tri< _    _ _ = PE.refl
...               | tri> e≮e' _ _ = ⊥-elim (e≮e' e<e')
...               | tri≈ e≮e' _ _ = ⊥-elim (e≮e' e<e')


-- Problem
lemma2 : ∀ e e' es → (ord-e'es : DecrOrdered (e' ∷ es)) → e < e' →
                     let 
                       f = pol′ (e' ∷ es) ord-e'es

                       ord-es : DecrOrdered es 
                       ord-es = tailDecrOrdered ord-e'es 

                       f' = pol′ es ord-es
                     in
                     Pol.exps (mon+ e f) ≡ e' ∷ (Pol.exps (mon+ e f'))

lemma2 e e' es ord-e'es e<e'  with compare e e'

... | tri< _ _ _ =  PE.refl
                    -- anything

      {- Intended: 
         = goal
           where
           ord-es = tailDecrOrdered ord-e'es
           f'     = pol′ es ord-es  
           goal   = 
             begin
               Pol.exps (mon+ e (pol′ (e' ∷ es) ord-e'es))   ≡[ PE.refl ]

               let esG = Pol.exps (proj₁ (aux es ord-es))  
               in
               Pol.exps (pol′ (e' ∷ esG) _)                  ≡[ PE.refl ]

               e' ∷ esG                                      ≡[ PE.refl ]
               e' ∷ (Pol.exps (proj₁ (aux es ord-es)))       ≡[ PE.refl ]
               e' ∷ (Pol.exps (mon+ e f')) 
             end
      -}  

... | _ = anything


More information about the Agda mailing list