Упрощение подформул в Coq

Я пытаюсь решить уравнение вида

A * B * C * D * E = F

где * некоторая сложная левая ассоциативная операция.

На данный момент все непрозрачно (включая * и A до F), и можно сделать прозрачным через autounfold with M_db.

Проблема в том, что если я глобально разверну определение в формуле, упрощение затянется навсегда. Вместо этого я хочу сначала развернуть A * B, применить некоторые тактики, чтобы привести его к нормальной форме X, а затем сделать то же самое с X * C и так далее.

Есть идеи, как мне это сделать? Вот мой текущий подход, но in A или at A не работает. Кроме того, мне непонятно, правильная ли это структура или reduce_m должна что-то возвращать.

Ltac reduce_m M :=
  match M with
  | ?A × ?B => reduce_m A;
              reduce_m B;
              simpl;
              autorewrite with C_db
  | ?A      => autounfold with M_db (* in A *);
              simpl; 
              autorewrite with C_db
  end.


Ltac simpl_m := 
  match goal with
  | [|- ?M = _ ] => reduce_m M
  end.

Минималистичный пример:

Require Import Arith.

Definition add_f (f g : nat -> nat) :=  fun x => f x + g x.

Infix "+" := add_f.

Definition f := fun x => if x =? 4 then 1 else 0.
Definition g := fun x => if x <=? 4 then 3 else 0.
Definition h := fun x => if x =? 2 then 2 else 0.

Lemma ex : f + g + h = fun x => match x with
                             | 0 => 3
                             | 1 => 3
                             | 2 => 5
                             | 3 => 3
                             | 4 => 4
                             | _ => 0 
                             end.

person Rand00    schedule 13.09.2017    source источник


Ответы (1)


Вы можете поместить свой термин в гипотезу и autounfold в нее. То есть можно заменить

autounfold with M_db (* in A *)

с

let Aterm := fresh in
set (Aterm := A);
autounfold with M_db in Aterm;
subst Aterm

Если ваш A слишком большой, это будет медленно, потому что set немного сложнее и выполняет какое-то сокращение. Если это так, вы можете настроить свою цель так, чтобы у вас было:

HA     : A' = A
HB     : B' = B
HC     : C' = C
HD     : D' = D
HE     : E' = E
HAB    : AB = A' * B'
HABC   : ABC = AB * C'
HABCD  : ABCD = ABC * D'
HABCDE : ABCDE = ABCD * E'
------------------------
ABCDE = F

и тогда вы можете сделать что-то вроде

Ltac reduce H :=
  autounfold with M_db in H; simpl in H; autorewrite with C_db in H.

reduce HA; reduce HB; reduce HC; reduce HD; reduce HE;
subst A' B'; reduce HAB;
subst AB C'; reduce HABC;
subst ABC D'; reduce HABCD;
subst ABCD E'; reduce HABCDE;
subst ABCDE.

Обновление для учетной записи для примера:

Чтобы выполнить сокращение вашей функции, вам действительно нужна либо экстенсиональность функции, либо использование отношения, отличного от =. Однако вам не нужна расширяемость функций для выполнения битов модульности:

Require Import Arith.

Definition add_f (f g : nat -> nat) :=  fun x => f x + g x.

Infix "+" := add_f.

Definition f := fun x => if x =? 4 then 1 else 0.
Definition g := fun x => if x <=? 4 then 3 else 0.
Definition h := fun x => if x =? 2 then 2 else 0.

Ltac save x x' H :=
  remember x as x' eqn:H in *.

Lemma ex : f + g + h = fun x => match x with
                                | 0 => 3
                                | 1 => 3
                                | 2 => 5
                                | 3 => 3
                                | 4 => 4
                                | _ => 0 
                                end.
Proof.
  save f f' Hf; save g g' Hg; save h h' Hh;
  save (f' + g') fg Hfg; save (fg + h') fgh Hfgh.
  cbv [f g] in *.
  subst f' g'.
  cbv [add_f] in Hfg.
  (* note: if you want to simplify [(if x =? 4 then 1 else 0) +
      (if x <=? 4 then 3 else 0)], then you need function
      extensionality.  However, you don't need it simply to
      modularize the simplification. *)

В качестве альтернативы, если вы настроите свою цель немного по-другому, вы можете избежать расширения функции:

Require Import Arith Coq.Classes.RelationClasses Coq.Setoids.Setoid Coq.Classes.Morphisms.

Definition add_f (f g : nat -> nat) :=  fun x => f x + g x.

Infix "+" := add_f.

Definition f := fun x => if x =? 4 then 1 else 0.
Definition g := fun x => if x <=? 4 then 3 else 0.
Definition h := fun x => if x =? 2 then 2 else 0.

Ltac save x x' H :=
  remember x as x' eqn:H in *.
Definition nat_case (P : nat -> Type) (o : P 0) (s : forall n, P (S n)) (x : nat) : P x
  := match x with
     | 0 => o
     | S n' => s n'
     end.
Lemma nat_case_plus (a a' : nat) (b b' : nat -> nat) (x : nat)
  : (nat_case _ a b x + nat_case _ a' b' x)%nat = nat_case _ (a + a')%nat (fun x => b x + b' x)%nat x.
Proof. destruct x; reflexivity. Qed.
Lemma nat_case_plus_const (a : nat) (b : nat -> nat) (x : nat) (y : nat)
  : (nat_case _ a b x + y)%nat = nat_case _ (a + y)%nat (fun x => b x + y)%nat x.
Proof. destruct x; reflexivity. Qed.
Global Instance nat_case_Proper {P} : Proper (eq ==> forall_relation (fun _ => eq) ==> forall_relation (fun _ => eq)) (nat_case P).
Proof.
  unfold forall_relation; intros x x' ? f f' Hf [|a]; unfold nat_case; auto.
Qed.
Global Instance nat_case_Proper' {P} : Proper (eq ==> pointwise_relation _ eq ==> forall_relation (fun _ => eq)) (nat_case (fun _ => P)).
Proof.
  unfold forall_relation, pointwise_relation; intros x x' ? f f' Hf [|a]; unfold nat_case; auto.
Qed.
Global Instance nat_case_Proper'' {P} {x} : Proper (pointwise_relation _ eq ==> eq ==> eq) (nat_case (fun _ => P) x).
Proof.
  intros ??? a b ?; subst b; destruct a; simpl; auto.
Qed.
Global Instance nat_case_Proper''' {P} {x} : Proper (forall_relation (fun _ => eq) ==> eq ==> eq) (nat_case (fun _ => P) x).
Proof.
  intros ??? a b ?; subst b; destruct a; simpl; auto.
Qed.
Ltac reduce :=
  let solve_tac := unfold nat_case; repeat match goal with |- context[match ?x with O => _ | _ => _ end] => destruct x end; reflexivity in
  repeat match goal with
         | [ H : context[if ?x =? 4 then ?a else ?b] |- _ ]
           => replace (if x =? 4 then a else b) with (match x with 4 => a | _ => b end) in H by solve_tac
         | [ H : context[if ?x =? 2 then ?a else ?b] |- _ ]
           => replace (if x =? 2 then a else b) with (match x with 2 => a | _ => b end) in H by solve_tac
         | [ H : context[if ?x <=? 4 then ?a else ?b] |- _ ]
           => replace (if x <=? 4 then a else b) with (match x with 0 | 1 | 2 | 3 | 4 => a | _ => b end) in H by solve_tac
         | [ H : context G[match ?x as x' in nat return @?T x' with O => ?a | S n => @?s n end] |- _ ]
           => let G' := context G[@nat_case T a s x] in
              change G' in H
         | [ H : context G[fun v => match @?x v as x' in nat return @?T x' with O => ?a | S n => @?s n end] |- _ ]
           => let G' := context G[fun v => @nat_case T a s (x v)] in
              change G' in H; cbv beta in *
         | [ H : context[(nat_case _ _ _ _ + nat_case _ _ _ _)%nat] |- _ ]
           => progress repeat setoid_rewrite nat_case_plus in H; simpl in H
         | [ H : context[(nat_case _ _ _ _ + _)%nat] |- _ ]
           => progress repeat setoid_rewrite nat_case_plus_const in H; simpl in H
         end.
Lemma ex : forall x, (f + g + h) x = match x with
                                     | 0 => 3
                                     | 1 => 3
                                     | 2 => 5
                                     | 3 => 3
                                     | 4 => 4
                                     | _ => 0 
                                     end.
Proof.
  intro x; cbv [add_f].
  save (f x) f' Hf; save (g x) g' Hg; save (h x) h' Hh; save (f' + g')%nat fg Hfg; save (fg + h')%nat fgh Hfgh.
  cbv [f g] in *.
  subst f' g'; reduce.
  cbv [h] in *; reduce.
  subst fg h'; reduce.
  subst fgh.
  unfold nat_case.
  reflexivity.
Qed.
person Jason Gross    schedule 14.09.2017
comment
Спасибо! Несколько более хитрое продолжение: A, B, C, D, E и F на самом деле являются функциями с конечной поддержкой. Это означает, что я должен использовать функциональную экстенсиональность и деструктировать, чтобы доказать AB = A' * B' (то есть, если AB должна быть простой функцией). К сожалению, если я попытаюсь ввести эвар AB (скажем), я не смогу унифицировать 1/2 = ?AB 1 3. Я пробовал такие вещи, как прозрачное утверждение из библиотеки HOTT, чтобы построить функцию, которая равна A' * B' на всех входных данных, но я не могу извлечь только функцию, соответствующую AB, из более широкого термина доказательства. - person Rand00; 14.09.2017
comment
На самом деле, мы могли бы просто сначала создать функцию с соответствующей поддержкой, кодовый домен которой полностью состоит из evars, а затем выполнить этот процесс унификации. (Хотя это может быть немного запутанно - приветствуются другие предложения.) - person Rand00; 14.09.2017
comment
Я не понимаю. A * B хорошо напечатано, верно? Таким образом, вы должны быть в состоянии записать A' * B'. Предполагается, что AB является новой переменной в контексте, равной A' * B' (т. е. remember (A' * B') as AB eqn:HAB). Или вы можете сделать что-то вроде: set (AB := A * B); assert (HAB : AB = A * B) by reflexivity; clearbody AB; set (A' := A) in *; set (B' := B) in *; assert (HA : A = A') by reflexivity; assert (HB : B = B') by reflexivity; clearbody A' B'?. - person Jason Gross; 15.09.2017
comment
Он хорошо типизирован. Цель здесь состоит в том, чтобы сделать AB простой функцией, а не произведением двух сложных функций. И (насколько я мог судить) для этого мне нужна была функциональная экстенсиональность. В конце концов, я попросил Ltac построить терм (fun x => match x with | O => ?e1 | S O => ?e2 | ... ) подходящего размера и использовать replace (A*B) with [above], за которым последовала функциональная экстенсиональность и вычисления, которые заполнили evars и доказали равенство. - person Rand00; 16.09.2017
comment
Использование replace с эваром также оказалось удобным, потому что тогда я мог построить нужный терм в цели. Это также сделало запуск с самого маленького продукта более естественным. - person Rand00; 16.09.2017
comment
У вас есть полный минимальный (не) рабочий пример? Вам не нужна функциональная экстенсиональность, но я не думаю, что могу сказать что-то еще без реального кода. - person Jason Gross; 16.09.2017
comment
Добавил пример выше. Я хочу заменить f + g на k, где k — простая функция. - person Rand00; 16.09.2017
comment
Обновлено приложением к этому примеру - person Jason Gross; 16.09.2017