How to indicate decreasing in size of two Coq inductive types

后端 未结 2 1415
一向
一向 2021-01-14 21:34

I\'m trying to define the game inductive type for combinatorial games. I want a comparison method which tells if two games are lessOrEq, gre

2条回答
  •  失恋的感觉
    2021-01-14 22:20

    One way of indicating the decreasing arguments of a function is by using an ad-hoc predicate that describes the domain of that function.

    Inductive gameCompareDom : compare_quest ->  game -> game -> Prop :=
      | gameCompareDom1 : forall c g1 g2, innerGCompareDom (nextCompare c) (compareCombiner c) g1 (g1side c g1) g2 (g2side c g2) -> gameCompareDom c g1 g2
    
    with innerGCompareDom : compare_quest -> combiner -> game -> gamelist -> game -> gamelist -> Prop :=
      | innerGCompareDom1 : forall next_c cbn g1 g1s g2 g2s, listGameCompareDom next_c cbn g1s g2 -> gameListCompareDom next_c cbn g1 g2s -> innerGCompareDom next_c cbn g1 g1s g2 g2s
    
    with listGameCompareDom : compare_quest -> combiner -> gamelist -> game -> Prop :=
      | listGameCompareDom1 : forall c cbn g1s g2, g1s = emptylist -> listGameCompareDom c cbn g1s g2
      | listGameCompareDom2 : forall c cbn g1s g2 g1s_car g1s_cdr, g1s = listCons g1s_car g1s_cdr -> gameCompareDom c g1s_car g2 -> listGameCompareDom c cbn g1s_cdr g2 -> listGameCompareDom c cbn g1s g2
    
    with gameListCompareDom : compare_quest -> combiner -> game -> gamelist -> Prop :=
      | gameListCompareDom1 : forall c cbn g1 g2s, g2s = emptylist -> gameListCompareDom c cbn g1 g2s
      | gameListCompareDom2 : forall c cbn g1 g2s g2s_car g2s_cdr, g2s = listCons g2s_car g2s_cdr -> gameCompareDom c g1 g2s_car -> gameListCompareDom c cbn g1 g2s_cdr -> gameListCompareDom c cbn g1 g2s.
    

    Armed with some inversion lemmas and proof that your function is total you can define the function like this:

    Lemma gameCompareDom1Inv : forall c g1 g2, gameCompareDom c g1 g2 ->
      innerGCompareDom (nextCompare c) (compareCombiner c) g1 (g1side c g1) g2 (g2side c g2).
    
    Lemma innerGCompareDom1Inv1 : forall next_c cbn g1 g1s g2 g2s,
      innerGCompareDom next_c cbn g1 g1s g2 g2s ->
      listGameCompareDom next_c cbn g1s g2.
    
    Lemma innerGCompareDom1Inv2 : forall next_c cbn g1 g1s g2 g2s,
      innerGCompareDom next_c cbn g1 g1s g2 g2s ->
      gameListCompareDom next_c cbn g1 g2s.
    
    Lemma listGameCompareDom2Inv1 : forall c cbn g1s g2 g1s_car g1s_cdr,
      listGameCompareDom c cbn g1s g2 -> g1s = listCons g1s_car g1s_cdr ->
      gameCompareDom c g1s_car g2.
    
    Lemma listGameCompareDom2Inv2 : forall c cbn g1s g2 g1s_car g1s_cdr,
      listGameCompareDom c cbn g1s g2 -> g1s = listCons g1s_car g1s_cdr ->
      listGameCompareDom c cbn g1s_cdr g2.
    
    Lemma gameListCompareDom2Inv1 : forall c cbn g1 g2s g2s_car g2s_cdr,
      gameListCompareDom c cbn g1 g2s -> g2s = listCons g2s_car g2s_cdr ->
      gameCompareDom c g1 g2s_car.
    
    Lemma gameListCompareDom2Inv2 : forall c cbn g1 g2s g2s_car g2s_cdr,
      gameListCompareDom c cbn g1 g2s -> g2s = listCons g2s_car g2s_cdr ->
      gameListCompareDom c cbn g1 g2s_cdr.
    
    Fixpoint gameCompareAux (c : compare_quest) (g1 : game) (g2 : game) (H1 : gameCompareDom c g1 g2) : Prop :=
      innerGCompareAux (nextCompare c) (compareCombiner c) g1 (g1side c g1) g2 (g2side c g2) (gameCompareDom1Inv _ _ _ H1)
    
    with innerGCompareAux (next_c : compare_quest) (cbn : combiner) (g1 : game) (g1s : gamelist) (g2 : game) (g2s : gamelist) (H1 : innerGCompareDom next_c cbn g1 g1s g2 g2s) : Prop :=
      cbn (listGameCompareAux next_c cbn g1s g2 (innerGCompareDom1Inv1 _ _ _ _ _ _ H1)) (gameListCompareAux next_c cbn g1 g2s (innerGCompareDom1Inv2 _ _ _ _ _ _ H1))
    
    with listGameCompareAux (c : compare_quest) (cbn : combiner) (g1s : gamelist) (g2 : game) (H1 : listGameCompareDom c cbn g1s g2) : Prop :=
      match g1s as gl1 return g1s = gl1 -> Prop with
      | emptylist                => fun H2 => cbn_init cbn
      | listCons g1s_car g1s_cdr => fun H2 => cbn (gameCompareAux c g1s_car g2 (listGameCompareDom2Inv1 _ _ _ _ _ _ H1 H2)) (listGameCompareAux c cbn g1s_cdr g2 (listGameCompareDom2Inv2 _ _ _ _ _ _ H1 H2))
      end eq_refl
    
    with gameListCompareAux (c : compare_quest) (cbn : combiner) (g1 : game) (g2s : gamelist) (H1 : gameListCompareDom c cbn g1 g2s) : Prop :=
      match g2s as gl1 return g2s = gl1 -> Prop with
      | emptylist                => fun H2 => cbn_init cbn
      | listCons g2s_car g2s_cdr => fun H2 => cbn (gameCompareAux c g1 g2s_car (gameListCompareDom2Inv1 _ _ _ _ _ _ H1 H2)) (gameListCompareAux c cbn g1 g2s_cdr (gameListCompareDom2Inv2 _ _ _ _ _ _ H1 H2))
      end eq_refl.
    
    Lemma gameCompareTot : forall c g1 g2, gameCompareDom c g1 g2.
    
    Lemma innerGCompareTot : forall next_c cbn g1 g1s g2 g2s,
      innerGCompareDom next_c cbn g1 g1s g2 g2s.
    
    Lemma listGameCompareTot : forall g2 g1s c cbn,
      listGameCompareDom c cbn g1s g2.
    
    Lemma gameListCompareTot : forall g1 g2s c cbn,
      gameListCompareDom c cbn g1 g2s.
    
    Definition gameCompare (c : compare_quest) (g1 : game) (g2 : game) : Prop :=
      gameCompareAux c g1 g2 (gameCompareTot _ _ _).
    
    Definition innerGCompare (next_c : compare_quest) (cbn : combiner) (g1 : game) (g1s : gamelist) (g2 : game) (g2s : gamelist) : Prop :=
      innerGCompareAux next_c cbn g1 g1s g2 g2s (innerGCompareTot _ _ _ _ _ _).
    
    Definition listGameCompare (c : compare_quest) (cbn : combiner) (g1s : gamelist) (g2 : game) : Prop :=
      listGameCompareAux c cbn g1s g2 (listGameCompareTot _ _ _ _).
    
    Definition gameListCompare (c : compare_quest) (cbn : combiner) (g1 : game) (g2s : gamelist) : Prop :=
      gameListCompareAux c cbn g1 g2s (gameListCompareTot _ _ _ _).
    

    The proofs of the inversion lemmas must end with Defined. instead of Qed. so that their content is transparent and available for computation. They must also not reference any opaque theorems.

    Afterwards, you should be able to define the following equation lemmas by resorting to the axiom of proof irrelevance:

    Lemma gameCompareEq : forall c g1 g2, gameCompare c g1 g2 =
      innerGCompare (nextCompare c) (compareCombiner c) g1 (g1side c g1) g2 (g2side c g2).
    
    Lemma innerGCompareEq : forall next_c cbn g1 g1s g2 g2s, innerGCompare next_c cbn g1 g1s g2 g2s =
      cbn (listGameCompare next_c cbn g1s g2) (gameListCompare next_c cbn g1 g2s).
    
    Lemma listGameCompareEq : forall c cbn g1s g2, listGameCompare c cbn g1s g2 =
      match g1s with
      | emptylist                => cbn_init cbn
      | listCons g1s_car g1s_cdr => cbn (gameCompare c g1s_car g2) (listGameCompare c cbn g1s_cdr g2)
      end.
    
    Lemma gameListCompareEq : forall c cbn g1 g2s, gameListCompare c cbn g1 g2s =
      match g2s with
      | emptylist                => cbn_init cbn
      | listCons g2s_car g2s_cdr => cbn (gameCompare c g1 g2s_car) (gameListCompare c cbn g1 g2s_cdr)
      end.
    

    You can use Extraction Inline on the auxiliary functions so that your main functions look like you would expect them to when extracted. But that doesn't apply here because your functions return Props instead of bools.

    Full development here.

提交回复
热议问题