SSReflect メモ: View Lemma

View Lemma.むずかしい….

まず,普通はあまり使わない向きかもしれないが,
bv1 /\ bv2 -> G
に対して
move/andP
を実行すると,
bv1 && bv2 -> G
になるメカニズムは,だいたい以下のようになっていると思われる.

andP の型は,reflect なので
(andP b1 b2 : reflect (b1 /\ b2) (b1 && b2)),
view hint に登録されている以下の6つのうちのどれかが使われて,
andPtop: bv1 /\ bv2が引数に渡される.
第1,2引数の P と b は,andP と top を渡したときにちゃんと型がつく
ように埋められるらしい.(reference manual Section 9.6)

Variables (P:Prop) (b c:bool).
Lemma elimTF  : reflect P b      ->    b = c -> if c then P else ~ P.
Lemma elimNTF : reflect P b      -> ~~ b = c -> if c then ~ P else P.
Lemma elimTFn : reflect P (~~ b) ->    b = c -> if c then ~ P else P.
Lemma introT  : reflect P b      ->      P   -> b.
Lemma introTn : reflect P (~~ b) ->    ~ P   -> b.
Lemma introN  : reflect P b      ->    ~ P   -> ~~ b.

今回の場合,これでマッチするのは introT なのでこれが使われて,正確には
generalize (introT andP top)が実行されて,
bv1 && bv2 -> G になる,ということのようである.
reference manual には,この項の top の入り方が書かれてないのでイマイチよくわからないが.

さて,では,もっと普通に使う bv1 && bv2 -> Gbv1 /\ bv2 -> G
に直すのはどうなっているか.この場合,intro した時点で,導入される context は,
top : bv1 && bv2 に見えている.これだと
view_lemma andP top がどこともマッチしないように見えるが,
view lemma の2番目の引数の型のソートは Prop なので,coercion が効いて,
is_true (bv1 && bv2) 型 すなわち (bv1 && bv2) = true
と考えることもできる.こう考えると, b = bv1 && bv2, c = true
とマッチすることができて, elimTF andP top
if true then bv1 /\ bv2 else ~ (bv1 /\ bv2) ,すなわち
bv1 /\ bv2 型になる.実際, generalize (elimTF andP top)
してみると, bv1 /\ bv2 が挿入される.

DFSチュートリアルに出てきたものから,応用例を.

contextに正しくない boolean predicate,たとえば H: x + y < x があった
とする.ゴールGがなんであろうと無視して証明をしたい.
こういうときに,Hの否定の方の証明
(この場合, leq_addr y x : x <= x + y )がすでにあれば,
case/idPn (leq_addr y x) とすればよい.

まず,idPn (b:bool) = reflect (~~b) (~~b) であるから, P
~~ b で,elimTFn にマッチすることになる,move/idPn であれば,
~ (~~ b) -> G となるところであるが,case/idPn なら,ここで
さらに場合分けが行われる.別記事に書いたように,not の場合分けを行うと
ゴールが ~~ b となる.今の場合だと ~ (x <= x + y) なので,
たとえば by rewrite -leqNgt. で証明が終わる.ここで,
leqNgt a b = (a <= b) = ~~ (a < b)

CentOS 6.5

自宅のマシン (Windows 7) の VMware player に CentOS 6.5 (64bit) の仮想マシンを作成しようとしている.
coq, ssreflect, Java PathFinder を利用する予定.
以下,作業メモ.


http://ftp.riken.jp/Linux/centos/6.5/isos/x86_64/
から CentOS-6.5-x86_64-bin-DVD1.iso
CentOS-6.5-x86_64-bin-DVD2.iso
をダウンロードして使う.DVD1.iso のダウンロードには15分くらいかかる.

sudoers を追加./etc/sudoers.d/01user というファイルを作って,
そこに username ALL=(ALL) ALL という行を追加.

vmware tools をインストール

ホームディレクトリの下の日本語名のファイルを英語名に変更

$ LANG=C xdg-user-dirs-gtk-update

起動時にネットワークをONにするため,
/etc/sysconfig/network-scripts/ifcfg-eth0
ONBOOT=yes
と指定する.

dropboxをインストール.rpmファイルがダウンロードできるので,
以下を実行

# rpm -ivh hoge.rpm

良くはわからないが,どうも
/etc/yum.repos.d/dropbox.repo が作られて,その内容が
正しくないようで,このあと yum が失敗するようになる.
上記ファイルを削除しておく.

gccなどをインストール.

# yum install gcc gtk2-devel libXpm-devel libjpeg-turbo-devel libtiff-devel giflib-devel ncurses-devel

emacs24.3をインストール

$ ./configure --without-gsettings
$ make
$ src/emacs -Q     (テスト)
$ sudo make install

このうち,--without-gsettingsは,
CentOS6.5のビルド問題回避のために必要らしい.

既存マシンから .bashrc や .emacs などをコピー (dropboxにしまってある)

OCaml4.01をインストール.
(現時点の最新は4.02だが,Camlp5がまだ対応していないようだ

$ ./configure
$ make world
$ make bootstrap
$ make opt
$ make opt.opt
$ sudo make install
$ make clean

Camlp5 をインストール

$ ./configure --transitional
$ make world.opt
$ sudo make install

coq 8.4 pl4 をインストール

$ ./configure -local -opt
$ make world

make install しないで使うと想定.Ltac を書きたいときにはこうしろ,
と書いてある….
以下を .bashrc などに追加

export COQDIR=/directory/where/coq/was/built
export PATH=${PATH}:${COQDIR}/bin

SSReflect 1.5 をインストール

$ export COQBIN=${COQDIR}/bin (coqtop等のバイナリがあるディレクトリ)
$ make
$ make install

この make install は,一般ユーザでよい.
${COQDIR}/user-contrib/Ssreflect に入る.

Mathcomp 1.5 をインストール

$ make
$ make install

この make install は,一般ユーザでよい.
${COQDIR}/user-contrib/MathComp に入る.

ProofGeneral 4.2 をインストール.
Emacs 24.3 で使うには,
generic/pg-response.elに以下の修正が必要.

--- before/pg-response.el    2012-09-25 18:44:18.000000000 +0900
+++ after/pg-response.el     2013-03-14 22:57:29.000000000 +0900
@@ -101,9 +101,9 @@
              pg-response-special-display-regexp
              proof-multiframe-parameters)))
     (if proof-multiple-frames-enable
-    (add-to-list 'special-display-regexps spdres)
-      (setq special-display-regexps
-        (delete spdres special-display-regexps))))
+    (add-to-list 'display-buffer-alist spdres)
+      (setq display-buffer-alist
+        (delete spdres display-buffer-alist))))
   (proof-layout-windows))

 (defun proof-three-window-enable ()

この変更を加えた上で,以下のようにビルド

$ make clean
$ make compile
ルートになって
# make install

.emacsの編集

(setq my-src-top "...")
(load-file (concat my-src-top "/ssreflect-1.5/pg-ssr.el"))
(load-file "/usr/share/emacs/site-lisp/ProofGeneral/generic/proof-site.el")
(setq coq-prog-args
      (cons "-R"
      (cons (concat my-src-top "/ssreflect-1.5/theories")
      (cons "Ssreflect"
      (cons "-R"
      (cons (concat my-src-top "/mathcomp-1.5/theories")
      (cons "MathComp"
      (cons "-emacs"
      nil))))))))
(setq proof-auto-raise-buffers nil)
(setq proof-three-window-enable t)

[Coq] well-founded relation

前回のエントリと同じ気持ちを,
list を使って書いてみる.

Inductive tree : Type :=
  | node : nat -> list tree -> tree.

今回も,Coqが生成する tree_ind は役に立たない.

forall P : tree -> Prop,
       (forall (n : nat) (l : list tree), P (node n l)) ->
       forall t : tree, P t

そこで,「t1はt2の子ノード」という有基底的関係 child(t1, t2)
に関する帰納法を使ってみることにする.

Inductive child (t: tree) : tree -> Prop :=
  | child_w: forall n l, In t l -> child t (node n l).

使うためには,child が well_founded であることを証明する
必要がある.現状,この証明が汚い (下のソースを参照).

Lemma child_well_founded: well_founded child.

ここで,well_founded (など) は,以下のように定義されている.

Inductive Acc (A : Type) (R : A -> A -> Prop) (x : A) : Prop :=
    Acc_intro : (forall y : A, R y x -> Acc R y) -> Acc R x

well_founded = 
  fun (A : Type) (R : A -> A -> Prop) => forall a : A, Acc R a
     : forall A : Type, (A -> A -> Prop) -> Prop

これができると,次のように帰納法を使うことができる.

induction t using (well_founded_ind child_well_founded).

もっと簡単な書き方があるのかもしれないが,一応これで
動いている.
ちなみに,well_founded_ind child_well_founded は,以下の
型を持つ:

forall P : tree -> Prop,
       (forall x : tree, (forall y : tree, child y x -> P y) -> P x) ->
       forall a : tree, P a

ソース全体は以下の通り

Require Import List.
Require Import Arith.

Inductive tree : Type :=
  | node : nat -> list tree -> tree.

Definition multi_max (l:list nat) : nat := 
  fold_left (fun x y => if (le_lt_dec x y) then y else x) l 0.

Definition total (l:list nat) : nat := fold_left (fun x y => x + y) l 0.

Fixpoint height (t: tree) : nat :=
  match t with
  | node a l => (multi_max (map height l)) + 1
  end.

Fixpoint numnodes (t: tree) : nat :=
  match t with
  | node a l => (total (map numnodes l)) + 1
  end.

(* "child t1 t2" means t1 is a child of t2 *)
Inductive child (t: tree) : tree -> Prop :=
  | child_w: forall n l, In t l -> child t (node n l).

Search ((_ < S _) -> _ ) .
Lemma lt_n_Sm_lt_or_eq: forall n m : nat, n < S m -> n < m \/ n = m.
Proof. admit. Qed.

Lemma in_le_total: forall a l, In a l -> a <= total l.
Proof.  admit.  Qed.

Lemma plus_S_lt: forall x y z, x + S y = z -> x < z.
Proof.  admit.  Qed.

Lemma child_acc_n : forall n t, numnodes t < n -> Acc child t.
Proof.
  induction n; intros.
    inversion H.
  apply lt_n_Sm_lt_or_eq in H.
  destruct H.  
    apply IHn; auto.
  destruct t.
  apply Acc_intro; intros.
  apply IHn.
  simpl in H.
  assert (In (numnodes y) (map numnodes l)).
    apply in_map.
    inversion H0; auto.
  apply in_le_total in H1.
  apply plus_S_lt in H.
  eapply le_lt_trans; [apply H1|].
  trivial.
Qed.

Lemma child_well_founded: well_founded child.
Proof.
  unfold well_founded.
  intros.
  apply child_acc_n with (n:=S (numnodes a)).
  apply le_lt_n_Sm.
  apply le_refl.
Qed.


Lemma plus_monotone: 
    forall x1 y1 x2 y2, x1 <= x2 -> y1 <= y2 -> x1 + y1 <= x2 + y2.
Proof.  admit.  Qed.

Lemma plus_left_monotone: forall x y z, x <= y -> x + z <= y + z.
Proof.  admit.  Qed.

Lemma multi_max_cons x l: multi_max (x::l) = max x (multi_max l).
Proof.  admit.  Qed.

Lemma total_cons x l: total (x::l) = x + total l.
Proof.  admit.  Qed.

Lemma max_le_plus: forall x y, max x y <= x + y.
Proof.  admit.  Qed.

Lemma lem1: forall t, height t <= numnodes t.
Proof.
  induction t using (well_founded_ind child_well_founded).
  destruct t; simpl; auto.
  apply plus_left_monotone.
  generalize l H; clear l H.
  induction l; intros; simpl; auto.
  rewrite multi_max_cons, total_cons.
  eapply le_trans.
    apply max_le_plus.
  apply plus_monotone.
    apply H.
    apply child_w.
    simpl; auto.
  apply IHl.
  intros; apply H.
  apply child_w.
  right.
  inversion H0; auto.
Qed.

[Coq] 同時機能的定義

参考にしたもの

同時機能的定義

例として,可変個の子供を持つ木を考える.Inductive を with でつなげる.

Inductive tree : Set :=
| node : nat -> forest -> tree
with forest : Set :=
| leaf : forest
| cons : tree -> forest -> forest.

帰納的に関数を定義する場合も,Fixpoint を with でつなげる.たとえばノードの数を数える場合

Fixpoint numnodes (t:tree) : nat :=
  match t with
  | node n f1 => 1 + numnodes_f f1
  end
with numnodes_f (f:forest) : nat :=
  match f with
  | leaf => 0
  | cons t1 f1 => numnodes t1 + numnodes_f f1
  end.

さて,帰納法による証明だが,とりあえず2つくらい方法がある.
最初は,この定義による帰納法.

一般に,induction x. とすると,xの型をTとして,T_ind が用いられる.
(これは Prop の場合.goalの型によって T_rec (Set) だったり T_rect (Type) だったり
するのであろう.)
ところが,上の例だと,tree_ind とか forest_ind とか作られているのだけれど,あまり
役に立たない.たとえば tree_ind の型は,つぎのようなもの.

forall P : tree -> Prop,
       (forall (n : nat) (f : forest), P (node n f)) -> forall t : tree, P t

ちゃんと同時帰納法に対応するものがほしい.
これは,Scheme という命令で生成することができる.

Scheme tree_forest_ind := Induction for tree Sort Prop
with   forest_tree_ind := Induction for forest Sort Prop.

tree_forest_ind は,以下の型を持つ

forall (P : tree -> Prop) (P0 : forest -> Prop),
       (forall (n : nat) (f : forest), P0 f -> P (node n f)) ->
       P0 leaf ->
       (forall t : tree, P t -> forall f1 : forest, P0 f1 -> P0 (cons t f1)) ->
       forall t : tree, P t

これなら使える.使う時には induction に using でこれを指定する.

induction t using tree_forest_ind.

実際には,この例だと P0 がなにになるか Coq には不明なので,einduction を使うことになる.

もうひとつの方法は,証明すべき定理の方も両者同時に進行させること.
たとえば,同様に「高さ」も定義して,高さよりもノードの数の方が等しいか大きいという
ことを証明したいとしよう.定理を with でつないで次のように書く.

Lemma lem1t: forall t, height   t <= numnodes t
with  lem1f: forall f, height_f f <= numnodes_f f.

これで,induction t とすると,次のようになる.

2 subgoals, subgoal 1 (ID 77)
  
  lem1t : forall t : tree, height t <= numnodes t
  lem1f : forall f : forest, height_f f <= numnodes_f f
  n : nat
  f : forest
  ============================
   height (node n f) <= numnodes (node n f)

subgoal 2 (ID 72) is:
 forall f : forest, height_f f <= numnodes_f f

当然というか何というか,ここで apply lem1t; apply lem1f. Qed. ではいけない.
さいごの Qed で怒られる.
ちゃんと一つ前に進んで,lem1t や lem1f を帰納法の仮定として適用して良いところで
適用すれば,証明が完了する.

全体のソースコードを示す.

Require Import Arith.

Inductive tree : Set :=
| node : nat -> forest -> tree
with forest : Set :=
| leaf : forest
| cons : tree -> forest -> forest.

Check tree_ind.


Fixpoint numnodes (t:tree) : nat :=
  match t with
  | node n f1 => 1 + numnodes_f f1
  end
with numnodes_f (f:forest) : nat :=
  match f with
  | leaf => 0
  | cons t1 f1 => numnodes t1 + numnodes_f f1
  end.

Fixpoint height (t:tree) : nat :=
  match t with
  | node n f1 => 1 + height_f f1
  end
with height_f (f:forest) : nat :=
  match f with
  | leaf => 0
  | cons t1 f1 => max (height t1) (height_f f1)
  end.

(* le_S_n: forall n m : nat, S n <= S m -> n <= m *)
(* le_n_S: forall n m : nat, n <= m -> S n <= S m *)
(* le_trans: forall n m p : nat, n <= m -> m <= p -> n <= p *)

Lemma max_le_plus: forall x y, max x y <= x + y.
Proof.
  admit.
Qed.

Lemma monotone_plus: 
    forall x1 y1 x2 y2, x1 <= x2 -> y1 <= y2 -> x1 + y1 <= x2 + y2.
Proof.
  admit.
Qed.

(* From here, we can proceed (1) as follows *)

Scheme tree_forest_ind := Induction for tree Sort Prop
with   forest_tree_ind := Induction for forest Sort Prop.
(*  This command generates the following induction scheme.
tree_forest_ind
     : forall (P : tree -> Prop) (P0 : forest -> Prop),
       (forall (n : nat) (f : forest), P0 f -> P (node n f)) ->
       P0 leaf ->
       (forall t : tree, P t -> forall f1 : forest, P0 f1 -> P0 (cons t f1)) ->
       forall t : tree, P t
*)

Lemma lem0: forall t, height t <= numnodes t.
Proof.
  einduction t using tree_forest_ind.
      simpl.
      apply le_n_S.
      apply IHt0.
    simpl; auto.
  simpl in *.
  eapply le_trans.
    apply max_le_plus.
  apply monotone_plus; auto.
Qed.



(* Or, alternatively, the following method (2) is also possible. *)

Lemma lem1t: forall t, height   t <= numnodes t
with  lem1f: forall f, height_f f <= numnodes_f f.
Proof.
    induction t.
(* The following does not work, of course :-) 
    apply lem1t.
    apply lem1f.
    Qed.
*)
    simpl.
    apply le_n_S.
    apply lem1f.
  induction f; simpl; auto.
  eapply le_trans.
    apply max_le_plus.      
  apply monotone_plus.  
    apply lem1t.
  apply IHf.
Qed.



keyword: simultaneous induction, simultaneous recursion, tree, variable number of children,

Google groups による ML のアドレス選択

どうせすぐまた変わってしまうのだろうけど,現時点でのGoogle Groupsの仕様(?).
ここで作っているMLで,どのアドレスにメールが送信されるかの指定は,
該当グループを選び,右上の「個人設定」から「メンバーシップとメールの設定」を選び,
「(…アドレス…) を次の設定でこのグループに指定します」という
部分の,アドレスのところをマウスクリックすると,選択できる.

ユーザプロファイルフォルダのドライブ

ユーザプロファイルフォルダ,要するに C:\Users についての騒動の顛末.

家のマシン (Windows 7) は,ドライブCが(SSDであるため)容量があまり十分でなく,
利用者たちがデスクトップにたくさんファイルを置くと立ちゆかなくなるので,
ユーザプロファイルフォルダを E:\Users に変えている.
ドライブEにはそれなりの容量がある.

変えると言っても Microsoft がそういうのをサポートしているわけではないので,
このページ あたりを参考に適当にやっていた.
だいぶ前のことなのでどのようにしたか詳細が思い出せない.
メモもとっていないというひどい話.

今日突然,ログインができなくなった.
「User Profile Service サービスによるログオンの処理に失敗しました。
ユーザー プロファイルを読み込めません。」
と言われる.
Googleを引くといろいろ出てきて,レジストリを直すらしい,ということはわかって,その通りやったのだけれど直らない.
どうも,ユーザプロファイルフォルダがなぜか C:\Users に戻ってしまったのが原因らしいと最後にはわかった.
たしか,C:\Users から E:\Users へのジャンクションを作っておいたと思うのだけれど,それもなくなって,C:\Users がフォルダになっている.
確実ではないけれど,どうも .NET version 4 を入れた周辺のなにかが悪さをしたのではないかと思われる….

で,結局今回は次のようにしてみた:

  • ジャンクションは作る. (mklink /J C:\Users E:\Users)
  • レジストリ HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList を,以下のようにする.
    • Default, Public, ProfilesDirectory に,明示的にドライブEを指定.
    • 各ユーザに関する (長い) キーの下にある ProfileImagePath にも,明示的にドライブEを指定.
    • なお,ログインに失敗したときに,キーの名前に .bak がついてしまうなどの問題が起こったので,Microsoftのサポートページの指示に従って対処.

とりあえず直ったようだ.

キーワード: user profile folder, user profile directory, drive, desktop, junction

Windows への spin のインストール

たまたま新しいマシンをセットアップする機会があったので,spinをインストールしてみた.

cygwin をインストール.特別に指定したパッケージは gcc-core のみ.

active tcl をインストール.インストーラの実行の際は「管理者として実行」

spinroot から,pc_spin*.zip と ispin.tcl をダウンロードして展開.

PATHに,cygwinインストールディレクトリ/bin を追加

以上

[Coq] exists と subset

exists x:A, P x と { x:A | P x } はほとんど同じように見える.実際,A と P x の型の項のペアだし.

Propを相手にしているときには,ほとんど変わらないと思うのだが,Setを相手にすると変わってくるようだ.

たとえば,x:option A であって,x = Some t となる t:A があるとわかっているときに,x から t を
取り出したい,という状況を考える.subset型だと簡単で,

Definition opPeel  {A:Type}(x:option A)(H:{ t:A | x = Some t }): A.
  destruct H as [t H].
  assumption.
Defined.

ですむ.同じことを exists でやろうとすると,

Definition opPeel  {A:Type}(x:option A)(H:exists t:A, x = Some t): A.
  destruct H as [t H].

ここで,
Error: Case analysis on sort Type is not allowed for inductive definition ex.
と怒られる.
まあ,存在する,とだけ言っているところから具体的な証拠を取り出そうとするのだから,それは
やはりダメということなのだろう.定義しようとするとこんな感じになる.

Definition optionPeel {A:Type}(x:option A)(H:exists t, x = Some t): A.
  refine (match x as v return (x = v) -> A with
            | None => fun H1 => _
            | Some t => fun _ => t
          end eq_refl).
  exfalso; destruct H as [t H2]; rewrite H2 in H1; discriminate H1.
Defined.

これが最善かどうかはわからないけれど.