Lean by Example
プログラミング言語であるとともに定理証明支援系でもある Lean 言語と、その主要なライブラリの使い方を豊富なコード例とともに解説した資料です。
Note
誤りのご指摘、ご提案などは GitHub リポジトリからお願いします。
lean-ja の Discord サーバがあります。質問や相談などはこちらにどうぞ。招待コードは
p32ZfnVawhです。https://discord.com/invite/exampleのexampleの部分を招待コードに置き換えてアクセスしてください。（スパム対策でURLを直接載せていません）
支援について ❤️
本書は lean-ja の管理者である北窓が執筆・開発しています。 もしも本書を気に入っていただけたのであれば、ご支援をいただけると励みになります。
- 金銭的な支援は Pixiv Fanbox から受け付けております。
- GitHub からスター🌟をつけていただくだけでも支援になります。
本書の特色 😎
1. 内容が正確
Lean は開発が活発に続いているソフトウェアであり、毎月のように新しいリリースが行われています。その際破壊的な変更が行われることは少なくありません。変更によって古くなってしまった記述を自動的に見つける方法がなければ、内容の信頼性が損なわれます。
本書では、この問題に対して次のように対処しています。
- 記述内容を可能な限りコードとして表現することにより、「ビルドが通れば記述内容は正しい」という状態を維持する。
- 内容を更新するごとにビルドが自動的に走るようにする。
これにより本書のほぼすべての記述はバージョン leanprover/lean4:v4.34.0-rc2 で実際に間違いがないということを確認済みです。
間違った記述を見つけられた際はお手数ですが issue でご報告をお願いします。
2. 情報が新しい
本書は、Lean とそのライブラリのバージョンを自動で更新するワークフロー lean-update を利用して、定期的にバージョンを最新のものに更新しています。Lean の最新情報をすべて掲載することはかないませんが、最新の情報を提供できるよう努めています。
3. コードをすぐに試せる
本書のすべての Lean コードブロックは、マウスを重ねると Lean Playground へジャンプするボタン が現れるようになっています。
またコードブロックの中には、import 文が足りないなどの理由でそのままでは実行できないものがありますが、そうした場合は画面右上の実行ボタン をクリックしていただければ、ファイル全体を実行することができます。
このようなことが可能なのは、mdgen を使って、Lean コードから markdown ファイルを生成することにより本書が制作されているからです。
4. わかりやすい
「わかりやすさ」にも種類があります。世の中には「難しい部分を隠蔽する」ことをもって「わかりやすい」としている書籍も存在しますが、本書はその立場をとりません。
では何をもってわかりやすいと考えているかというと、まず本書では「ほぼすべての記述がコード例によって検証されている」ので、言い換えれば「どの記述にもコード例が付随している」ということになります。これにより、「そもそも何を言っているのかわからない記述」が本書にはほとんど存在しないはずです。
また、「ほぼすべての記述がコード例によって検証されている」ということは、「コード例で検証できないことには言及できない」ことになります。これにより、本書の記述は「それが何であるのか」の詳しい説明が少なく、「それを使って何ができるのか」の説明が多くなっています。これにより、結果として説明がより具体的かつ実践的になり、特に初学者にとってより理解しやすくなるという効果が生じているはずです。
スポンサー
このプロジェクトは Proxima Technology 様よりご支援を頂いています。
Proxima Technology（プロキシマテクノロジー）は数学の社会実装を目指し、その⼀環としてモデル予測制御の民主化を掲げているAIスタートアップ企業です。数理科学の力で社会を変えることを企業の使命としています。
リンク集
🌐 コミュニティ
- Lean Theorem Prover Lean の公式サイト。
- Lean Community Lean のユーザコミュニティ。
- Lean Prover Zulip Chat Lean について何でも質問できる公式のフォーラム。
- Lean Forward 数学への Lean の応用を推進するコミュニティ。
🧰 ライブラリやツール
- Mathlib4 Lean で大学の学部程度の数学を実装したライブラリ。
- Lean4 VSCode 拡張機能 Lean4 のための VSCode 拡張機能。
- Lean4 Web ブラウザ上で Lean が実行できるプレイグラウンド。
- Reservoir Lean 公式のパッケージレジストリ。
🔍 ライブラリ検索ツール
- Loogle Mathlib などからの検索ツール。型の情報や定数名から検索ができます。vscode-lean4 から実行することもできます。
- Lean Search 自然言語で Mathlib から定理や定義が検索できるサイト。これに関連して「A Semantic Search Engine for Mathlib4」という論文があります。日本語対応しています。
- Lean Explore 自然言語で Mathlib などから定理や定義が検索できるサイト。日本語対応していないことに注意。これに関連して 「LeanExplore: A search engine for Lean 4 declarations」 という論文があります。
- Moogle 自然言語でクエリできるライブラリ検索エンジン。
📖 公式ドキュメント
- Lean Language Reference Lean 言語の公式リファレンス。Verso という Lean 製のツールで執筆されています。
- Theorem Proving in Lean 4 Lean 4の定理証明支援系としての側面に焦点を当てた公式チュートリアルテキストです。理論的な記述が多めです。
- Functional Programming in Lean 関数型プログラミング言語としての Lean の入門書。
- Mathematics in Lean Lean で数学を形式化する方法を学ぶ教科書。初等整数論をはじめ、位相空間論や測度論も扱われるなど内容が充実しており、多くの演習問題があります。
📚 コミュニティによる教材・資料
- Natural Number Game 4 Lean を使い、ペアノの公理から始めて自然数の基本的な性質を証明する初心者向けブラウザゲーム。
- Metaprogramming in Lean 4 Lean で独自のコマンドやタクティクを作る方法を解説した本。
- The Mechanics of Proof 大学の初級レベルの授業のための Lean を使った教科書。Mathlib にはない独自のタクティクが使用されていることに注意が必要です。
- The Hitchhiker’s Guide to Logical Verification 「 Formal Proof and Verification」という授業の参考書。テーマは形式検証であり、形式数学の形式化だけでなくプログラミング意味論にも触れています。
- Logic and Mechanized Reasoning Lean を使った論理学および自動証明の教科書。ソースコードもGitHubリポジトリで公開されています。
- Scientific Computing in Lean Lean で科学計算を行うライブラリ SciLean の著者による、科学計算についての解説書。
- From Zero to QED 型理論と関数型プログラミングを背景に、Lean を用いた定理証明について基礎から段階的に学ぶ入門書。
- Type Checking in Lean4 Lean4 のカーネル（型検査機構）について深く理解するための資料です。
- Lean 4 (Meta)programming Cookbook Lean4 のメタプログラミング / プログラミング用のレシピ集。「こういうことをしたいときにどう書くか」がまとめられています。
📚 日本語の書籍
- ゼロから始めるLean言語入門 Leanで自然数に関する理論を構築することを通して、Leanの基本的な使い方を学ぶ入門書。示した結果を再利用可能にする必要性を強調しているのが特徴。
🗾 日本語の参考資料
- Theorem Proving in Lean 4 日本語訳 Lean で数学の証明を行う方法を解説した公式チュートリアルの、有志による日本語訳です。
- 数学系のためのLean勉強会 Lean で数学をどのように実装するのか、実際に実装する過程を追うことで学べる教材です。
- Leanのインストール方法・elanとLakeの使い方 Leanのインストール方法・elanとLakeの使い方をまとめた有志による資料。
Lean のインストール方法
Lean および関連ツールのインストール方法を説明します。VSCode の Lean 4 拡張機能が自動的にインストールしてくれるのですが、ここではコマンドラインから手動で入れる場合の手順を説明します。
OS 共通の事項
-
インストールすべきものは、
elanとleanとlakeの３つです。elanは Lean のバージョン管理ツールで、leanは Lean 本体、lakeは Lean のパッケージ管理ツールです。elanをインストールすれば、elan経由でleanとlakeもインストールできます。 -
Lean のインストールには
gitとcurlが必要です。gitはテキストのバージョン管理をするためのツールで、curlはデータを外部から取得したり、外部に送信したりするためのツールです。
Windows の場合
PowerShell 7 のインストール
まずは使用しているシェルを確認します。PowerShell 7 を使うことを推奨します。他のシェルでも Lean のインストール自体は可能ですが、Windows では PowerShell 7 を使うことが一般的であるためこのような手順を案内しています。
Windows PowerShell と PowerShell 7 以降は混同されがちですが、下記を実行して Major が 7 以上であれば PowerShell 7 です。
$PSVersionTable.PSVersion
PowerShell 7 をインストールするには、次を実行します。
winget install --id Microsoft.PowerShell --source winget
文字化けの修正
そのままだと PowerShell 上で Unicode 文字が文字化けすることがあるので、以下を $Profile の末尾に追記しておきます。なお「履歴ベースの予測の有効化」は Lean とは関係がありませんが、便利なので追加すると良いでしょう。
# 履歴ベースの予測を有効化
Set-PSReadLineOption -PredictionSource History
# Lean の文字化けを修正する
$utf8 = New-Object System.Text.UTF8Encoding
[console]::InputEncoding = $utf8
[console]::OutputEncoding = $utf8
$OutputEncoding = $utf8
git と curl のインストール
以下、全てのコマンドは PowerShell 7 で実行することを前提とすることにします。
git と curl がインストール済みであるか、次のコマンドで確認します。
git --version
curl --version
おそらく初期状態の Windows では git はインストールされていないと思います。以下のコマンドでインストールします。
winget install --id Git.Git -e --source winget
curl コマンドはおそらく初めから入っていると思いますが、もし入っていない場合は次のコマンドでインストールします。
winget install --id cURL.cURL --source winget
elan のインストール
次に、elan をインストールします。次のコマンドでインストールできます。
curl -O --location https://elan.lean-lang.org/elan-init.ps1
pwsh `
-ExecutionPolicy Bypass `
-f elan-init.ps1 `
-NoPrompt:$True `
-DefaultToolchain:stable
Remove-Item elan-init.ps1
実行後、elan コマンドが使えるようになったか確認します。
elan --version
Lean と lake のインストール
次に、Lean（と同梱されている lake）をインストールします。stable を指定することで、最新の安定版をインストールできます。
elan toolchain install stable
終わったら、Lean と lake のバージョンを確認します。
lean --version
lake --version
Linux の場合
シェルは bash を使用することを想定して手順を書きます。
git と curl のインストール
まず、git と curl がインストール済みであるか確認します。
git --version
curl --version
インストールされていなければインストールします。
sudo apt update
sudo apt install -y git curl
elan のインストール
次に elan をインストールします。
curl -O --location https://elan.lean-lang.org/elan-init.sh
sh elan-init.sh -y --default-toolchain stable
rm elan-init.sh
終わったら elan コマンドが使えるようになったか確認します。
elan --version
Lean と lake のインストール
次に、Lean（と同梱されている lake）をインストールします。stable を指定することで、最新の安定版をインストールできます。
elan toolchain install stable
終わったら、Lean と lake のバージョンを確認します。
lean --version
lake --version
MacOS の場合
シェルとして zsh を利用することを想定して手順を書きます。
git と curl のインストール
まず git と curl が使えるか確認します。
git --version
curl --version
MacOS の場合、curl は最初から入っていると思います。git が入っていない場合でも、git --version の実行時にインストールするか聞かれるはずです。
elan のインストール
次に elan をインストールします。
curl -O --location https://elan.lean-lang.org/elan-init.sh
sh elan-init.sh -y --default-toolchain stable
rm elan-init.sh
終わったら elan コマンドが使えるようになったか確認します。
elan --version
Lean と lake のインストール
次に、Lean（と同梱されている lake）をインストールします。stable を指定することで、最新の安定版をインストールできます。
elan toolchain install stable
終わったら、Lean と lake のバージョンを確認します。
lean --version
lake --version
Mathlib4 Help
Mathlib4 Help はMathlib の #help コマンドの出力をまとめたページです。
ランダムぺージ
対話的コマンド
トップレベルコマンドのうち、# から始まるものを本書では便宜的に「対話的コマンド」と呼んでいます。これは、そうしたコマンドの多くが「式を評価した値を調べる」「式の型を調べる」など Lean から情報を得るために使用されるからです。
Warning
対話的コマンド(diagnostic command)という用語は一般的なものではありません。Lean コミュニティで通じない可能性もあります。著者は diagnostic command という用語を The Hitchhiker’s Guide to Logical Verification から拝借しましたが、同じものが hash command と呼ばれているのを聞いたこともあります。決まった呼び方がないという印象です。
#check_failure
#check_failure は、エラーが起こった時に成功し、エラーが起こらなければ失敗するコマンドです。エラーが起こるコードを意図的に構成したいときに便利です。
-- 自然数と文字列を足すことはできない
#check_failure 1 + "hello"
-- `1 = 2` を `rfl` で証明することはできない
#check_failure (by rfl : 1 = 2)
-- `1 + 4 = 5` は `contradiction` では示せない
#check_failure (by contradiction : 1 + 4 = 5)
#check
#check コマンドは、項(term) の型を表示します。Lean ではすべての項に型があるので、どんな項にも使えます。#check term という構文で、term の型を表示することができます。
-- 文字
/- info: 'a' : Char -/
#check 'a'
-- 文字列
/- info: "Hello" : String -/
#check "Hello"
-- 自然数
/- info: 1 : Nat -/
#check 1
-- 浮動小数点数
/- info: 1.0 : Float -/
#check 1.0
-- 整数
/- info: -2 : Int -/
#check -2
-- `1` はそのままだと自然数扱いになるが、整数にキャストできる
/- info: 1 : Int -/
#check (1 : Int)
-- 自然数のリスト
/- info: [1, 2, 3] : List Nat -/
#check [1, 2, 3]
-- 自然数の配列
/- info: #[1, 2, 3] : Array Nat -/
#check #[1, 2, 3]
-- 関数
/- info: fun x => x + 42 : Nat → Nat -/
#check fun x => x + 42
-- 真偽値
/- info: Bool.true : Bool -/
#check true
-- 命題
/- info: True : Prop -/
#check True
逆に term の型が T であることを確かめるには example コマンドを使用して example : T := term とします。
example : Nat := 42
example : Int := - 13
なお「すべての」項に型があるので、特に型も型を持ちます。多くの組み込み型の型は Type になっています。
-- 文字列型の型は Type
/- info: String : Type -/
#check String
-- 自然数型の型は Type
/- info: Nat : Type -/
#check Nat
#eval
#eval コマンドは、式の値をその場で評価します。
import Lean.Elab.Command -- `#eval` コマンドのフルパワーを引き出す
/- info: 2 -/
#eval 1 + 1
-- 階乗関数
def fac : Nat → Nat
| 0 => 1
| n + 1 => (n + 1) * fac n
/- info: 120 -/
#eval fac 5
def main : IO Unit :=
IO.println "Hello, world!"
/- info: Hello, world! -/
#eval main
#eval による出力結果は編集することができます。代表的な方法は、Repr クラスのインスタンスを実装することです。
/-- ユーザが持つ権限 -/
inductive Role where
| admin
| write
| read
/- info: Role.admin -/
#eval Role.admin
-- `#eval` の結果を強制的に上書きする
instance : Repr Role where
reprPrec := fun _role _ => "ほげほげ！"
/- info: ほげほげ！ -/
#eval Role.admin
よくあるエラー
計算不能
not computationally relevant というエラーになることがあります。
/- error: Cannot evaluate, types are not computationally relevant -/
#eval Nat
/- error: Cannot evaluate, proofs are not computationally relevant -/
#eval (rfl : 1 + 1 = 2)
これは、Lean の型や証明項は計算可能な解釈を持たないためです。
表示方法がわからない
一般に Repr や ToString および ToExpr のインスタンスでないような型の項は、表示方法がわからないので #eval に渡すことができません。
/-
error: Could not synthesize a `ToExpr`, `Repr`, or `ToString` instance for type
Nat → Nat
-/
#eval (fun x => x + 1)
Repr インスタンスがあれば関数であっても #eval に渡すことができます。
-- 最初はエラーになってしまう
/-
error: Could not synthesize a `ToExpr`, `Repr`, or `ToString` instance for type
Unit → Nat
-/
#eval (fun _ => 1 : Unit → Nat)
instance {α : Type} [Repr α] : ToString (Unit → α) where
toString x := s!"fun (_ : Unit) => {reprStr (x ())}"
-- Repr インスタンスを定義する
instance {α : Type} [Repr α] : Repr (Unit → α) where
reprPrec x _ := toString x
-- #eval に渡せるようになった！
/- info: fun (_ : Unit) => 1 -/
#eval (fun _ => 1 : Unit → Nat)
補足: 式の評価結果を代入する
#eval コマンドは式を評価してその結果をユーザに表示しますが、「式の評価結果を別のコードに代入する」には eval% を使います。
import Mathlib.Tactic.Eval
def bar := 1 + 1
def foo₁ := eval% bar
def foo₂ := bar
/-
info: def foo₁ : Nat :=
2
-/
#print foo₁
/-
info: def foo₂ : Nat :=
bar
-/
#print foo₂
#find
#find はライブラリ検索を行うコマンドです。
Lean 実行環境で実行せずとも、Loogle というウェブサイトがあり、ここで #find を実行することができます。そして #loogle コマンドで Loogle をエディタから利用することができるので、使用法の解説はそちらに譲ります。
また、Mathlib の検索では Moogle というサイトもあります。こちらは自然言語検索が可能です。
#grind_lint
#grind_lint コマンドは、grind タクティクのために登録した定理がインスタンスの暴発を引き起こさないかどうか検査するためのコマンドです。
inspect サブコマンド
#grind_lint inspect thm は、指定した定理を個別に詳しく調べます。
def wrap (x : Nat) : Nat := 0
theorem wrap_branch (x : Nat)
: wrap x = wrap (2 * x) ∧ wrap x = wrap (2 * x + 1) := by
simp [wrap]
grind_pattern wrap_branch => wrap x
-- wrap_branch を展開すると wrap が指数関数的に増えていくので、
-- 膨大なインスタンスが生成される。
/-
info: instantiating `wrap_branch` triggers more than 100 additional `grind` theorem instantiations
---
info: wrap_branch
[thm] instances
[thm] wrap_branch ↦ 100
---
info: Try this to display the actual theorem instances:
[apply] set_option trace.grind.ematch.instance true in
#grind_lint inspect wrap_branch
-/
#grind_lint inspect wrap_branch
生成されたインスタンス数が閾値を超えた場合にだけ報告をします。
閾値の値は、(min := n) という構文で指定できるので、全て報告してほしい場合は min := 0 とします。
def Nat.factorial (n : Nat) : Nat :=
match n with
| 0 => 1
| n + 1 => (n + 1) * Nat.factorial n
theorem Nat.factorial_succ (n : Nat) :
Nat.factorial (n + 1) = (n + 1) * Nat.factorial n := by
simp [Nat.factorial]
grind_pattern Nat.factorial_succ => n.factorial
#grind_lint inspect (min := 0) Nat.factorial_succ
#guard_msgs
#guard_msgs コマンドは、あるコマンドの出力が与えられた文字列と一致するか検証します。
/-- info: 2 -/
#guard_msgs in #eval 2
/--
error: failed to synthesize instance of type class
HAdd ℕ String String
Hint: Type class instance resolution failures can be inspected with the `set_option trace.Meta.synthInstance true` command.
-/
#guard_msgs in #eval (2 + "hello" : String)
空白の違いを無視させるには
#guard_msgs コマンドは空白の数に敏感で、空白の長さによって通ったり通らなかったりします。しかし、whitespace という引数に lax を指定することにより、この空白に関する制限は緩めることができます。
variable (α : Type)
-- 通常の場合
/--
error: failed to synthesize instance of type class
Inv α
Hint: Type class instance resolution failures can be inspected with the `set_option trace.Meta.synthInstance true` command.
-/
#guard_msgs in #check (_ : α)⁻¹
-- スペースを入れてもエラーにならない
/--
error: failed to synthesize instance of type class
Inv α
Hint: Type class instance resolution failures can be inspected with the `set_option trace.Meta.synthInstance true` command.
-/
#guard_msgs (whitespace := lax) in #check (_ : α)⁻¹
舞台裏
#guard_msgs コマンドは「与えられたコマンドを実行してその出力メッセージを取り出す」ということを行いますが、これは elabCommandTopLevel 関数で実行することができます。これを利用すると、#guard_msgs コマンドの派生コマンドを自分で定義することができます。
ここでは例として、「ドキュメントコメントに書かれた内容が出力メッセージに含まれるかどうか判定するコマンド」を定義してみます。
import Batteries.Data.String.Matcher
import Lean.Elab.Command
open Lean Elab Command
/-- コマンドの実行結果のメッセージに特定の文字列が含まれるかどうか検証するコマンド -/
syntax (docComment)? "#contain_msg" "in" command : command
elab_rules : command
| `(command| #contain_msg in $_cmd:command) => do
logInfo "success: nothing is expected"
| `(command| $doc:docComment #contain_msg in $cmd:command) => do
-- ドキュメントコメントに書かれた文字列を取得する
let expected := String.trimAscii (← getDocStringText doc) |>.copy
if expected.isEmpty then
logInfo "success: nothing is expected"
return
-- 与えられたコマンドを実行する
withReader ({ · with snap? := none }) do
elabCommandTopLevel cmd
-- コマンドの実行結果のメッセージを取得する
let msgs := (← get).messages.toList
let msgStrs := (← msgs.mapM (·.data.toString))
|>.map (·.replace "\"" "")
-- コマンドの実行結果のメッセージに expected が含まれるか検証する
for msgStr in msgStrs do
unless String.contains msgStr expected do
logError "error: output string does not contain the expected string"
-- ドキュメントコメントがない場合は何もしない
#contain_msg in #eval "hello"
/- info: success: nothing is expected -/
/-- -/ #contain_msg in #eval "hello"
/- error: error: output string does not contain the expected string -/
/-- 21 -/ #contain_msg in #eval 23
#guard
#guard は与えられた Bool 値が true であることを確かめます。
-- 階乗関数
def fac : Nat → Nat
| 0 => 1
| n + 1 => (n + 1) * fac n
#guard fac 5 == 120
決定可能性
#guard に Bool ではなく Prop 型の項を与えた場合、エラーになることがあります。次の命題は証明があるので真ですが、 #guard は通りません。
example (α : Type) (l : List α) : [] ⊆ l := by simp
-- Prop 型を持つ
#check ((α : Type) → ∀ (l : List α), [] ⊆ l : Prop)
/-
error: Type mismatch
∀ (α : Type) (l : List α), [] ⊆ l
has type
Prop
but is expected to have type
Bool
---
error: cannot evaluate code because 'sorryAx' uses 'sorry' and/or contains errors
-/
#guard ((α : Type) → ∀ (l : List α), [] ⊆ l : Prop)
しかし、 1 + 1 = 2 等も #check で確かめてみると型は Prop です。にも関わらず #guard に渡してもエラーになりません。これは不思議に思えますが、理由は 1 + 1 = 2 が Decidable 型クラスのインスタンスであり、決定可能だからです。
-- 型は Prop
/- info: 1 + 1 = 2 : Prop -/
#check 1 + 1 = 2
#guard 1 + 1 = 2
-- 1 + 1 = 2 は決定可能
#synth Decidable (1 + 1 = 2)
Prop 型であっても、Decidable クラスのインスタンスであれば Bool に変換できます。それを自動で行っているので、Prop 型の項でも #guard に通せるというわけです。
-- 決定可能な Prop 型の項を Bool に変換する関数
#check (decide : (p : Prop) → [_h : Decidable p] → Bool)
-- Bool 型になっている
/- info: decide (1 + 1 = 2) : Bool -/
#check decide (1 + 1 = 2)
DIY: 差分の表示
#guard コマンドを使って A = B という式を評価して false だったとき、デフォルトでは A と B がそれぞれどんな値であるかは表示されません。単に「等しくない」というメッセージが出るだけです。
/-
error: Expression
decide (1 + 1 = 3)
did not evaluate to `true`
-/
#guard 1 + 1 = 3
この挙動は少し不便です。#guard に渡された等式が false だったときに左辺と右辺の値を表示するようなコマンドが欲しいですね。これは、以下のように自作することができます。1
import Lean
import Qq
open Lean Meta Elab Command Qq
private def failGenerically (e : Expr) : TermElabM Unit := do
throwError "Expression{indentExpr e}\ndid not evaluate to `true`"
private def fail (e : Expr) : TermElabM Unit := do
let_expr Decidable.decide p _ := e | failGenerically e
let_expr Eq _ lhs rhs := p | failGenerically e
let lhs_fmt_expr : Q(Format) ← mkAppM ``repr #[lhs]
let rhs_fmt_expr : Q(Format) ← mkAppM ``repr #[rhs]
let lhs_fmt ← unsafe evalExpr Format q(Format) lhs_fmt_expr
let rhs_fmt ← unsafe evalExpr Format q(Format) rhs_fmt_expr
throwError
"Expression{indentExpr e}\n\
did not evaluate to `true`\n\
---\n\
{lhs} = {lhs_fmt}\n\
{rhs} = {rhs_fmt}"
/-- 等式を評価して不成立だったときに、左辺と右辺の値を表示するような
`#guard` コマンドの派生コマンド -/
elab "#guard_diff" e:term : command => liftTermElabM do
let e ← Term.elabTermEnsuringType e q(Bool)
Term.synthesizeSyntheticMVarsNoPostponing
let e ← instantiateMVars e
let mvars ← getMVars e
if mvars.isEmpty then
let v ← unsafe evalExpr Bool q(Bool) e
unless v do fail e
else
_ ← Term.logUnassignedUsingErrorInfos mvars
/-
error: Expression
decide (3 * 4 = 2 + 2)
did not evaluate to `true`
---
3 * 4 = 12
2 + 2 = 4
-/
#guard_diff 3 * 4 = 2 + 2
-
こちらのコードは Zulip の #guard with diff というトピックで Marcus Rossel さんによって提案されたコードを参考にしています。 ↩
#help
#help は、ドキュメントを確認するためのコマンドです。以下のような機能があります。
#help tacticで全タクティクのリストが見られます。#help optionで全オプションのリストが見られます。オプションは、set_optionを実行することで切り替えることができます。#help attrで全属性(attribute)のリストが見られます。#help commandで全コマンドのリストが見られます。#help termですべての term syntax の一覧が見られます。
他にも機能がありますが、詳細はBatteriesのドキュメントをご覧ください。
Note
Mathlib4 Help で
#helpコマンドの出力結果を見ることができます。
import Batteries.Tactic.HelpCmd
-- 以下のコマンドで全 tactic のリストが見られます
#help tactic
-- 全 attribute のリストを見るには次のコマンドです
#help attr
-- 全コマンドのリストを見るには次のコマンドが使えます
#help command
#html
#html コマンドは、その名の通り html をインフォビューに表示させるコマンドです。ProofWidgets4 というライブラリで定義されています。
JSX によく似た構文を使うことができます。
import ProofWidgets
-- JSX ライクな構文が使えるようにする
open scoped ProofWidgets.Jsx
#html <p>"ここに HTML を書きます"</p>
-- いろんなHTMLタグを書くことができる
#html
<div>
<h3>"見出し"</h3>
<p>
<b>"強調されたテキスト"</b>
<i>"斜体のテキスト"</i>
</p>
<a href="https://lean-lang.org/">"リンク"</a>
</div>
-- 画像も表示できる
#html
<img src={"https://upload.wikimedia.org/wikipedia/commons/6/6a/Julia-set_N_z3-1.png"}
alt="julia set"/>
コンポーネント紹介
HTMLタグを使用できるだけでなく、様々なコンポーネントが定義されています。
MarkdownDisplay
<MarkdownDisplay /> コンポーネントを使用すると、Markdown や TeX を表示させることができます。
import ProofWidgets
open ProofWidgets Jsx
-- Markdown と TeX を表示する
#html <MarkdownDisplay contents={"
## Riemann zeta function
The Riemann zeta function is defined as
$$
\\zeta(s) = \\sum_{n=1}^∞ \\frac{1}{n^s}
$$
for $\\mathrm{Re} (s) > 0$.
"}/>
GraphDisplay
<GraphDisplay /> コンポーネントを使用すると、有向グラフを表示させることができます。
import ProofWidgets
open ProofWidgets Jsx ForceGraphDisplay
/-- `Edge` を作る -/
def mkEdge (st : String × String) : Edge := {source := st.1, target := st.2}
/-- 文字列として与えられたラベルから `Vertex` を作る -/
def mkVertex (id : String) : Vertex := {id := id}
-- 有向グラフを表示する
#html
<ForceGraphDisplay
vertices={#["a", "b", "c", "d", "e"].map mkVertex}
edges={#[("a", "b"), ("b", "c"), ("c", "d"), ("d", "e"), ("e", "a")].map mkEdge}
/>
LineChart
ProofWidgets4 には Recharts ライブラリ に対するサポートがあり、<LineChart /> コンポーネントを使用すると、関数のグラフを表示させることができます。
import ProofWidgets
open Lean ProofWidgets Recharts
open scoped Jsx
/-- 与えられた関数 `fn` の `[0, 1]` 区間上での値のグラフ -/
def Plot (fn : Float → Float) (steps := 100) : Html :=
-- `[0, 1)` 区間を `steps` 個に分割する
let grids := Array.range steps
|>.map (fun x => x.toFloat / steps.toFloat)
-- データを JSON に変換
let y := grids.map fn
let jsonData : Array Json := grids.zip y
|>.map (fun (x,y) => json% {x: $(toJson x), y: $(toJson y)});
<LineChart width={400} height={400} data={jsonData}>
<XAxis dataKey?="x" />
<YAxis dataKey?="y" />
<Line type={.monotone} dataKey="y" stroke="#8884d8" dot?={Bool.false} />
</LineChart>
#html Plot (fun x => (x - 0.3) ^ 2 + 0.1)
#html Plot (fun x => 0.2 + 0.5 * Float.sin (7 * x))
使用例
#html コマンドを使うと SVG 画像を infoview 内で直接表示させることができるという点、さらに ProofWidgets が SVG 画像の作成をある程度サポートしているという点を利用すると、「二分木を画像として infoview に表示させる」ということが可能です。1
import ProofWidgets
open ProofWidgets Svg
/-- デフォルトの表示領域(Frame) -/
private def defaultFrame : Frame := {
xmin := 0 -- 左下隅の x 座標
ymin := 0 -- 左下隅の y 座標
width := 1000 -- 横方向のピクセル数
height := 1000 -- 縦方向のピクセル数
xSize := 1000 -- width と同じ値なので、ピクセル数と座標の値は一致
}
/-- 描画に関する設定 -/
structure RenderConfig where
/-- ノードを描画するときの円の半径 -/
radius : Nat := 16
/-- ノードを描画するときの円の塗りつぶし色(RGB) -/
fillColor : (Float × Float × Float) := (0.74, 0.87, 1.0)
/-- ノードのラベルのフォントサイズ -/
fontsize : Nat := 14
/-- ノードのラベルの色(RGB) -/
textColor : (Float × Float × Float) := (0.0, 0.0, 0.0)
/-- エッジの色(RGB) -/
edgeColor : (Float × Float × Float) := (50.0, 50.0, 50.0)
/-- エッジの太さ(ピクセル) -/
edgeWidth : Nat := 2
/-- ノード間の水平・垂直間隔の基準値 -/
step := 30.0
/-- `RenderConfig`を読み取りできる計算文脈を表すモナド -/
abbrev RenderM := ReaderM RenderConfig
/-- 位置情報を付加したノードのデータ -/
structure NodePos where
/-- ノードのx座標(右に行くほど大きい) -/
x : Float
/-- ノードのy座標(下に行くほど大きい) -/
y : Float
/-- ラベル -/
label : String
/-- 上面と下面を反転して計測したy座標 -/
private def NodePos.y_inv (self : NodePos) (f : Frame) : Float :=
f.height.toFloat - self.y
/-- ノード（円とラベル）を作成する -/
private def createNodeElements (node : NodePos) (f : Frame) : RenderM (Array (Element f)) := do
let radius := (← read).radius
let fillColor := (← read).fillColor
let fontsize := (← read).fontsize
let textColor := (← read).textColor
let circle := circle (node.x, node.y_inv f) (.px radius)
|>.setFill fillColor
let adjust := fontsize.toFloat * 0.35 -- ラベルの位置調整用
let text := text (node.x - adjust, node.y_inv f - adjust) node.label (.px fontsize)
|>.setFill textColor
return #[circle, text]
/-- ノードの描画テスト用の関数 -/
private def createNodeHtml (node : NodePos) (f : Frame) : RenderM Html := do
let elements ← createNodeElements node f
let svg : Svg f := { elements := elements }
return svg.toHtml
#html ReaderT.run (r := {}) <|
createNodeHtml (f := defaultFrame) (node := { x := 150, y := 30, label := "A" })
/-- エッジ（ノードの親子関係）を作成する -/
private def createEdgeElement (parent child : NodePos) (f : Frame) : RenderM (Element f) := do
let edgeColor := (← read).edgeColor
let edgeWidth := (← read).edgeWidth
let element := line (parent.x, parent.y_inv f) (child.x, child.y_inv f)
|>.setStroke edgeColor (.px edgeWidth)
return element
/-- エッジの描画テスト用の関数 -/
private def createEdgeHtml (parent child : NodePos) (f : Frame) : RenderM Html := do
let element ← createEdgeElement parent child f
let svg : Svg f := { elements := #[element] }
return svg.toHtml
#html ReaderT.run (r := {}) <| createEdgeHtml
(parent := { x := 150, y := 30, label := "A" })
(child := { x := 100, y := 80, label := "B" })
(f := defaultFrame)
/-- (ラベル付きの)二分木 -/
inductive BinTree (α : Type) where
/-- 空の木 -/
| empty
/-- ノード -/
| node (val : α) (left right : BinTree α)
variable {α : Type} [ToString α]
/-- 二分木をノードの配列に変換する。 -/
def BinTree.toNodes (tree : BinTree α) : Array α :=
match tree with
| .empty => #[]
| .node val left right => #[val] ++ (left.toNodes ++ right.toNodes)
/-- 二分木のエッジを配列にする。(親, 子) のペアにして返すことに注意。 -/
def BinTree.toEdges {β : Type} (tree : BinTree β) : Array (β × β) :=
match tree with
| .empty => #[]
| .node a left right =>
let leftEdges :=
match left with
| .empty => #[]
| .node b _ _ => (toEdges left).push (a, b)
let rightEdges :=
match right with
| .empty => #[]
| .node c _ _ => (toEdges right).push (a, c)
leftEdges ++ rightEdges
/-- ３つ組データを構造体の項に変換する -/
def NodePos.ofPair (p : α × Nat × Nat) (step : Float) : NodePos :=
let (label, x, y) := p
{ x := x.toFloat * step, y := y.toFloat * step, label := toString label }
/-- ２分木の描画情報が与えられたときに、それを SVG 画像として描画する -/
def BinTree.render (tree : BinTree (α × (Nat × Nat))) (f : Frame := defaultFrame) (cfg : RenderConfig := {}) : Html :=
let html : RenderM Html := do
let step := (← read).step
let nodesArray := (← tree.toNodes
|>.map (NodePos.ofPair (step := step))
|>.mapM (fun node => createNodeElements node f))
|>.flatten
let edgesArray ← tree.toEdges
|>.map (fun (x1, x2) => (NodePos.ofPair x1 step, NodePos.ofPair x2 step))
|>.mapM (fun (parent, child) => createEdgeElement parent child f)
let svg : Svg f := { elements := edgesArray ++ nodesArray }
return svg.toHtml
ReaderT.run html cfg
/-- 二分木の葉 -/
def BinTree.leaf (val : α) : BinTree α :=
.node val .empty .empty
-- 二分木の描画テスト
-- レイアウト情報を手動で与えて描画している
#html
let treeLayout := BinTree.node ("A", (2, 1))
(.leaf ("B", (1, 2)))
(.node ("C", (4, 2))
(.leaf ("D", (3, 3)))
(.leaf ("E", (5, 3))))
BinTree.render treeLayout
/-- 2分木の各要素に一様に関数を適用する -/
def BinTree.map {α β : Type} (f : α → β) (tree : BinTree α) : BinTree β :=
match tree with
| .empty => .empty
| .node val left right =>
.node (f val) (map f left) (map f right)
/-- `BinTree`は関手 -/
instance : Functor BinTree where
map := BinTree.map
/-- ２分木のレイアウト情報が渡されたときに、各ノードのレイアウト位置を一様にずらす -/
def BinTree.shift {β γ : Type} (tree : BinTree (α × β)) (shiftFn : β → γ) : BinTree (α × γ) :=
(fun (a, pos) => (a, shiftFn pos)) <$> tree
/-- ２分木の描画幅。二分木を描画したときに何グリッド占めるか。 -/
def BinTree.width (tree : BinTree α) : Nat :=
tree.toNodes.size - 1
/-- 二分木のレイアウトを計算する関数 -/
def BinTree.layout (tree : BinTree α) : BinTree (α × (Nat × Nat)) :=
match tree with
| .empty => .empty
| .node a .empty .empty =>
.node (a, (1, 1)) .empty .empty
| .node a .empty right =>
let rightLayout := layout right
let rightShifted := rightLayout.shift (fun (x, y) => (x + 1, y + 1))
.node (a, (1, 1)) .empty rightShifted
| .node a left .empty =>
let leftLayout := layout left
let leftShifted := leftLayout.shift (fun (x, y) => (x, y + 1))
.node (a, (left.width + 2) * 1, 1) leftShifted .empty
| .node a left right =>
let leftLayout := layout left
let rightLayout := layout right
let leftShifted := leftLayout.shift (fun (x, y) => (x, y + 1))
let rightShifted := rightLayout.shift (fun (x, y) => (x + (left.width + 2) * 1, y + 1))
.node (a, ((left.width + 2) * 1, 1)) leftShifted rightShifted
-- 二分木の描画テスト
-- 二分木からレイアウト情報を計算し、それを元に描画している
#html
let tree := BinTree.node "A"
(BinTree.leaf "B")
(BinTree.node "C"
(BinTree.leaf "D")
(BinTree.leaf "E"))
BinTree.render tree.layout
-
この例を作成するにあたり、lean-ja Discord サーバーで todaymint さんにご助力をいただきました。 ↩
#instances
#instances は、与えられた型クラスのインスタンスの完全なリストを出力するコマンドです。
import Batteries.Tactic.Instances -- `#instances` コマンドを使うために必要
-- 内容が何もない例示のためだけの型クラス
class Hoge (α : Type) where
hoge : Unit
-- `Nat` を `Hoge` のインスタンスにする
instance : Hoge Nat where
hoge := ()
-- `Bool` を `Hoge` のインスタンスにする
instance : Hoge Bool where
hoge := ()
-- 今登録した2つのインスタンスが表示される
/-
info: 2 instances:
instHogeBool : Hoge Bool
instHogeNat : Hoge Nat
-/
#instances Hoge
#lint
#lint コマンドは、環境リンター(environment linter)を実行します。
環境リンターとは何かというと、Lean のリンター（よくない書き方のコードを検出するツール）の一種です。
環境リンターは、#lint コマンドや lake lint コマンドで実行することができます。
Lean のリンターには他に、構文リンター(syntax linter)があります。
import Batteries.Tactic.Lint
-- ドキュメントコメントのない定理
theorem hoge : True := by trivial
-- ドキュメントコメントのない定理に対して警告するリンタ
/-
The `docBlameThm` linter reports:
THEOREMS ARE MISSING DOCUMENTATION STRINGS:
-/
#lint only docBlameThm
-- ドキュメントコメントのない定義
def fuga : True := by trivial
-- 定義にドキュメントコメントがあるか確認するリンタ
-- 定理は対象外なのでスルーされる
/-
The `docBlame` linter reports:
DEFINITIONS ARE MISSING DOCUMENTATION STRINGS:
-/
#lint only docBlame
環境リンターをユーザが自作したい場合は、Batteries.Tactic.Lint.Linter 型の項を作って [env_linter] 属性を付与します。
open Lean Batteries Tactic Lint
/-- `bad` という文字が入っている宣言を検出する、意味のないリンター -/
@[env_linter]
meta def findBad : Batteries.Tactic.Lint.Linter where
noErrorsFound := "no bad declarations found."
errorsFound := "BAD DECLARATIONS FOUND:"
test declName := do
-- 自動生成された宣言などを無視したければここで除外
if ← isAutoDecl declName then
return none
-- declName を調べる
let info ← getConstInfo declName
-- 問題なしなら none
-- 問題ありなら some メッセージ
if info.name.toString.contains "bad" then
return some m!"declaration name contains `bad`"
else
return none
def bad := "わるいよ！"
/-
error: -- Found 1 error in 4 declarations (plus 0 automatically generated ones) in the current file with 1 linters
-/
#lint only findBad
#loogle
#loogle コマンドは、Lean で定理や関数を探すための検索エンジンである、Loogle を利用した検索をエディタ上で行うためのコマンドです。Loogle で使用できるのと同様の検索クエリが使用できます。
#find と似ていますが、#find と違って #loogle はAPIを利用するだけなのでより高速に動作します。
検索クエリの書き方
名前に特定の文字列が含まれるかどうか
二重引用符 " で文字列を囲って与えると、補題の名前にその文字列が含まれるような補題や、関数名にその文字列が含まれるような関数を検索します。
たとえば、仮に Nat.add_zero : ∀ n : Nat, n + 0 = 0 の名前をどわすれして、思い出したいとしましょう。ここで「整数の、ゼロの和に関する定理」というところまで思い出せるのであれば、定理名に入っていそうな文字列を与えることで検索に引っかけることができます。
import LeanSearchClient.LoogleSyntax
/-
info: Loogle Search Results
[apply] #check Nat.add_zero -- (n : ℕ) : n + 0 = n
⏎
[apply] #check instNeZeroNatHAdd -- {n m : ℕ} [h : NeZero n] : NeZero (n + m)
⏎
[apply] #check instNeZeroNatHAdd_1 -- {n m : ℕ} [h : NeZero m] : NeZero (n + m)
⏎
[apply] #check Nat.zero_add -- (n : ℕ) : 0 + n = n
⏎
[apply] #check Nat.add_one_ne_zero -- (n : ℕ) : n + 1 ≠ 0
⏎
[apply] #check Nat.zero_ne_add_one -- (n : ℕ) : 0 ≠ n + 1
-/
#loogle "Nat", "zero", "add"
特定の定数・関数が登場するか
たとえば List.foldl という関数についてどのような補題が存在するか知りたいとします。このような場合、List.foldl が定理の中で言及されているような定理を検索したいですが、これはそのまま識別子を与えることで検索可能です。
/-
info: Loogle Search Results
[apply] #check List.foldl -- {α : Type u} {β : Type v} (f : α → β → α) (init : α) : List β → α
Folds a function over a list from the left, accumulating a value starting with `init`. The
accumulated value is combined with the each element of the list in order, using `f`.
⏎
Examples:
* `[a, b, c].foldl f z = f (f (f z a) b) c`
* `[1, 2, 3].foldl (· ++ toString ·) "" = "123"`
* `[1, 2, 3].foldl (s!"({·} {·})") "" = "((( 1) 2) 3)"`
⏎
⏎
[apply] #check List.foldl_nil -- {α✝ : Type u_1} {β✝ : Type u_2} {f : α✝ → β✝ → α✝} {b : α✝} : List.foldl f b [] = b
⏎
[apply] #check List.foldl_cons -- {α : Type u} {β : Type v} {a : α} {l : List α} {f : β → α → β} {b : β} : List.foldl f b (a :: l) = List.foldl f (f b a) l
⏎
[apply] #check List.foldl_eq_foldr_reverse -- {α : Type u_1} {β : Type u_2} {l : List α} {f : β → α → β} {b : β} : List.foldl f b l = List.foldr (fun x y => f y x) b l.reverse
⏎
[apply] #check List.foldl_reverse -- {α : Type u_1} {β : Type u_2} {l : List α} {f : β → α → β} {b : β} : List.foldl f b l.reverse = List.foldr (fun x y => f y x) b l
⏎
[apply] #check List.foldr_eq_foldl -- {α : Type u_1} {init : α} {xs : List α} {f : α → α → α} [Std.Associative f] [Std.LawfulIdentity f init] : List.foldr f init xs = List.foldl f init xs
-/
#loogle List.foldl
型による検索
探したい定理・関数が持っているはずの型で検索することができます。たとえば List.map という関数をどわすれしたとしましょう。このとき、(α → β) → List α → List β という型を持つ関数を探すことで、List.map にたどり着くことができます。それには型変数の部分をメタ変数にして検索クエリを作ります。
/-
info: Loogle Search Results
[apply] #check List.map -- {α : Type u_1} {β : Type u_2} (f : α → β) (l : List α) : List β
Applies a function to each element of the list, returning the resulting list of values.
⏎
`O(|l|)`.
⏎
Examples:
* `[a, b, c].map f = [f a, f b, f c]`
* `[].map Nat.succ = []`
* `["one", "two", "three"].map (·.length) = [3, 3, 5]`
* `["one", "two", "three"].map (·.reverse) = ["eno", "owt", "eerht"]`
⏎
⏎
[apply] #check List.modifyHead -- {α : Type u} (f : α → α) : List α → List α
Replace the head of the list with the result of applying `f` to it. Returns the empty list if the
list is empty.
⏎
Examples:
* `[1, 2, 3].modifyHead (· * 10) = [10, 2, 3]`
* `[].modifyHead (· * 10) = []`
⏎
⏎
[apply] #check List.mapTR -- {α : Type u} {β : Type v} (f : α → β) (as : List α) : List β
Applies a function to each element of the list, returning the resulting list of values.
⏎
`O(|l|)`. This is the tail-recursive variant of `List.map`, used in runtime code.
⏎
Examples:
* `[a, b, c].mapTR f = [f a, f b, f c]`
* `[].mapTR Nat.succ = []`
* `["one", "two", "three"].mapTR (·.length) = [3, 3, 5]`
* `["one", "two", "three"].mapTR (·.reverse) = ["eno", "owt", "eerht"]`
⏎
⏎
[apply] #check List.modify -- {α : Type u} (l : List α) (i : ℕ) (f : α → α) : List α
Replaces the element at the given index, if it exists, with the result of applying `f` to it. If the
index is invalid, the list is returned unmodified.
⏎
Examples:
* `[1, 2, 3].modify 0 (· * 10) = [10, 2, 3]`
* `[1, 2, 3].modify 2 (· * 10) = [1, 2, 30]`
* `[1, 2, 3].modify 3 (· * 10) = [1, 2, 3]`
⏎
⏎
[apply] #check List.mapTR.loop -- {α : Type u} {β : Type v} (f : α → β) : List α → List β → List β
⏎
[apply] #check List.map_eq_mapTR -- : @List.map = @List.mapTR
-/
#loogle (?a → ?b) → List ?a → List ?b
パターンによる検索
パターンで検索することもできます。たとえば、n * m = 0 ↔ n = 0 ∨ m = 0 を主張する定理の名前が知りたいとしましょう。このとき、定理の中に出現するべきパターンから検索することができます。
/-
info: Loogle Search Results
[apply] #check Nat.mul_eq_zero -- {m n : ℕ} : n * m = 0 ↔ n = 0 ∨ m = 0
-/
#loogle "Nat", "mul", (_ * _ = 0), (_ = 0 ∨ _ = 0)
#print コマンドには複数の機能がありますが、単体で使うと定義を表示することができます。
/-
info: inductive Or : Prop → Prop → Prop
number of parameters: 2
constructors:
Or.inl : ∀ {a b : Prop}, a → a ∨ b
Or.inr : ∀ {a b : Prop}, b → a ∨ b
-/
#print Or
/-
info: @[defeq] theorem Nat.add_succ : ∀ (n m : Nat), n + m.succ = (n + m).succ :=
fun n m => rfl
-/
#print Nat.add_succ
/-
info: structure And (a b : Prop) : Prop
number of parameters: 2
fields:
And.left : a
And.right : b
constructor:
And.intro {a b : Prop} (left : a) (right : b) : a ∧ b
-/
#print And
利用可能な構文
#print 単体で利用できるほか、サブコマンドも定義されています。利用できるサブコマンドの全体は、エラーメッセージから確認できますが、以下の通りです。
axiomseqnsequationssigtactic
open Lean Parser in
/-- `s : String` をパースして `Syntax` の項を得る。`cat` は構文カテゴリ。-/
def parse (cat : Name) (s : String) : MetaM Syntax := do
ofExcept <| runParserCategory (← getEnv) cat s
/-
error: <input>:1:7: expected 'axioms', 'eqns', 'equations', 'sig', 'tactic', identifier or string literal
-/
#eval parse `command "#print axiom"
また、このエラーメッセージから、#print コマンドに直接渡せるのは識別子(identifier)または文字列リテラル(string literal)だけであることが確認できます。識別子ではない一般の項(term)を渡すと、構文エラーになります。
open Lean in
/-
error: Application type mismatch: The argument
a
has type
TSyntax `term
but is expected to have type
TSyntax [`ident, `str]
in the application
a.raw
-/
run_meta
let a ← `(1 + 1)
let _ ← `(#print $a)
#print axioms: 依存公理の確認
概要
#print axioms で、与えられた証明項が依存する公理を出します。たとえば Lean では排中律は選択原理 Classical.choice を使って証明するので、排中律は選択原理に依存しています。
/-- 排中律 -/
example : ∀ (p : Prop), p ∨ ¬p := Classical.em
/- info: 'Classical.em' depends on axioms: [propext, Classical.choice, Quot.sound] -/
#print axioms Classical.em
また、#print axioms は不正な証明を見つけるのにも有用です。sorry という命題を「証明したことにする」タクティクがありますが、これは sorryAx という万能な公理を導入していることが確認できます。
theorem contra : False := by sorry
/- info: 'contra' depends on axioms: [sorryAx] -/
#print axioms contra
ただし、#print axioms で常に不正な証明が発見できるわけではありません。たとえば debug.skipKernelTC オプションを使用することですり抜けることができてしまいます。
舞台裏
Lean.collectAxioms という関数を使用することにより、依存公理を調べて何かを行うような #print axioms の類似コマンドを自作することができます。ここでは例として、elab コマンドを使用して「ある定理が選択原理 Classical.choice に依存しているかどうか調べて、依存していればエラーにする」というコマンドを作成します。
section
open Lean Elab Command
/-- 選択原理に依存していないことを検証するコマンド -/
elab "#detect_classical " id:ident : command => do
-- 識別子(ident)を Name に変換
let constName ← liftCoreM <| realizeGlobalConstNoOverload id
-- 依存する公理を取得
let axioms ← collectAxioms constName
-- 依存公理がなかったときの処理
if axioms.isEmpty then
logInfo m!"'{constName}' does not depend on any axioms"
return ()
-- Classical で始まる公理があるかどうかチェック
-- もしあればエラーにする
let caxes := axioms.filter fun nm => Name.isPrefixOf `Classical nm
if caxes.isEmpty then
logInfo m!"'{constName}' is non-classical and depends on axioms: {axioms.toList}"
else
throwError m!"'{constName}' depends on classical axioms: {caxes.toList}"
end
-- 依存公理がないケース
/- info: 'Nat.add_zero' does not depend on any axioms -/
#detect_classical Nat.add_zero
-- 選択公理に依存しないケース
/- info: 'Nat.div_add_mod' is non-classical and depends on axioms: [propext] -/
#detect_classical Nat.div_add_mod
-- 選択公理に依存するときはエラー
/- error: 'Classical.em' depends on classical axioms: [Classical.choice] -/
#detect_classical Classical.em
#print opaque: opaque/partial 依存の確認
opaque コマンドによって定義された名前や、partial コマンドによって定義された関数への依存を見つけ出したいとき、#print opaque というサブコマンドが利用できます。
import Batteries.Tactic.PrintOpaques
/-- 無限ループする関数 -/
partial def endless {α : Type u} (a : α) : α :=
endless a
def exampleFunc (a : Nat) : Nat :=
endless a + 1
/- info: 'exampleFunc' depends on opaque or partial definitions: [endless] -/
#print opaques exampleFunc
#reduce
#reduce は、与えられた式をこれ以上簡約できなくなるまで簡約します。
/- info: 4 -/
#reduce 1 + 3
/- info: 4 -/
#reduce (fun x => x + 1) 3
#evalとの違い
これだけ見ると #eval と同じですが、#reduce は式の評価ではなくて簡約なので、関数や型も渡すことができます。
以下は、関数を渡す例です。
/-- 1を足すだけの関数 -/
def addOne (x : Nat) := x + 1
-- addOne が定義に展開されている
/- info: fun x => x.succ -/
#reduce addOne
-- 合成が計算できる
/- info: fun x => x.succ.succ -/
#reduce addOne ∘ addOne
また次は #reduce コマンドに型を渡す例です。
/-- `Nat`に値を持つ`n`引数関数の型 -/
def Natural (n : Nat) : Type :=
match n with
| 0 => Nat
| n + 1 => Natural n → Nat
-- 全く簡約されない
/- info: Natural 0 -/
#reduce Natural 0
再帰除去
#reduce コマンドに再帰関数を渡してみると、出力結果に .rec などが含まれる複雑な式が返ってきます。特に、出力結果は再帰的ではありません。
/-- 常にどんな値に対してもゼロを返す関数 -/
def zero {α : Type} (xs : List α) : Nat :=
match xs with
| [] => 0
| _ :: xs => zero xs
/-
info: fun xs => (List.rec ⟨0, PUnit.unit⟩ (fun head tail tail_ih => ⟨tail_ih.1, tail_ih⟩) xs).1
-/
#reduce zero
これは、Lean が裏で 再帰除去(recursion elimination) を行っているためです。
実際、Lean の型チェッカは再帰的な定義を受け付けないように設計されています。なぜかというと、再帰的な定義を（制限なしに）許すと矛盾が簡単に示せてしまうからです。
/-- Lean の型チェッカが許すべきでない再帰関数の例 -/
unsafe def bad {P : Prop} : P := bad
-- 矛盾が示せてしまう
unsafe example : False := bad
#synth
型クラス C と型 T があるとき、#synth C T は T が C のインスタンスになっているかチェックします。もしインスタンスでなかった場合にはエラーになります。
型クラスとは
型クラスとは、複数の型に対して共通の機能や実装を提供するものです。具体例を見てみましょう。たとえば逆数は、複数の型に対して定義されています。
-- `⁻¹` で逆数を表すことができる
#check (1 : ℚ)⁻¹
-- 実数として見ても同じ
#check (1 : ℝ)⁻¹
逆数をとる関数 fun x => x⁻¹ の定義域はどうなっているのでしょうか？定義域を一般の型 α に拡張してみて、どうなるか見てみましょう。
variable (α : Type)
/-
error: failed to synthesize instance of type class
Inv α
Hint: Type class instance resolution failures can be inspected with the `set_option trace.Meta.synthInstance true` command.
-/
#check (_ : α)⁻¹
一般の型に対して逆数は定義できないので、エラーになってしまいました。エラーメッセージで α は Inv のインスタンスではないと言われています。この Inv が型クラスです。Inv のインスタンスであるような型 T に対しては、逆数関数 (·)⁻¹ : T → T が定義できるというわけです。
インスタンスとは
例えば実数 ℝ に対して逆数は定義できるだろうと予想されますが、実際 ℝ は Inv のインスタンスであることが確認できます。
/- info: Real.instInv -/
#synth Inv Real
自然数 ℕ に対しては逆数が定義されていないと予想されますが、実際 Inv のインスタンスになっていません。
-- エラーになってしまう
/-
error: failed to synthesize
Inv ℕ
Hint: Additional diagnostic information may be available using the `set_option diagnostics true` command.
-/
#synth Inv Nat
-- Inv のインスタンスになっていない
#check_failure (inferInstance : Inv Nat)
自分で無理やり ℕ を Inv のインスタンスにしてみると、通るようになります。ここでは逆数関数を常に 1 になる定数関数としてみましょう。
instance : Inv Nat := ⟨fun _ => 1⟩
#synth Inv Nat
example : (1 : ℕ)⁻¹ = 1 := by rfl
#test
#test コマンドは、Plausible ライブラリで定義されているもので、与えられた命題が成り立つかどうか、具体例をランダムに生成してチェックすることで検証します。plausible タクティクと同様の機能を持ちます。1
import Plausible
/-- 農民の掛け算と呼ばれるよくわからない関数 -/
def peasantMul (x y : Nat) : Nat := Id.run do
let mut x := x
let mut y := y
let mut prod := 0
while x > 0 do
if x % 2 = 1 then
prod := prod + y
x := x / 2
y := y * 2
return prod
-- どうやら a * b と等しいようだが…？
-- これは本当に正しいのだろうか
#guard peasantMul 3 2 = 6
#guard peasantMul 2 4 = 8
-- 正しそう！
#test ∀ n m, peasantMul n m = n * m
#test コマンドを使う利点としては、期待される仕様をそのまま表現したものがテストとして機能するので、テストを作る労力が軽減されるというのがあります。仕様を述語論理で表現することが容易な関数のテストや、異なる実装をした関数同士が実は等しいといったテストで有用でしょう。
/-- 与えられたリストに含まれない最小の要素を求める -/
def minFree (xs : List Nat) : Nat :=
List.range (xs.length + 1)
|>.removeAll xs
|>.head!
-- `minFree`の出力は元のリストに含まれない
#test ∀ xs : List Nat, minFree xs ∉ xs
-- `minFree`の出力は、元のリストに含まれない数の集合に対して下界を与える
#test ∀ xs : List Nat, ∀ x : Nat, x ∉ xs → minFree xs ≤ x
-
以下に紹介する
peasantMul関数の例は、Jeff Erickson「Algorithms」の0章2節で紹介されているアルゴリズムを参考にさせていただきました。 ↩
#time
#time は、コマンドの実行時間を計測するためのコマンドです。ミリ秒単位で結果を出してくれます。
-- フィボナッチ数列の遅い実装
-- `n` に関して指数関数的な時間がかかる
def fibonacci : Nat → Nat
| 0 => 0
| 1 => 1
| n + 2 => fibonacci n + fibonacci (n + 1)
-- 環境にもよるが、1000ms以上かかってしまうことも
#time #eval fibonacci 32
-- フィボナッチ数列のより速い実装
-- `n` に関して線形時間で計算できる
def fib (n : Nat) : Nat :=
(loop n).1
where
loop : Nat → Nat × Nat
| 0 => (0, 1)
| n + 1 =>
let p := loop n
(p.2, p.1 + p.2)
-- 10 ms 程度で終わる
#time #eval fib 32
Warning
エディタ上から
#evalコマンドで実行したり、コマンドラインでlean --runで実行したときにはインタプリタが使用されます。これにより計測できる実行時間は、コンパイル後のバイナリの実行時間とは異なります。コンパイル後のバイナリの実行時間を計測するには
lean_exeというlakefileのオプションを使用してください。
舞台裏
IO.monoMsNow という関数でそのときの時刻をミリ秒単位で取得できます。これにより #time コマンドのような時間計測を行うコマンドを自作できるでしょう。また IO.monoNanosNow という関数も存在し、これはナノ秒単位で結果を取得します。これを使うと、単位がナノ秒であるような #time の派生コマンドを自作できます。
import Lean
open Lean Elab Command Term Meta in
elab "#nano_time " stx:command : command => do
-- 実行直前に計測開始
let start_time ← IO.monoNanosNow
-- コマンドを実行
elabCommand stx
-- 実行後に計測終了
let end_time ← IO.monoNanosNow
-- 差分を実行時間としてナノ秒単位で出力
logInfo m!"time: {end_time - start_time}ns"
#nano_time
#eval 21 * 2
#version
#version コマンドは、その環境での Lean のバージョンと OS の情報を表示します。
#version
#whats_new
#whats_new コマンドを使うと、あるコマンドによって新たに導入された定理や関数などを見ることができます。
import Mathlib.Util.WhatsNew
/-- 自然数っぽい何か -/
inductive MyNat : Type where
| zero
| succ (n : MyNat)
def MyNat.add (m n : MyNat) : MyNat :=
match m with
| .zero => n
| .succ m' => MyNat.succ (MyNat.add m' n)
instance : Add MyNat where
add := MyNat.add
theorem MyNat.zero_add (n : MyNat) : MyNat.zero + n = n := by
rfl
/- info: -- Lean.Meta.simpExtension extension: 1 new entries -/
#whats_new in attribute [simp] MyNat.zero_add
#whnf
#whnf は、式を弱頭正規形(weak head normal form)に簡約するコマンドです。
弱頭正規形とは、式の構成要素の最初の部分(head)がそれ以上簡約できない形になっている状態のことです。たとえば式の頭が帰納型のコンストラクタや、ラムダ式になっていれば弱頭正規形です。
import Mathlib.Tactic.Conv -- `#whnf` コマンドを使うために必要
-- 弱頭正規形
/- info: (fun x => x + 1) 1 :: List.map (fun x => x + 1) [2, 3] -/
#whnf [1, 2, 3].map (· + 1)
-- 弱頭正規形で止まらずに完全に簡約した場合
/- info: [2, 3, 4] -/
#reduce [1, 2, 3].map (· + 1)
-- 上記の式がなぜ弱頭正規形であるのかの説明
example : [1, 2, 3].map (· + 1) = [2, 3, 4] := calc
-- フィールド記法を展開する
_ = List.map (· + 1) [1, 2, 3] := by rfl
-- ラムダ式に展開される
_ = List.map (fun x => x + 1) [1, 2, 3] := by rfl
-- List.map を使うために、引数をコンストラクタに分解する
_ = List.map (fun x => x + 1) (1 :: [2, 3]) := by rfl
-- List.map の定義を展開する
_ = (fun x => x + 1) 1 :: List.map (fun x => x + 1) [2, 3] := by rfl
-- これはコンストラクタが先頭に来ているので、弱頭正規形になっている
_ = List.cons ((fun x => x + 1) 1) (List.map (fun x => x + 1) [2, 3]) := by rfl
_ = [2, 3, 4] := by rfl
型クラスの実装を調べる
一見して使いどころがないようですが、型クラスの実装を調べたいときに有用です。
たとえば、以下のように Many という型を定義し、Monad 型クラスの実装を与えたとします。
/-- 遅延評価版の List もどき -/
inductive Many (α : Type) where
| none : Many α
| more : α → (Unit → Many α) → Many α
variable {α β : Type}
def Many.one (x : α) : Many α := Many.more x (fun () => Many.none)
def Many.union {α : Type} : Many α → Many α → Many α
| .none, ys => ys
| .more x xs, ys => Many.more x (fun () => union (xs ()) ys)
def Many.bind : Many α → (α → Many β) → Many β
| .none, _ => Many.none
| .more x xs, f =>
(f x).union (bind (xs ()) f)
/-- Many にモナドの実装を与える -/
instance instMonadMany : Monad Many where
pure := Many.one
bind := Many.bind
Monad 型クラスは Functor クラスや Applicative クラスの実装を含むので、Many は Functor や Applicative のインスタンスでもあります。このインスタンスは次のように inferInstance という関数で構成することができますが、その中身を #print で出力してみても実装がわかりません。
instance instManyFunctor : Functor Many := inferInstance
/-
info: @[instance_reducible] def instManyFunctor : Functor Many :=
inferInstance
-/
#print instManyFunctor
しかし、#whnf コマンドに渡すと実装内容を表示してくれます。
-- Functor の実装を表示させることができた
/- info: { map := fun {α β} f x => (fun {α β} => Many.bind) x ((fun {α} => Many.one) ∘ f) } -/
#whnf (inferInstance : Functor Many)
-- seq の実装を表示させることができた
/-
info: {
seq := fun {α β} f x =>
(fun {α β} => Many.bind) f fun y => (fun {α β} => Many.bind) (x ()) ((fun {α} => Many.one) ∘ y) }
-/
#whnf (inferInstance : Seq Many)
なお、これを #reduce で行おうとすると簡約しすぎて読みづらい表示が出てきます。
/-
info: {
map := fun {α β} f x =>
(Many.rec ⟨fun x => Many.none, PUnit.unit⟩
(fun a a_1 a_ih =>
⟨fun x =>
(Many.rec ⟨fun x => x, PUnit.unit⟩
(fun a a_2 a_ih => ⟨fun x => Many.more a fun x_1 => (a_ih PUnit.unit).1 x, a_ih⟩) (x a)).1
((a_ih PUnit.unit).1 x),
a_ih⟩)
x).1
fun x => Many.more (f x) fun x => Many.none,
mapConst := fun {α β} x x_1 =>
(Many.rec ⟨fun x => Many.none, PUnit.unit⟩
(fun a a_1 a_ih =>
⟨fun x =>
(Many.rec ⟨fun x => x, PUnit.unit⟩
(fun a a_2 a_ih => ⟨fun x => Many.more a fun x_2 => (a_ih PUnit.unit).1 x, a_ih⟩) (x a)).1
((a_ih PUnit.unit).1 x),
a_ih⟩)
x_1).1
fun x_2 => Many.more x fun x => Many.none }
-/
#reduce (inferInstance : Functor Many)
宣言的コマンド
トップレベルコマンドには # から始まるものとそうでないものがあり、そうでないものを本書では便宜的に「宣言的コマンド」と呼んでいます。これは、そうしたコマンドが定義を行ったり属性を付与したりと、Lean に何かを宣言するために使われることが多いためです。
Warning
宣言的コマンド(declarative command)という用語は一般的なものではなく、著者が本書で使うために考案したものです。
abbrev
abbrev は、略称(abbreviation)を宣言するコマンドです。
たとえば、Nat 型に別の名前を与えたかったとしましょう。Lean では型も他の項と同様に宣言できるので、次のように書いて問題がないように見えます。1
def NaturalNumber : Type := Nat
しかし、ここで定義した Nat の別名を項に対して使用するとエラーになります。エラーメッセージには以下の通り「NaturalNumber の OfNat インスタンスが見つかりません」という旨のことが書かれています。これは、Lean が NaturalNumber を定義に展開してそれが実は Nat に等しいことを知るよりも先に、42 : NaturalNumber という表記が定義されているか OfNat のインスタンスを探そうとしてエラーになったことを示唆します。
/-
error: failed to synthesize instance of type class
OfNat NaturalNumber 42
-/
#check (42 : NaturalNumber)
ここでエラーを修正する方法の一つが、def の代わりに abbrev を使用することです。
abbrev NaturalNumber : Type := Nat
#check (42 : NaturalNumber)
舞台裏
abbrev コマンドを使用すると、裏で [reducible] 属性が付与されます。
abbrev NaturalNumber : Type := Nat
-- `[reducible]` 属性が付与されている
/-
info: @[reducible] def NaturalNumber : Type :=
Nat
-/
#print NaturalNumber
-
以下のコード例は、Functional Programming in Lean の１章３節の記述を参考にさせていただきました。 ↩
add_aesop_rules
add_aesop_rules は aesop タクティクに追加のルールを登録するためのコマンドです。
import Aesop
/-- 自然数 n が正の数であることを表す帰納的述語 -/
inductive Pos : Nat → Prop where
| succ n : Pos (n + 1)
example : Pos 1 := by
-- 最初はルールが足りなくて示せない
fail_if_success aesop
-- 手動でコンストラクタを `apply` することで証明できる
apply Pos.succ
-- `Pos` 関連のルールを `aesop` に憶えさせる
add_aesop_rules safe constructors [Pos]
-- aesop で示せる
example : Pos 1 := by aesop
なお aesop をカスタマイズしたものを専用のタクティクにまとめることも可能ですが、それについてはここでは詳しく述べません。declare_aesop_rule_sets コマンドのページを参照してください。
add_aesop_rules は、add_aesop_rules <phase>? <priority>? <builder_name>? <rule_sets>? という構文で使用できます。
phase について
phase は norm と safe と unsafe の３通りです。「ルールを適用した後、ダメそうだとわかったら引き返せ」「常に最初に適用せよ」など試行錯誤のやり方を指示します。
open Lean Parser Category in
-- `Aesop.phase` という構文カテゴリが存在する
#check (Aesop.phase : Category)
norm
norm は正規化(normalisation)ルールを表します。最初に適用されるルール群であり、適用によりゴールが増えないようなルールだけを登録することが推奨されます。[simp] 補題と同様に使用されます。
/-- And を模倣して自作した型 -/
structure MyAnd (a b : Prop) : Prop where
intro ::
left : a
right : b
/-- `P ∧ P ↔ P` に相当するルール -/
theorem erase_duplicate {P : Prop} : MyAnd P P ↔ P := by
constructor <;> intro h
· rcases h with ⟨h⟩
exact h
· exact MyAnd.intro h h
example (P : Prop) (hp : P) : MyAnd P P := by
-- 最初は aesop で証明できない
fail_if_success solve
| aesop
sorry
-- aesop に登録する
add_aesop_rules norm simp [erase_duplicate]
example (P : Prop) (hp : P) : MyAnd P P := by
-- aesop で証明できるようになった!
aesop
safe
safe ルールは、norm ルールの実行後に適用されます。あるゴールが証明可能であるとき、それに safe ルールを適用しても生成されるゴールは依然として証明可能であるように、safe ルールを選ぶことが推奨されます。
/-- 自前で定義したリスト -/
inductive MyList (α : Type) where
| nil
| cons (head : α) (tail : MyList α)
/-- リストが空ではないことを表す帰納的述語 -/
inductive NonEmpty {α : Type} : MyList α → Prop where
| cons x xs : NonEmpty (MyList.cons x xs)
example : NonEmpty (MyList.cons 1 MyList.nil) := by
-- 最初は aesop で証明できない
fail_if_success aesop
sorry
local add_aesop_rules safe apply [NonEmpty.cons]
-- aesop で示せるようになった！
example : NonEmpty (MyList.cons 1 MyList.nil) := by aesop
unsafe
unsafe ルールは、すべての safe ルールが失敗した場合に適用されます。失敗したらバックトラックして他の unsafe ルールを試します。priority として成功する確率(%)を指定する必要があります。
variable (a b c d e : Nat)
example (h1 : a ≤ b) (h2 : b ≤ c) (h3 : c ≤ d) (h4 : d ≤ e) : a ≤ e := by
-- 最初は aesop で証明できない
fail_if_success aesop
sorry
-- 推移律を `unsafe` ルールとして登録する
local add_aesop_rules unsafe 10% apply [Nat.le_trans]
example (h1 : a ≤ b) (h2 : b ≤ c) (h3 : c ≤ d) (h4 : d ≤ e) : a ≤ e := by
-- aesop で証明できるようになった！
aesop
safe ルールは適用すると後戻りができないため、特定の状況でのみ適用したいルールは unsafe とすることが推奨されます。誤って safe ルールに登録してしまうと上手く動作しないことがあります。
-- safe ルールとして推移律を登録する
local add_aesop_rules safe apply [Nat.le_trans]
variable (a b c d e : Nat)
example (h1 : a ≤ b) (h2 : b ≤ c) (h3 : c ≤ d) (h4 : d ≤ e) : a ≤ e := by
-- aesop で証明できない
-- 同じ命題を同じように登録したが、safe にしてしまったからダメだった
fail_if_success aesop
sorry
builder_name について
builder_name は、登録されるルールに対して「ゴールを分解する」「仮定から推論を進める」といった方向性を決めます。複数の選択肢がありますが、ここではその一部を紹介します。
open Lean Parser Category in
-- `Aesop.builder_name` という構文カテゴリが存在する
#check (Aesop.builder_name : Category)
apply
apply タクティクと同様にはたらくルールを登録します。
example (a b c d e : Nat)
(h1 : a < b) (h2 : b < c) (h3 : c < d) (h4 : d < e) : a < e := by
-- 最初は aesop で示せない
fail_if_success aesop
-- 手動で示すならこのように apply を繰り返すことになる
apply Nat.lt_trans (m := d) <;> try assumption
apply Nat.lt_trans (m := c) <;> try assumption
apply Nat.lt_trans (m := b) <;> try assumption
-- 推移律を登録する
local add_aesop_rules unsafe 10% apply [Nat.lt_trans]
example (a b c d e : Nat)
(h1 : a < b) (h2 : b < c) (h3 : c < d) (h4 : d < e) : a < e := by
-- aesop で証明できるようになった
aesop
constructors
constructors ビルダーは、帰納型 T の形をしたゴールに遭遇した際に、コンストラクタを適用するように指示します。
/-- 自前で定義した偶数を表す帰納的述語 -/
inductive Even : Nat → Prop where
| zero : Even 0
| succ m : Even m → Even (m + 2)
example : Even 2 := by
-- 最初は aesop で証明できない
fail_if_success aesop
-- 手動でコンストラクタを適用することで示せる
apply Even.succ
apply Even.zero
-- aesop にルールを登録する
local add_aesop_rules safe constructors [Even]
example : Even 2 := by
-- aesop で証明できるようになった
aesop
cases
cases ビルダーは、帰納型 T の形をした仮定がローカルコンテキストにある場合に、それに対して再帰的に cases タクティクを使用して分解するように指示します。
/-- 自前で定義した奇数を表す帰納的述語 -/
inductive Odd : Nat → Prop where
| one : Odd 1
| succ m : Odd m → Odd (m + 2)
example (n : Nat) (h : Odd (n + 2)) : Odd n := by
-- 最初は aesop で証明できない
fail_if_success aesop
-- 手動で cases を使って分解することで証明できる
cases h
assumption
-- aesop にルールを登録する
local add_aesop_rules safe cases [Odd]
example (n : Nat) (h : Odd (n + 2)) : Odd n := by
-- aesop で証明できるようになった
aesop
destruct
destruct ビルダーは、A₁ → ⋯ → Aₙ → B という形の命題を登録することで、仮定に A₁, ..., Aₙ が含まれている場合に、元の仮定を消去して B を仮定に追加します。
/-- 任意の数 n について、n か n + 1 のどちらかは偶数 -/
theorem even_or_even_succ (n : Nat) : Even n ∨ Even (n + 1) := by
induction n with
| zero => left; apply Even.zero
| succ n ih =>
rcases ih with ih | ih
· right
apply Even.succ
assumption
· left
assumption
example {n : Nat} (h0 : ¬ Even n) (h1 : ¬ Even (n + 1)) : False := by
-- 最初は aesop で証明できない
fail_if_success aesop
-- 手動で補題を示すことで証明する
have := even_or_even_succ n
simp_all
local add_aesop_rules unsafe 30% destruct [even_or_even_succ]
example {n : Nat} (h0 : ¬ Even n) (h1 : ¬ Even (n + 1)) : False := by
-- aesop で示せるようになった！
aesop
tactic
tactic ビルダーは、タクティクを追加のルールとして直接利用できるようにします。
example (a b : Nat) (h : 3 ∣ (10 * a + b)) : 3 ∣ (a + b) := by
-- aesop で証明できない
fail_if_success aesop
-- omega で証明できる
omega
-- aesop にルールを登録する
local add_aesop_rules safe tactic [(by omega)]
example (a b : Nat) (h : 3 ∣ (10 * a + b)) : 3 ∣ (a + b) := by
-- aesop で証明できるようになった!
aesop
attribute
attribute は、属性(attribute)を付与するためのコマンドです。
次の例では、命題に [simp] 属性を付与しています。これは simp タクティクで利用される命題を増やすことを意味します。
theorem foo {P Q : Prop} : (P → Q) ∧ P ↔ Q ∧ P := by
constructor <;> intro h
all_goals
refine ⟨?_, by simp_all⟩
simp_all
example {P Q : Prop} : (P → Q) ∧ P ↔ Q ∧ P := by
-- `simp` では示せない
fail_if_success solve
| simp
sorry
-- `attribute` で属性を付与
attribute [simp] foo
example {P Q : Prop} : (P → Q) ∧ P ↔ Q ∧ P := by
-- `simp` で示せるようになった
simp
属性の削除
与えた属性を削除することができることもあります。削除するには - を属性の頭に付けます。属性の削除はデバッグを意図した機能で、常にローカルにはたらき、そのセクションの外に出ると削除された属性が戻ります。
section
-- `[simp]` 属性を削除
attribute [-simp] foo
-- 再び `simp` では示せなくなった
example {P Q : Prop} : (P → Q) ∧ P ↔ Q ∧ P := by
fail_if_success solve
| simp
sorry
end
-- `simp` で示せるようになった
example {P Q : Prop} : (P → Q) ∧ P ↔ Q ∧ P := by simp
属性によっては、削除することができないこともあります。
@[irreducible] def greet := "Hello"
/- error: Attribute `[irreducible]` cannot be erased -/
attribute [-irreducible] greet
タグ
attribute コマンドを使用すると定義の後から属性を付与することができますが、定義した直後に属性を付与する場合はタグと呼ばれる @[..] という書き方が使えます。
@[simp]
theorem bar {P Q : Prop} : (P → Q) ∧ P ↔ Q ∧ P := by
constructor <;> intro h
all_goals
refine ⟨?_, by simp_all⟩
simp_all
example {P Q : Prop} : (P → Q) ∧ P ↔ Q ∧ P := by
simp
有効範囲を制限する
特定の section 内でのみ付与した属性を有効にするには、local で属性名を修飾します。
example (P Q : Prop) : ((P ∨ Q) ∧ ¬ Q) ↔ (P ∧ ¬ Q) := by
-- simp だけでは証明できない
fail_if_success solve
| simp
sorry
section
-- 補題
theorem or_and_neg (P Q : Prop) : ((P ∨ Q) ∧ ¬ Q) ↔ (P ∧ ¬ Q) := by
constructor <;> intro h
· refine ⟨?_, by simp_all⟩
have : ¬ Q := h.right
simp_all
· refine ⟨?_, by simp_all⟩
simp_all
-- local に simp 補題を登録
attribute [local simp] or_and_neg
-- simp で証明ができるようになった！
example (P Q : Prop) : ((P ∨ Q) ∧ ¬ Q) ↔ (P ∧ ¬ Q) := by simp
end
example (P Q : Prop) : ((P ∨ Q) ∧ ¬ Q) ↔ (P ∧ ¬ Q) := by
-- section を抜けると simp 補題が利用できなくなった
fail_if_success solve
| simp
sorry
axiom
axiom は、公理(axiom)を宣言するためのコマンドです。公理とは、議論の前提のことで、証明を与えることなく正しいと仮定される命題です。
/-- sorryAx を真似て作った公理 -/
axiom mySorryAx {P : Prop} : P
-- 任意の命題を示すことができる
theorem FLT : ∀ x y z n : Nat, n > 2 → x^n + y^n ≠ z^n := by
apply mySorryAx
/- info: 'FLT' depends on axioms: [mySorryAx] -/
#print axioms FLT
組み込みの公理
組み込みで用意されている公理をいくつか紹介します。
命題外延性 propext
命題外延性の公理 propext は、同値な命題は等しいという公理です。この公理があることにより、どのような状況でも常に命題をそれと同値な命題と置き換えることができます。
-- 命題外延性の公理
/- info: axiom propext : ∀ {a b : Prop}, (a ↔ b) → a = b -/
#print propext
-- 命題外延性の公理を使って命題を置換する
theorem ex_prop_ext (a b : Prop) (p : Prop → Prop) (h : a ↔ b) (h₁ : p a) : p b := by
have := propext h
rw [←this]
assumption
/- info: 'ex_prop_ext' depends on axioms: [propext] -/
#print axioms ex_prop_ext
商の公理 Quot.sound
任意の型 α : Sort u と α 上の2項関係 r : α → α → Prop に対して、その商(quotient)を作ることができます。商の概念は、以下に示す複数の定数から構成されます。
section
universe u
variable {α : Sort u}
-- 商
#check (Quot : (α → α → Prop) → Sort u)
-- 商の構築
#check (Quot.mk : (r : α → α → Prop) → α → Quot r)
-- 帰納法の原理。
-- 任意の部分集合 `β ⊆ Quot r` に対して、
-- β が `Quot.mk r a` の形の項を全て含むならば、
-- β は商 `Quot r` 全体に一致する。
#check (Quot.ind :
{r : α → α → Prop} → {β : Quot r → Prop}
→ (∀ a, β (Quot.mk r a)) → ∀ q, β q)
-- 要するに商 `Quot r` の全ての項は `Quot.mk r a` の形をしている。
-- Quot.ind から直ちに従う。
example (r : α → α → Prop) (q : Quot r) : ∃ a : α, q = Quot.mk r a := by
have := Quot.ind (β := fun q => ∃ a : α, q = Quot.mk r a)
apply this
intro a
exists a
-- 関数の商へのリフト。
-- 関数 `f : α → β` が、関係 `r` に関して合同性を持つならば、
-- `f` をリフトして関数 `Quot r → β` が得られる。
#check (Quot.lift :
{r : α → α → Prop} → {β : Sort u} → (f : α → β)
→ (∀ a b, r a b → f a = f b) → Quot r → β)
end
商の公理 Quot.sound は上記の「商のような」概念を本物の商にします。
-- `r a b` が成り立つならば、商に送った時に同じ値になることを主張する。
/-
info: axiom Quot.sound.{u} : ∀ {α : Sort u} {r : α → α → Prop} {a b : α},
r a b → Quot.mk r a = Quot.mk r b
-/
#print Quot.sound
商の公理はなぜ重要か
上記で挙げた商を構成する以下の定数は、いずれも他の型からは独立したオブジェクトです。
- 型
Quot - コンストラクタ
Quoto.mk - 帰納法の原理
Quot.ind - 関数の商へのリフト
Quot.lift - 商の公理
Quot.sound
この中で Quot.sound だけが「公理」と呼ばれ、特別扱いされているのは何故でしょうか。以下のように商の公理以外の部分を Lean の帰納型を使って構成してみると理解できるかもしれません。
section
universe u
variable {α : Type}
/-- 標準ライブラリの Quot を真似して自作した型 -/
inductive MyQuot (r : α → α → Prop) : Type u where
| mk (a : α)
-- 商型のコンストラクタ
#check (MyQuot.mk : {r : α → α → Prop} → α → MyQuot r)
-- 自動生成された商型の帰納法の原理
-- Quot.ind とそっくりであることがわかる
#check (MyQuot.rec :
{r : α → α → Prop} → {β : MyQuot r → Sort _}
→ (mk : ∀ a : α, β (MyQuot.mk a)) → ∀ q, β q)
end
ここで、関数の商へのリフト Quot.lift に対応するものを具体的に関数として作ることができます。
/-- 商へのリフトの対応物 -/
def MyQuot.lift.{u} {α : Type}{r : α → α → Prop} {β : Sort u}
(f : α → β) (_ : ∀ a b, r a b → f a = f b) : MyQuot r → β
| MyQuot.mk a => f a
こうして Quot.sound を使わず、Lean に備わっている帰納型の構成だけを使って作った MyQuot は、商の公理以外のすべての点で商型にそっくりですが、全然商になっていません。コンストラクタを使って作られる項 MyQuot.mk a は、a : α が異なればすべて異なる項であり、同一視が全く入っていません。このような観点から、Quot.sound は商を商たらしめる重要なものであり、「商の公理」と呼ぶにふさわしいと考えられるわけです。
関数外延性
商の公理 Quot.sound を利用して、関数外延性を示すことができます。関数外延性とは、関数 f, g について ∀ x, f x = g x という仮定から f = g が示せるという定理です。直観的には「すべての入力に対して同じ値を返すような２つの関数は等しい」と主張しています。
実際に証明していきます。一般に証明を理解するためには、前提を確認することが大切です。「商の公理を使用しなくても、前提として等しいことが分かっているものは何か」をまず確認しましょう。前提として利用できる事実には、次の２つがあります：
- 関数
fとラムダ式fun x => f xは等しい。（これは η 簡約(eta reduce) と呼ばれる簡約ルールより従います） - 関数
fと、「関数fを適用する関数」は等しい。
実際に、公理を一切使わずにこれは証明できます。
universe u v
variable {α : Type u} {β : α → Sort v}
/-- η 簡約。依存関数はラムダ式と等しい。 -/
theorem lambda_eq (f : (x : α) → β x) : f = (fun x => f x) := by rfl
-- 依存関数 `f` がラムダ式 `fun x => f x` に等しいことは、定義から従うので
-- 何の公理も必要としない。
/- info: 'lambda_eq' does not depend on any axioms -/
#print axioms lambda_eq
/-- 関数適用を行う高階関数 -/
def funApp (a : α) (f : (x : α) → β x) : β a := f a
/-- 「`f` を適用する関数」と `f` は等しい -/
theorem funApp_eq (f : (x : α) → β x) : funApp (f := f) = f := calc
-- 関数とラムダ式は等しい
_ = (fun a => funApp a f) := by rw [lambda_eq funApp]
-- funApp の定義から等しい
_ = (fun a => f a) := by dsimp only [funApp]
-- 関数とラムダ式は等しい
_ = f := by rw [lambda_eq f]
-- これも何の公理も必要としない
/- info: 'funApp_eq' does not depend on any axioms -/
#print axioms funApp_eq
この事実を使うと、商の公理から関数外延性の証明ができます。
/-- 関数外延性の定理 -/
theorem my_funext {f g : (x : α) → β x} (h : ∀ x, f x = g x) : f = g := by
-- 外延性等式を表す二項関係を定義する
let eqv (f g : (x : α) → β x) := ∀ x, f x = g x
-- 二項関係 eqv で `(x : α) → β x` の商を取る
let «[(x : α) → β x]» := Quot eqv
-- 関数 `f` と `g` は商の公理から、商に送ると等しいことに注意する。
-- 商の公理はここで使っている。
have : Quot.mk eqv f = Quot.mk eqv g := Quot.sound (λ x => h x)
-- 関数適用 `funApp` は、適用する項 `a` を固定すれば `(x : α) → β x` 上の関数と見なせる。
-- この関数は同値関係 `eqv` を保つため、
-- 関数適用 `funApp` を商 `«[(x : α) → β x]»` 上に持ち上げることができる。
let «[funApp]» (a : α) (f' : «[(x : α) → β x]») : β a := by
have lift := @Quot.lift ((x : α) → β x) eqv (β a) (funApp a)
apply lift
· intro f g h
exact h a
· exact f'
-- `f = g` を示す問題を `«[funApp]»` をかませることで、
-- 商での等式に帰着させることができる。
exact show f = g from calc
-- 「`f` を適用する関数」と `f` は等しい
_ = funApp (f := f) := by rw [funApp_eq f]
-- 商への関数の持ち上げの定義から等しい
_ = «[funApp]» (f' := Quot.mk eqv f) := by rfl
-- 関数 `f` と `g` は商の公理から、商に送ると等しい
_ = «[funApp]» (f' := Quot.mk eqv g) := by rw [this]
-- 商への関数の持ち上げの定義から等しい
_ = funApp (f := g) := by rfl
-- 「`g` を適用する関数」と `g` は等しい
_ = g := by rw [funApp_eq g]
/- info: 'my_funext' depends on axioms: [Quot.sound] -/
#print axioms my_funext
選択原理 Classical.choice
選択原理は、ある型が空ではないという情報だけから、「魔法のように」具体的な元を構成することができると主張します。これは計算不可能な操作であるため、選択原理を使用する関数には noncomputable 修飾子が必要になります。
選択原理は数学でいうと NBG(Neumann-Bernays-Gödel) 集合論における大域選択公理(axiom of global choice)とよく似ています。
-- 選択原理は、空でない型から具体的な元を構成する
#check (Classical.choice : {α : Sort u} → Nonempty α → α)
ここで、ある型が空ではないという主張は Nonempty という型クラスで表現されています。Nonempty α は ∃ e : α, True と同値なので、存在命題だと思って構いません。
example (α : Type) : Nonempty α ↔ ∃ e : α, True := by
constructor
· intro ⟨a⟩
exists a
· intro ⟨a, _⟩
exact ⟨a⟩
存在命題に対する選択
選択原理は単に項を取ってくる関数ですが、選んだ項が満たすべき性質が欲しいこともあります。言い換えれば、存在命題 ∃ x : α, P x が成り立っているとき、P x が成り立つような x : α を取ってくる関数が必要なこともあります。それは選択原理を使って次のように構成することができます。
variable {α : Sort u}
noncomputable def indefiniteDescription (p : α → Prop) (h : ∃ x, p x) : {x // p x} := by
-- 選択原理を使用する
apply Classical.choice
-- p x となる x が存在することを示せばよい
show Nonempty {x // p x}
-- 仮定の存在命題から x を取り出す
obtain ⟨x, px⟩ := h
-- この x が所望の条件を満たす
exact ⟨x, px⟩
Lean のライブラリ上では、存在命題から選択する関数には Classical.choose という名前が、選択された項が満たすべき性質には Classical.choose_spec という名前がついています。
variable {p : α → Prop}
-- 存在命題から選択する関数
#check (Classical.choose : (h : ∃ x, p x) → α)
-- 選択された要素が満たす性質
#check (Classical.choose_spec : (h : ∃ x, p x) → p (Classical.choose h))
なぜ証明無関係と矛盾しないのか
証明無関係の節で詳しく述べているように、存在命題は「何かがある」としか主張しておらず、具体的な項を復元するのに必要な情報を持っていません。したがって存在が主張されている項を取り出して関数の返り値にすることはできないはずですが、選択原理を使うと存在命題から具体的な項が得られてしまいます。これが矛盾を生まないのはなぜでしょうか？
答えは、選択原理は証明方法が異なる証明項であっても、同じ命題であれば一様に同じ項を返すからです。以下の例では、「証拠」が異なるような存在命題の証明項を２つ与えていますが、そこから選択される項は同じです。つまり、選択原理は同値な存在命題すべてに対して一斉に同じ項を取り出す方法があると主張しているのであって、「存在が主張されている項を取り出して関数の返り値にする」ことができるとまでは主張していないのです。
-- 同じ存在命題の２通りの証明
-- 2乗すると1になる整数を２通り与えた
theorem foo : ∃ x : Int, x ^ 2 = 1 := by exists 1
theorem bar : ∃ x : Int, x ^ 2 = 1 := by exists -1
open Classical in
-- 選択される項は同じ
example : choose foo = choose bar := by rfl
排中律
選択原理と命題外延性と関数外延性を併せると、排中律を証明することができます。これは Diaconescuの定理 として知られる結果です。以下にその証明を示しましょう。
まず、命題論理から始めます。排中律は任意の命題 P : Prop に対して P ∨ ¬ P が成り立つという主張ですが、これを示すにはある命題 Q : Prop に対して「P → Q かつ ¬ Q ∨ P」を示せば十分です。
variable (P Q : Prop)
/-- 排中律を証明するための主要な補題 -/
theorem lemma_em (himp : P → Q) (hor : ¬ Q ∨ P) : P ∨ ¬ P := by
rcases hor with h | h
· right
intro hP
have := himp hP
contradiction
· left
exact h
-- 何の公理も使用していない
/- info: 'lemma_em' does not depend on any axioms -/
#print axioms lemma_em
選択原理を用いると命題 Q を構成することができ、関数外延性と命題外延性により、それが所望の性質を持つことを示すことができます。
/-- 排中律 -/
theorem em (P : Prop) : P ∨ ¬ P := by
-- Prop の部分集合 U と V を考える
let U (x : Prop) : Prop := (x = True) ∨ P
let V (x : Prop) : Prop := (x = False) ∨ P
-- U と V は空ではない
have exU : ∃ x, U x := ⟨True, by simp [U]⟩
have exV : ∃ x, V x := ⟨False, by simp [V]⟩
-- したがって、選択原理を使って `u ∈ U` と `v ∈ V` を選ぶことができる
let u : Prop := Classical.choose exU
let v : Prop := Classical.choose exV
have u_def : U u := Classical.choose_spec exU
have v_def : V v := Classical.choose_spec exV
-- 選択原理を使用したご利益として、u と v は一貫した方法で選択されているので、
-- `U = V` ならば `u = v` が成り立つ。
-- これは `u = True`, `v = False` などと構成した場合は示せないことに注意。
have eq_of_eq (h : U = V) : u = v := by
simp [u, v, h]
-- `Q := u = v` として `Q` を構成する
apply lemma_em (Q := u = v)
case himp =>
show P → u = v
-- P が成り立つと仮定する
intro (hP : P)
-- `U = V` を示せばよい
apply eq_of_eq
-- U と V の定義を展開する
dsimp [U, V]
-- 関数外延性によってゴールを書き換える
ext x
-- あとは命題論理の問題になる
-- 仮定に P があるので自明
show x = True ∨ P ↔ x = False ∨ P
simp [hP]
case hor =>
show (u ≠ v) ∨ P
-- U と V の定義を展開する
replace u_def : u ∨ P := by simpa [U] using u_def
replace v_def : ¬ v ∨ P := by simpa [V] using v_def
-- これにより４通りの場合分けが生じるが、１つを除いてすべて P が成り立つ。
rcases u_def with hu | hu <;> rcases v_def with hv | hv
all_goals (try right; assumption)
-- 残りの１つでは `u ≠ v` が成り立つ。
simp [hu, hv]
万能公理 SorryAx
sorryAx は、sorry タクティクを使用したときに使用される公理です。どんな命題でも証明することができ、どんなデータでも構成することができる万能な公理ですが、これを使用して証明を埋めるのはもちろんズルです。
/-- Fermat の最終定理 -/
theorem flt (x y z n : Nat) : n > 2 → x ^ n + y ^ n = z ^ n → x * y * z = 0 := by
sorry
/- info: 'flt' depends on axioms: [sorryAx] -/
#print axioms flt
class
class は 型クラス(type class) を定義するためのコマンドです。型クラスを用いると、複数の型に対して定義され、型ごとに異なる実装を持つような関数を定義することができます。例えば「和を取る操作」のような、Nat や Int や Rat など複数の型に対して同じ名前で定義したい関数を作りたいとき、型クラスが適しています。
/-- 証明なしのバージョンのモノイド。
ただしモノイドとは、要素同士を「くっつける」操作ができて、
くっつけても変わらない要素があるようなもののこと。-/
class Monoid (α : Type) where
/-- 単位元 -/
e : α
/-- 二項演算 -/
op : α → α → α
/-- 自然数はモノイド -/
instance : Monoid Nat where
-- ゼロを単位元とする
e := 0
-- 加算を二項演算とする
op := Nat.add
/-- 連結リストはモノイド -/
instance {α : Type} : Monoid (List α) where
-- 空リストを単位元とする
e := []
-- リストの連結を二項演算とする
op := List.append
-- `Nat` に対してモノイドの演算が使える
#guard Monoid.op 0 0 = 0
-- `List Nat` に対してモノイドの演算が使える
#guard Monoid.op [1] [2, 3] = [1, 2, 3]
-- `Nat` に対して単位元を取得する関数が使える
#guard (Monoid.e : Nat) = 0
-- `List Int` に対しても単位元を取得する関数が使える
#guard (Monoid.e : List Int) = []
型クラス解決
型クラスが行っていることを class を使わずにDIYしてみると、型クラスの理解が深まるでしょう。class として上で定義したものを、もう一度 構造体として定義してみます。1
/-- 構造体でモノイドクラスを真似たもの -/
structure Monoid' (α : Type) where
e : α
op : α → α → α
/-- 自然数がモノイドのインスタンスであるという主張を再現したもの -/
def instMonoid'Nat : Monoid' Nat where
e := 0
op := Nat.add
このとき構造体 Monoid' のフィールド Monoid'.e は、「Monoid' の項に対して α の要素を返す」関数なので、次のような型を持ちます。
#check (Monoid'.e : {α : Type} → (self : Monoid' α) → α)
self : Monoid' α が暗黙の引数ではなく明示的な引数なので、型クラスのように書くことはできません。
#check_failure (Monoid'.e : Nat)
しかし、インスタンスを引数として渡せば、型クラスのように Nat の要素を取り出すことができます。
#check (Monoid'.e instMonoid'Nat : Nat)
構造体による模倣と本物の型クラスの違いがどこにあるのかおわかりいただけたでしょうか。最大の違いは、引数の instMonoid'Nat が省略できるかどうかです。
ここで(本物の)型クラスにおける単位元関数 e の型を調べてみると、self : Monoid' α が角括弧 [ .. ] で囲われていることがわかります。
#check (Monoid.e : {α : Type} → [_self : Monoid α] → α)
これは インスタンス暗黙引数(instance implicit) と呼ばれるもので、この場合 Lean に対して Monoid' α 型の項を自動的に合成するよう指示することを意味します。また、型クラスのインスタンス暗黙引数を自動的に合成する手続きのことを、 型クラス解決(type class resolution) と呼びます。
outParam
概要
足し算を表現する型クラスを自分で定義してみましょう。名前は Plus としてみます。足し算は自然数の和 Nat → Nat → Nat のように、同じ型の中で完結する操作として定義されることが多いものですが、より一般的に α → β → γ で定義されるものとしてみます。
/-- 自前で定義した足し算記法のためのクラス -/
class Plus (α β γ : Type) where
plus : α → β → γ
-- 足し算記法を定義
-- ライブラリにある足し算記号と被るのを避けるため変な記号にしておく
scoped infixl:65 " +ₚ " => Plus.plus
-- 自然数と自然数のリストとの足し算を定義
instance : Plus Nat (List Nat) (List Nat) where
plus n ns := List.map (fun x => n + x) ns
-- 定義した記号が使えるようになった
#check 1 +ₚ [1, 2]
この定義は上手くいっているように見えますが、返り値の型である γ を指定しないと #eval で式の値が評価できないという問題があります。
-- メタ変数の番号を表示しない
set_option pp.mvars false
-- 返り値の型がわからないので型クラス解決ができないというエラーが出ている
/-
error: failed to synthesize instance of type class
Plus Nat (List Nat) (IO ?_)
Hint: Type class instance resolution failures can be inspected with the `set_option trace.Meta.synthInstance true` command.
-/
#eval 1 +ₚ [1, 2]
-- 返り値の型を教えると評価できる
#eval (1 +ₚ [1, 2] : List Nat)
ここで最初の Plus の定義を書き換え、返り値の型を outParam で修飾すると、上手くいくようになります。これは、γ が未知の状態でも型クラス解決を行うようになるためです。
-- `γ` の型 `Type` を `outParam` で包んで注釈する
class Plus (α β : Type) (γ : outParam Type) where
plus : α → β → γ
scoped infixl:65 " +ₚ " => Plus.plus
instance : Plus Nat (List Nat) (List Nat) where
plus n ns := List.map (fun x => n + x) ns
-- 返り値の型を教えなくても評価できるようになった！
#eval 1 +ₚ [1, 2]
使用例: カリー化の計算
outParam の使用例として、多引数関数のカリー化を計算する型クラスを定義する例を紹介します。
なおこの例ではインスタンス優先度(priority := low という指定の部分)も使用していますが、それについては instance のページを参照してください。
/-- 多引数関数の「カリー化」を表現する型クラス -/
class Curry (Xs Y : Type) (F : outParam Type) where
/-- `Xs → Y` 型の関数を、「カリー化」された形 `F` に変換する。 -/
curry : (Xs → Y) → F
-- `curry` という関数名を名前空間の指定なしで直接使えるようにする
export Curry (curry)
variable {X Y Xs F : Type}
/-- ベースケース: `Xs` が単一引数 `X` のとき、`F = X → Y` としてそのまま返す。
より具体的なインスタンスが優先されるように、`priority := low` を指定している。
-/
instance (priority := low) : Curry X Y (X → Y) where
curry := id
/-- 再帰ケース: `f : (X × Xs) → Y` をカリー化して `curry f : X → Xs → Y` という関数を得る。
`x : X` が与えられたとき、部分適用 `f (x, ·) : Xs → Y` を帰納的にカリー化して返す。-/
instance [Curry Xs Y F] : Curry (X × Xs) Y (X → F) where
curry := fun f x => curry (fun xs => f (x, xs))
-- 動作テスト
example : curry (fun a : Nat => a) = (fun a => a) := rfl
example : curry (fun ((a, b) : Nat × Nat) => a + b) = (fun a b => a + b) := rfl
example :
let actual := curry fun ((a, b, c) : Nat × Nat × Nat) => a + b + c
let expected := fun a b c => a + b + c
actual = expected := rfl
使用例: アンカリー化の計算
アンカリー化（カリー化の逆の操作）も同様に計算することができます。
/-- アンカリー化を計算する型クラス。
`f : F` を `uncurry f : Xs → Y` に変換する。-/
class Uncurry (F : Type) (Xs Y : outParam Type) where
uncurry : F → Xs → Y
-- `Uncurry.uncurry` の代わりに `uncurry` と直接書けるようにエクスポートしておく
export Uncurry (uncurry)
variable {X Y Xs F : Type}
/-- ベースケース:
`f : X → Y` をアンカリー化しても何も変わらない。
ただし、より具体的なインスタンスが利用できる場面で
このインスタンスが使用されないように `priority` を低く設定している -/
instance (priority := low) : Uncurry (X → Y) X Y where
uncurry := id
/-- 帰納ケース:
`f : F` をアンカリー化して `uncurry f : Xs → Y` を得ることができるとする。
このとき `g : X → F` をアンカリー化して `uncurry g : X × Xs → Y` を得ることができる。-/
instance [Uncurry F Xs Y] : Uncurry (X → F) (X × Xs) Y where
uncurry := fun f (x, xs) => uncurry (f x) xs
-- 動作テスト
example : uncurry (fun a : Nat => a) = (fun a => a) := rfl
example : uncurry (fun a b : Nat => a + b) = (fun (a, b) => a + b) := by rfl
example :
let actual := uncurry (fun a b c : Nat => a + b + c)
let expected := (fun (a, b, c) => a + b + c)
actual = expected := by rfl
class inductive
基本的に型クラスの下部構造は構造体ですが、一般の帰納型を型クラスにすることも可能です。それには class inductive というコマンドを使います。
/-- 全単射があるという同値関係 -/
structure Equiv (α : Type) (β : Type) where
toFun : α → β
invFun : β → α
left_inv : invFun ∘ toFun = id
right_inv : toFun ∘ invFun = id
@[inherit_doc] infixl:25 " ≃ " => Equiv
/-- その型の濃度を知っていることを意味する型クラス。
証明無関係の制約により、返り値の型を Prop にしてはいけない。-/
class inductive HasCardinal (X : Type) : Type where
/-- 有限集合は濃度が計算できる -/
| finite (n : Nat) (f : X ≃ Fin n)
/-- 可算無限集合は濃度が計算できる -/
| countable (f : X ≃ Nat)
/-- Bool の濃度は計算できる -/
instance : HasCardinal Bool := by
apply HasCardinal.finite (n := 2)
constructor
-- Bool → Fin 2 を作る
case toFun => exact (fun b => if b then 1 else 0)
-- Fin 2 → Bool を作る
case invFun => exact (fun ⟨x, _⟩ => x == 1)
-- invFun ∘ toFun は Bool 上の恒等関数
case left_inv =>
ext b
cases b <;> simp
-- toFun ∘ invFun は Fin 2 上の恒等関数
case right_inv =>
ext ⟨x, h⟩
simp only [Fin.isValue, Function.comp_apply, beq_iff_eq, id_eq]
match x with
| 0 => simp
| 1 => simp
/-- 可算無限までしかない順序数もどき -/
inductive Ordinal : Type where
| nat (n : Nat)
| omega
deriving DecidableEq
def Ordinal.toString : Ordinal → String
| Ordinal.nat n => ToString.toString n
| Ordinal.omega => "ω"
instance : ToString Ordinal := ⟨Ordinal.toString⟩
/-- X の濃度が計算できる場合、X の濃度を返す関数 -/
def HasCardinal.card (X : Type) [h : HasCardinal X] : Ordinal :=
match h with
| finite n _ => Ordinal.nat n
| countable _ => Ordinal.omega
-- 単に card という名前でアクセスできるようにする
export HasCardinal (card)
-- Bool の濃度が計算できた
#guard card Bool = Ordinal.nat 2
-
この説明は Mathematics in Leanを参考にしています。 ↩
declare_aesop_rule_sets
declare_aesop_rule_sets コマンドは、aesop タクティクで使用させるための特定のルールセットを宣言します。
Warning
このページの内容は ボタンから Lean 4 Web で実行することができません。
基本的な使い方
declare_aesop_rule_sets で宣言されたルールセットは、宣言したそのファイルの中では有効になりません。import する必要があります。前提として以下の内容のファイルを import しているとしましょう。
-- import されているファイルの内容
import Aesop
declare_aesop_rule_sets [HogeRules]
このとき、以下のように aesop の rule_sets に HogeRules を渡すことで、HogeRules に登録されたルールセットを使用することができます。
import LeanByExample.Declarative.DeclareAesopRuleSets.Lib -- インポートで有効になる
example : True := by
aesop (rule_sets := [HogeRules])
タクティク作成
このコマンドの主な用途は、aesop をカスタマイズして aesop と同じように使えるタクティクを自作することです。特定のルールセットに対して登録されたルールは単に aesop を実行しただけでは適用されないので、用途ごとにタクティクを分けることができるという理屈です。
たとえば、macro コマンドを使ったシンプルな方法で、aesop が持つデフォルトのルールセットはそのままにaesop をベースに新たに hoge というタクティクを作ることができます。
/-- aesop ラッパー -/
macro "hoge" : tactic => do `(tactic| aesop (rule_sets := [HogeRules]))
example : True := by
hoge
aesop? と同等の機能も、同じようにして実現することができます。
/-- `hoge` が使用したルールを生成する -/
macro "hoge?" : tactic => `(tactic| aesop? (rule_sets := [HogeRules]))
/-
info: Try this:
[apply] simp_all only
-/
example : True := by
hoge?
hoge タクティク用のルールを登録することもできます。
[aesop] 属性と同等の機能を持つ [hoge] 属性を作成したい場合は、たとえば次のようにします。
/-- `hoge` タクティク用のルールを追加する -/
macro "hoge" e:Aesop.rule_expr : attr =>
`(attr| aesop (rule_sets := [HogeRules]) $e)
/-- `True` を模して自作した命題 -/
inductive MyTrue : Prop where
| intro
example : MyTrue := by
-- 最初は証明できない
fail_if_success hoge
apply MyTrue.intro
attribute [local hoge safe constructors] MyTrue
example : MyTrue := by
-- `hoge` で証明できるようになった！
hoge
example : MyTrue := by
-- 依然として `aesop` では証明できない
fail_if_success aesop
apply MyTrue.intro
add_aesop_rules コマンドと同様の機能を持つ add_hoge_rules コマンドを作成したい場合は、たとえば次のようにします。
/-- `hoge` タクティク用のルールを追加する -/
macro attrKind:attrKind "add_hoge_rules" e:Aesop.rule_expr : command =>
`(command| $attrKind:attrKind add_aesop_rules (rule_sets := [HogeRules]) $e)
/-- `True` を模して自作した命題 -/
inductive MyTrue : Prop where
| intro
example : MyTrue := by
-- 最初は証明できない
fail_if_success hoge
apply MyTrue.intro
-- `MyTrue` に関するルールを `hoge` に登録する
local add_hoge_rules safe constructors [MyTrue]
example : MyTrue := by
-- `hoge` で証明できるようになった!
hoge
example : MyTrue := by
-- 依然として `aesop` では証明できない
fail_if_success aesop
apply MyTrue.intro
declare_syntax_cat
declare_syntax_cat コマンドは、新しい構文カテゴリを宣言するためのコマンドです。構文カテゴリを宣言することで、宣言した構文を再利用可能にして冗長な構文宣言を減らすことができます。
例として、集合の内包表記 {x : T | P x} を定義するコードを示します。
/-- `α` を全体集合とする部分集合の全体 -/
def Set (α : Type u) := α → Prop
variable {α : Type u}
/-- 項 `x : α` が `X : Set α` に属する -/
def Set.mem (X : Set α) (x : α) : Prop := X x
/-- `x ∈ X` と書けるようにする -/
instance : Membership α (Set α) where
mem := Set.mem
/-- 述語 `p : α → Prop` から構成される集合 -/
def setOf (p : α → Prop) : Set α := p
/-- binder という構文カテゴリ。
これは変数束縛を表していて、
`{x : X | P x}` の `x : X` の部分とか
`{x ∈ X | P x}` の `x ∈ X` の部分とかを表している -/
declare_syntax_cat binder
/-- `{x : T | P x}` の `: T` の部分。
あってもなくても良いので `( )?` で囲う -/
syntax ident (" : " term)? : binder
/-- `{x ∈ T | P x}` の `∈ T` の部分。
あってもなくても良いので `( )?` で囲う -/
syntax ident (" ∈ " term)? : binder
/-- 集合の内包表記 -/
syntax "{" binder "|" term "}" : term
-- 合法な構文として認識される
-- 実装は与えていないのでエラーにはなる
#check_failure { x | x = 0}
#check_failure { x : Nat | x > 0 }
#check_failure { x ∈ T | x = 0}
/-- `{x : T | P x}` と `{x ∈ T | P x}` の形の式を `setOf` の式に変換する -/
macro_rules
| `({ $var:ident | $body:term }) => `(setOf (fun $var => $body))
| `({ $var:ident : $ty:term | $body:term }) => `(setOf (fun ($var : $ty) => $body))
| `({ $var:ident ∈ $s:term | $body:term }) => `(setOf (fun $var => $var ∈ $s ∧ $body))
-- 内包表記が使えるようになった
#check { x : Nat | x > 0 }
#check
let Even := { x : Nat | x % 2 = 0 }
{ x ∈ Even | x > 0 }
def
def は、関数や定数など、グローバルに項を定義するための基本的なコマンドです。
/-- 1を足す関数 -/
def addOne (n : Nat) : Nat := n + 1
-- 関数だけでなく定数も定義できる
def foo := "hello"
構文ルール
def は以下のような構文ルールを持ちます。
defの後に関数名・定数名を書きます。- 関数名の後に引数を指定します。引数なしだと定数になります。
- 引数の後に
:によって返り値の型を指定します。返り値の値が関数本体などから推論できる場合は省略できます。 :=の後に関数の本体を書きます。
なお theorem コマンドも同様の構文ルールを持ちます。
再帰関数
再帰関数も同様の構文で定義することができます。
/-- 階乗関数 -/
def factorial (n : Nat) : Nat :=
match n with
| 0 => 1
| n + 1 => (n + 1) * factorial n
#guard factorial 7 = 5040
このとき、裏で Lean は再帰関数が停止することの証明を生成しようとし、証明が失敗するとエラーになります。これについて詳しくは以下のページを参照してください。
引数の指定
関数を定義するとき、隣接する同じ型の引数に対しては : を使いまわすことができます。
def add (n m : Nat) : Nat := n + m
def threeAdd (n m l : Nat) : Nat := n + m + l
また丸括弧 () ではなくて波括弧で引数を指定すると、その引数は暗黙の引数になり、Lean が推論して埋めてくれるようになります。
/-- リストの長さを返す -/
def List.myLength {α : Type} (xs : List α) : Nat :=
match xs with
| [] => 0
| _ :: xs => 1 + myLength xs
-- `α` を引数として与えなくても呼び出すことができる
#guard List.myLength [1, 2, 3] = 3
名前付き引数
通常は引数をスペース区切りで渡しますが、それだと引数を埋める順番が固定されます。引数の名前を指定して値を渡すこともできて、そうすれば引数の順番を気にする必要はありません。これを 名前付き引数(named arguments) といいます。
/-- a に 10 を掛けてから b を足す -/
def addAndMul (a b : Int) : Int :=
10 * a + b
-- 何も指定しないと a, b の順番で引数を渡すことになる
#guard addAndMul 3 2 == 32
-- 引数名を指定して渡すと、引数を好きな順番で渡せる
#guard addAndMul (b := 3) (a := 2) == 23
引数のデフォルト値
関数の引数には、デフォルト値を設定することができます。デフォルト値を設定すると、引数を省略して呼び出したときにその値が自動的に使われます。
/-- `name` から挨拶文を生成する -/
def greetWithDefault (name : String) (punct := "!") : String :=
name ++ "さん、こんにちは" ++ punct
-- `punct` を省略しているが、デフォルトの `!` が使われている
#guard greetWithDefault "山本" == "山本さん、こんにちは!"
明示的に指定したくなった場合は、名前付き引数として渡します。
#guard greetWithDefault "山本" (punct := "!!!") == "山本さん、こんにちは!!!"
deriving
deriving は、型クラスのインスタンスを自動的に生成します。
以下に示すように、deriving instance C for T とすると型 T に対して型クラス C のインスタンスを生成します。
inductive Color : Type where
| red
| green
| blue
-- 暗黙的に Repr インスタンスを生成しない
set_option eval.derive.repr false
-- `Repr` が定義されていないので `eval` できない
/-
error: could not synthesize a `Repr` or `ToString` instance for type
Color
-/
#eval Color.red
-- インスタンス生成
deriving instance Repr for Color
-- `eval` できるようになった
#eval Color.red
deriving 句
対象の型の直後であれば、省略して deriving C だけ書けば十分です。
def StrList := List String deriving Inhabited
#check (default : StrList)
また複数の型クラスに対してインスタンスを生成するには、クラス名をカンマで続けます。
structure People where
name : String
age : Nat
deriving Inhabited, Repr
-- 両方のインスタンスが生成されている
#eval (default : People)
よくあるエラー
なお、deriving で実装を生成できるのは、DerivingHandler が登録されていて実装方法が用意されている型クラスのみです。実装方法が指定されていなければ使うことはできません。
/-- 自前で定義した型クラス -/
class Callable (α : Type) where
call : α → String
/- error: No deriving handlers have been implemented for class `Callable` -/
deriving instance Callable for People
例外として、定義を展開して既存のインスタンスが見つかる場合は deriving が通ります。
/-- 適当に定義した自前の型クラス -/
class Foo (α : Type) where
foo : Unit
/-- String の Foo インスタンスを定義する -/
instance : Foo String where
foo := ()
-- `Foo` の deriving handler は作っていないが、String と bar は同じなので
-- String のインスタンスが使用される
def bar := String deriving Foo
-- String のインスタンスが使われている
#guard Foo.foo bar = ()
dsimproc
dsimproc は、simproc を宣言するためのコマンドの一つです。
simproc は、ある式 expr にマッチする部分を見つけたときに、より単純な式 result を動的に計算し、expr = result の証明も同時に構成するような、simp タクティクから呼び出される書き換え規則のことです。
dsimproc は simproc を定義するものですが、定義的に等しい(definitionally equal) 変形だけを行います。
したがって、expr = result の証明が不要です。(rfl を使うだけで済むので)
以下は、具体的な数値に対する関数呼び出しを計算して単純化するようなシンプルな simproc を定義する例です。
import Lean
def Nat.fib (n : Nat) : Nat :=
match n with
| 0 => 0
| 1 => 1
| n + 2 => fib (n + 1) + fib n
example (P : Nat → Prop) (h : P (Nat.fib 5)) : P 5 := by
-- 最初は simp が使えない
fail_if_success simp at h
have : Nat.fib 5 = 5 := by rfl
simp [this] at h
assumption
dsimproc computeFib (Nat.fib _) := fun e => do
-- パターンマッチ。`e : Expr` が `Nat.fib n` の形であることを確認する
-- そうでなければ即終了する
let_expr Nat.fib m ← e
| return .continue
-- `m` が自然数リテラルであることを確認する
-- もしそうでなければ即終了する
let some n := m.nat?
| return .continue
-- `Nat.fib n` を評価する
let l := Nat.fib n
return .visit <| Lean.toExpr l
-- 単純化をやってくれる
example (P : Nat → Prop) (h : P (Nat.fib 5)) : P 5 := by
dsimp at h
assumption
example (P : Nat → Prop) (h : P (Nat.fib 5)) : P 5 := by
-- `simp_all`からも呼び出される
simp_all
用途
simp 補題による書き換えでは無数に多くの補題を必要としそうな場合であっても、simproc を使うことで綺麗に解決できることがあります。1
open Lean Meta Qq in
/-- 数値リテラル `n` を `1 + 1 + ⋯ + 1` という形に展開する
**注意**: このsimprocが常に適用されると困るので、実際には`dsimproc_decl`を使った方が良い。
-/
dsimproc unfoldNat ((_)) := fun e => do
-- 自然数リテラルでなければ即終了する
let_expr OfNat.ofNat _ num inst := e
| return .continue
let some n := num.rawNatLit?
| return .continue
-- その自然数リテラルが自然数を表しているのでなければ即終了する
let num : Q(Nat) := num
unless ← isDefEq inst q(instOfNatNat $num) do
return .continue
-- `1 + 1 + ⋯ + 1` の形に展開する
let mut result : Q(Nat) := q(1)
let mut n := n
while n > 1 do
result := q($result + 1)
n := n - 1
return .done result
example (a : Nat) : 3 * a = 1 * a + 2 * a := by
dsimp only [unfoldNat]
guard_target =ₛ (1 + 1 + 1) * a = 1 * a + (1 + 1) * a
grind
example (a : Nat) : (2 : Int) * a = a + a := by
-- 自然数を表す自然数リテラルは存在しないので失敗する
fail_if_success dsimp only [unfoldNat]
grind
-
このコード例は、Robin Arnez さんに教えていただいたものを参考にしています。 ↩
elab
elab コマンドは、構文とその解釈を同時に定義するためのコマンドです。マクロと似ていますが、マクロとは違ってコードの置換ではなく手続き的な処理に向いています。このコマンドを使うと、コマンドやタクティクや項エラボレータを手軽に定義することができます。
より詳しく書くと、elab コマンドは構文とそのエラボレータを同時に定義するためのコマンドです。ただしエラボレータとは、おおざっぱに言えば Syntax を Expr に変換する処理のことです。
使用例
タクティク
elab コマンドを使わずにタクティクを定義しようとすると、以下の手続きを踏む必要があります。
import Lean
/-- 挨拶をするだけのタクティク -/
syntax (name := greetStx) "greet₁" : tactic
open Lean Elab Tactic in
@[tactic greetStx]
def evalGreet : Tactic := fun _ =>
logInfo "Hello, world!"
/- info: Hello, world! -/
example : True := by
greet₁
trivial
elab コマンドを使用すると、これらを一括で行うことができます。
open Lean Elab Tactic in
elab "greet₂" : tactic =>
logInfo "Hello, world!"
/- info: Hello, world! -/
example : True := by
greet₂
trivial
コマンド
elab コマンドを使わずにコマンドを定義しようとすると、以下の手続きを踏む必要があります。
- 構文を定義する。
CommandElab型の関数を定義する。- 構文と実装を
[command_elab]属性で結びつける。
/-- 挨拶をするだけのコマンド -/
syntax (name := greetCmdStx) "#greet₁" : command
open Lean Elab Command in
@[command_elab greetCmdStx]
def evalGreetCmd : CommandElab := fun _ =>
logInfo "Hello, world!"
/- info: Hello, world! -/
#greet₁
elab コマンドを使用すると、これらを一括で行うことができます。
open Lean Elab Command in
elab "#greet₂" : command =>
logInfo "Hello, world!"
/- info: Hello, world! -/
#greet₂
項エラボレータ
elab コマンドを使わずに項エラボレータを定義しようとすると、以下の手続きを踏む必要があります。
- 構文を定義する。
TermElab型の関数を定義する。- 構文と実装を
[term_elab]属性で結びつける。
syntax (name := greetTermStx) "<<" "greet₁" ">>" : term
open Lean Elab Term in
@[term_elab greetTermStx]
def evalGreetTerm : TermElab := fun _ _ => do
return (toExpr "hello world")
/- info: "hello world" -/
#eval << greet₁ >>
elab コマンドを使用すると、これらを一括で行うことができます。
open Lean Elab Term in
elab "<<" "greet₂" ">>" : term =>
return (toExpr "hello world")
/- info: "hello world" -/
#eval << greet₂ >>
example
example は名前を付けずに命題の証明をすることができるコマンドです。
-- `1 + 1 = 2` は `rfl` で証明できる
example : 1 + 1 = 2 := rfl
-- `n + 0 = n` は `rfl` で証明できる
example {n : Nat} : n + 0 = n := rfl
より正確には、example : T := t は t が型 T を持っていることを確かめます。特に T の型が Prop であるときには、最初に述べた通り t は T の証明だとみなすことができます。
-- `[1, 2, 3]` は `List Nat` 型の項
example : List Nat := [1, 2, 3]
-- `#[1, 2, 3]` は `Array Nat` 型の項
example : Array Nat := #[1, 2, 3]
-- `true` は `Bool` 型の項
example : Bool := true
export
export コマンドは、他の名前空間から定義を現在の名前空間に追加します。
具体的には、Some.Namespace の配下に nameᵢ がある状態で export Some.Namespace (name₁ name₂ ...) を実行することにより、以下の両方の処理が行われます。
openと同様に、nameᵢがSome.Namespaceの接頭辞なしで現在の名前空間N上で見えるようになります。- 現在の名前空間
Nの外部の名前空間からN.nameᵢとしてアクセスできるようになります。
namespace N -- export コマンドが実行される名前空間
inductive Sample : Type where
| foo
| bar
| baz
-- foo は名前空間 Sample 上にあるので、
-- 短い名前ではアクセスできない
#check_failure foo
#check Sample.foo
-- foo を現在の名前空間 N に追加する
export N.Sample (foo)
-- 短い名前でもアクセス可能になった
#check foo
end N
-- 名前空間 `N` の外部からアクセスするには、
-- 普通はフルネームが必要
#check_failure N.bar
#check N.Sample.bar
-- しかし foo は名前空間 N の内部で export されているので、
-- N を指定するだけでアクセス可能
#check N.foo
grind_pattern
grind_pattern コマンドは、定理を grind タクティクに再利用させるためのパターンを指定するコマンドです。
/-- 何らかの二項関係 -/
opaque R : Nat → Nat → Prop
/-- R は推移的 -/
axiom Rtrans {x y z : Nat} : R x y → R y z → R x z
-- ローカルコンテキストに `R x y` と `R y z` が現れたとき、
-- `Rtrans` をインスタンス化しなさいと grind に指示している
grind_pattern Rtrans => R x y, R y z
example (x y z : Nat) (h₁ : R x y) (h₂ : R y z) : R x z := by
-- grind で証明できる
grind
[grind] 属性では登録できない例
多くの場合、わざわざ grind_pattern コマンドでパターンを手動指定しなくても [grind] 属性にパターンを自動で推測させることができますが、自動推測に失敗することがあります。このような場合は grind_pattern コマンドでパターンを明示する必要があります。
variable {α : Type}
/-- 二項関係 `R` がリストの隣接要素に対して成立するという述語。 -/
inductive IsChain (R : α → α → Prop) : List α → Prop
| nil : IsChain R []
| single (a : α) : IsChain R [a]
| cons_cons {a b : α} {l : List α} (hab : R a b) (hchain : IsChain R (b :: l)) :
IsChain R (a :: b :: l)
attribute [grind cases] IsChain
attribute [simp] IsChain.nil IsChain.single
attribute [grind <=] IsChain.cons_cons IsChain.single IsChain.nil
variable {R : α → α → Prop}
/-- リストの最後の要素を取得する。 -/
@[simp]
def last? (xs : List α) : Option α :=
match xs with
| [] => none
| [a] => some a
| _ :: b :: bs => last? (b :: bs)
theorem last?_cons_exists (xs : List α) (x : α) :
∃ y : α, some y = last? (x :: xs) := by
induction xs generalizing x with simp_all
-- `[grind]` 属性は、登録すべきパターンを見つけられない。
/-
error: invalid `grind` theorem, failed to find an usable pattern using different modifiers
-/
attribute [grind] last?_cons_exists
-- `grind_pattern` コマンドなら、`last? (x :: xs)` を見たときに
-- `last?_cons_exists` を使うよう明示的に指定できる。
grind_pattern last?_cons_exists => last? (x :: xs)
@[grind =]
theorem IsChain.append {xs ys : List α} :
IsChain R (xs ++ ys) ↔
match last? xs, ys with
| none, _ => IsChain R ys
| _, [] => IsChain R xs
| some x, b :: _ => IsChain R xs ∧ R x b ∧ IsChain R ys := by
fun_induction last? xs with grind
ワイルドカード
パターンの中でワイルドカード _ を使用することができます。この機能は、条件を厳しすぎず緩すぎない、ちょうどよい強さに調整するのに役立ちます。
/-- 何らかの関数 -/
opaque f : Nat → Nat
/-- f は単調増加 -/
axiom f_monotone {a b : Nat} (h : a ≤ b) : f a ≤ f b
section Part1
/- ## 厳しすぎるパターン指定の例 -/
grind_pattern f_monotone => f a, f b, f a ≤ f b
example (a b : Nat) (h : a ≤ b) : f a ≤ f b := by
-- grind の中の前処理等で `f a ≤ f b` の形が崩れるため、
-- grind が `f a ≤ f b` のパターンを見つけられない。
-- そのため grind で証明できない
fail_if_success grind
apply f_monotone <;> assumption
end Part1
section Part2
/- ## ワイルドカードでパターンを緩める例 -/
grind_pattern f_monotone => f a, f b, f _ ≤ f _
example (a b : Nat) (h : a ≤ b) : f a ≤ f b := by
-- grind で証明できるようになった！
grind
end Part2
where による制御
grind_pattern コマンドは、grind タクティクに定理を再利用させることができるという点では [grind] 属性とできることが同じですが、grind_pattern コマンドの方がより細かい制御を行えます。
典型的な例として、grind_pattern コマンドでは where で制約を追加することができ、不要なインスタンスが暴発することを防ぐことができます。
=/= 制約
=/= 制約を追加すると、両辺が 定義的に等しい(definitionally equal) かどうかの場合分けが追加され、等しくない場合のみ定理がインスタンス化されるようになります。
variable {α : Type} [Mul α] [One α]
/-- リストの積 -/
@[grind =]
def List.myprod (xs : List α) : α :=
xs.foldr (· * ·) 1
-- 注意: 既に定義されているものが存在する
#check List.prod
-- α がモノイドという仮定を足す
variable [@Std.LawfulIdentity α (· * ·) 1]
variable [@Std.Associative α (· * ·)]
@[simp, grind =]
theorem List.myprod_cons (x : α) (xs : List α) :
(x :: xs).myprod = x * xs.myprod := by
grind
theorem List.myprod_append (xs ys : List α) :
(xs ++ ys).myprod = xs.myprod * ys.myprod := by
induction xs with
| nil => grind
| cons x xs ih =>
simp_all [Std.Associative.assoc]
section
-- 単に「左辺を見つけたらインスタンス化」というルールにすると...
local grind_pattern List.myprod_append => (xs ++ ys).myprod
/-
trace: [grind.ematch.instance] List.myprod.eq_1: ([] ++ []).myprod = List.foldr (fun x1 x2 => x1 * x2) 1 ([] ++ [])
[grind.ematch.instance] List.myprod_append: ([] ++ []).myprod = [].myprod * [].myprod
[grind.ematch.instance] List.append_nil: [] ++ [] = []
[grind.ematch.instance] List.nil_append: [] ++ [] = []
[grind.ematch.instance] List.foldr_append: List.foldr (fun x1 x2 => x1 * x2) 1 ([] ++ []) =
List.foldr (fun x1 x2 => x1 * x2) (List.foldr (fun x1 x2 => x1 * x2) 1 []) []
[grind.ematch.instance] List.foldr_nil: List.foldr (fun x1 x2 => x1 * x2) 1 [] = 1
-/
example : ([] ++ []).myprod = 1 := by
-- `[] ++ []` に対しても暴発して余計なインスタンス化が実行される
set_option trace.grind.ematch.instance true in
grind
end
-- `=/=` 制約を追加して、空リストが混ざっているときはインスタンス化しないように指示
grind_pattern List.myprod_append => (xs ++ ys).myprod where
xs =/= []
ys =/= []
/-
trace: [grind.ematch.instance] List.myprod.eq_1: ([] ++ []).myprod = List.foldr (fun x1 x2 => x1 * x2) 1 ([] ++ [])
[grind.ematch.instance] List.append_nil: [] ++ [] = []
[grind.ematch.instance] List.nil_append: [] ++ [] = []
[grind.ematch.instance] List.foldr_append: List.foldr (fun x1 x2 => x1 * x2) 1 ([] ++ []) =
List.foldr (fun x1 x2 => x1 * x2) (List.foldr (fun x1 x2 => x1 * x2) 1 []) []
[grind.ematch.instance] List.foldr_nil: List.foldr (fun x1 x2 => x1 * x2) 1 [] = 1
-/
example : ([] ++ []).myprod = 1 := by
-- `[] ++ []` に対して暴発しなくなる
set_option trace.grind.ematch.instance true in
grind
guard 制約
guard 制約を追加すると、与えられた条件が成り立つときにだけ定理がインスタンス化されるようになります。
grind_pattern コマンドでは様々なパターンが登録できるのですが、等式を登録することはできません。
したがって A = B が成り立つときにインスタンス化してほしい定理がある場合は、guard 制約を追加するのが良いでしょう。
theorem Nat.zero_of_divide_lt_right {a b c : Nat} (hac : c < a) (h : a * b = c) :
b = 0 ∧ c = 0 := by
cases b with grind
-- invalid pattern というエラーになり、登録できない
-- これは等式をパターンとして登録しようとしたため
/-
error: invalid pattern, (non-forbidden) application expected
@Eq (Nat) (@HMul.hMul (Nat) (Nat) (Nat) (@instHMul (Nat) (instMulNat)) #4 #3) #2
-/
grind_pattern Nat.zero_of_divide_lt_right => c < a, a * b = c
-- 等式を避ければパターンとして登録できる
grind_pattern Nat.zero_of_divide_lt_right => c < a, a * b where
guard a * b = c
/-- 割り算と剰余の定理の、一意性パート -/
theorem Int.division_with_remainder_unique {a b q r q' r' : Int} (hb : 0 < b)
(h : a = b * q + r) (hr : 0 ≤ r) (hrb : r < b)
(h' : a = b * q' + r') (hr' : 0 ≤ r') (hrb' : r' < b) :
q = q' ∧ r = r' := by
-- 両辺引いて、以下の等式を得る。
have h_abs_eq : b.natAbs * (q - q').natAbs = (r' - r).natAbs := by
grind only [natAbs_eq_iff_mul_eq_zero]
-- `0 ≤ r < b` と `0 ≤ r' < b` から、`|r' - r| < b` が成り立つ
have : (r' - r).natAbs < b.natAbs := by grind
-- `0 < b` と `|r' - r| < b` から、`q - q' = 0` が成り立つ
have : (q - q').natAbs = 0 := by
-- ここで grind_pattern で登録した上記の定理を使用している
grind only [usr Nat.zero_of_divide_lt_right]
have q_eq_q' : q - q' = 0 := by grind
-- さらに `r = a - b * q` と `r' = a - b * q'` より `r = r'` が成り立つ。
have r_eq_r' : r = r' := by
grind
grind only
また、不等式 A ≤ B 等はパターンとしては登録できるのですが、動作が不安定になるためお勧めできません。なるべく guard 制約などとして扱うことが望ましいでしょう。
-- 整数全体を表す記号
notation:max "ℤ" => Int
/-- 絶対値。値は整数(自然数ではない) -/
def Int.abs (a : ℤ) : ℤ := max a (- a)
@[inherit_doc]
notation:max "|" a "|" => Int.abs a
/-- 0 以上の数については、絶対値は元の数に等しい -/
theorem Int.abs_of_nonneg {a : ℤ} (ha : 0 ≤ a) : |a| = a := by
grind only [abs, = Int.max_def]
section
-- `0 ≤ a` を探索パターンとして登録してみると
local grind_pattern Int.abs_of_nonneg => |a|, 0 ≤ a
-- 何故か `ha : 0 ≤ a` という仮定を見つけてくれず、
-- `grind` で証明できない。
example {a : ℤ} (ha : 0 ≤ a) : |a| = a := by
fail_if_success grind
sorry
end
-- `guard` 制約としていれてやると上手く動作する
grind_pattern Int.abs_of_nonneg => |a| where
guard 0 ≤ a
example {a : ℤ} (ha : 0 ≤ a) : |a| = a := by
grind
inductive
inductive コマンドは、帰納型(inductive type) を定義することができます。
帰納型とは、Lean においてユーザが新しい型を定義するための主要な方法です。帰納型はその型の項を得るための有限個の関数（コンストラクタ）を組み合わせることによって定まります。コンストラクタがこれから定義しようとしている型自身を引数に含むことも許されるので、帰納型は再帰的な構造を持つことができます。
帰納型の例
列挙型
帰納型の最も基本的な例は、次のような列挙型です。列挙型とは、固定された値のどれかを取るような型です。
/-- 真か偽のどちらかの値をとる型 -/
inductive MyBool where
| true
| false
#check (MyBool.true : MyBool)
列挙型は、帰納型の中でもすべてのコンストラクタが引数を持たないような特別な場合といえます。
再帰的なデータ構造
一般には、帰納型のコンストラクタは引数を持つことができます。コンストラクタの引数の型が定義しようとしているその帰納型自身であっても構いません。これにより、連結リストや二分木といった再帰的な構造を持つデータ型を定義することができます。
/-- 連結リスト -/
inductive LinkedList (α : Type) where
/-- 空のリスト -/
| nil
/-- リスト `xs : LinkedList α` の先頭に `head : α` をつけたものはリスト -/
| cons (head : α) (tail : LinkedList α)
/-- 2分木 -/
inductive BinTree (α : Type) where
/-- 空の木 -/
| empty
/-- ノード `value : α` の左と右に木を付け加えたものは木 -/
| node (value : α) (left right : BinTree α)
帰納族
ある添字集合 Λ : Type の要素 λ : Λ のそれぞれに対して、型 T λ : Sort u を独立した型として定義することができます。簡単な例として、長さを型の情報として持つリストがあります。
/-- 長さを型の情報として持つリスト -/
inductive Vec (α : Type) : Nat → Type where
| nil : Vec α 0
| cons (a : α) {n : Nat} (v : Vec α n) : Vec α (n + 1)
これで帰納型の族 {Vec α 0, Vec α 1, Vec α 2, …} を定義したことになります。このように定義される帰納型の族を 帰納族(inductive family) と呼びます。
inductive コマンドはパラメータと添字(index)を区別するため、次のように書くとエラーになることに注意してください。
/-
error: Mismatched inductive type parameter in
BadVec α 0
The provided argument
0
is not definitionally equal to the expected parameter
n
Note: The value of parameter `n` must be fixed throughout the inductive declaration. Consider making this parameter an index if it must vary.
-/
inductive BadVec (α : Type) (n : Nat) : Type where
| nil : BadVec α 0
| cons (a : α) {n : Nat} (v : Vec α n) : BadVec α (n + 1)
このようにコードを書くと n はパラメータとして扱われます。パラメータは、各コンストラクタの返り値の型に一様に現れなくてはいけません。
したがって、nil の右辺には BadVec α 0 ではなく BadVec α n が来なければならないというエラーが出ているわけです。実際に、このエラーはコンストラクタの返り値の型を変更すれば消すことができます。
/-- 良くない方法でエラーを消した `BadVec` -/
inductive BadVec' (α : Type) (n : Nat) : Type where
| nil : BadVec' α n
| cons (a : α) (v : Vec α n) : BadVec' α n
#check (BadVec'.nil : BadVec' Nat 3)
しかし、元々の Vec とは似て非なるものになってしまいます。上記の BadVec' では、nil : BadVec α 0 だけでなく nil : BadVec α 1 や nil : BadVec α 2 なども存在すると宣言したことになってしまいます。
帰納的述語
inductive コマンドを使って述語を定義することもできます。すなわち、「この条件が成立するなら、この性質が成り立つ」という十分条件を網羅的に列挙することによって、ある性質を定義することができます。このようにして定義される述語のことを 帰納的述語(inductive predicate) と呼びます。
使用例: 自然数における順序関係
Lean の標準ライブラリにある簡単な例として、自然数における順序関係の定義が挙げられます。(infix コマンドは見やすくするために使用しています。)
/-- 標準ライブラリの定義を真似て構成した順序関係 -/
inductive Nat.myle (n : Nat) : Nat → Prop where
/-- 常に `n ≤ n` が成り立つ -/
| refl : myle n n
/-- `n ≤ m` ならば `n ≤ m + 1` が成り立つ -/
| step {m : Nat} : myle n m → myle n (m + 1)
@[inherit_doc] infix:50 " ≤ₘ " => Nat.myle
この場合 inductive コマンドを使用せずに、def を使って Bool 値の再帰関数として定義しても意味的に同じものができます。
/-- 自然数における順序関係を計算する関数 -/
def Nat.myble (m n : Nat) : Bool :=
match m, n with
-- 常に `0 ≤ n` が成り立つ
| 0, _ => true
-- 常に `¬ m + 1 ≤ 0` が成り立つ
| _ + 1, 0 => false
-- `m + 1 ≤ n + 1 ↔ m ≤ n` が成り立つ
| m + 1, n + 1 => Nat.myble m n
両者の違いは何でしょうか？双方にメリットとデメリットがあります。
Bool 値の再帰関数として定義するメリットとして、計算可能になることが挙げられます。再帰関数として定義されていれば #eval コマンドなど、Lean に組み込まれた機能を使って計算を行うことができます。一方で帰納的述語として定義されていると、計算をさせるための準備をこちらで行う必要があります。
-- すぐに計算できる
#guard Nat.myble 12 24
/-
error: failed to synthesize
Decidable (2 ≤ₘ 4)
Hint: Additional diagnostic information may be available using the `set_option diagnostics true` command.
-/
#eval 2 ≤ₘ 4
帰納的述語として定義するメリットとしては、たとえば証明に使う論理モデルと計算に使うモデルを分離できることがあります。計算可能でないというデメリットは Decidable クラスのインスタンスにすることで補うことができるならば、大きな問題にはならないと考えられます。計算を気にせずに証明時に楽なシンプルなモデルを採用できるのは、帰納的述語のメリットです。
-- 論理モデルに基づいて帰納法を回して証明をする例
example {m n k : Nat} (h₁ : m ≤ₘ n) (h₂ : n ≤ₘ k) : m ≤ₘ k := by
induction h₂ with
| refl => assumption
| @step l h₂ ih =>
apply Nat.myle.step (by assumption)
使用例: 回文判定
Prop 値の再帰関数として定義することと比較した、帰納的述語として定義することのメリットとして「定義における場合分けが簡潔になる」ことが挙げられます。以下は、リストが回文であることを主張する帰納的述語の例です。
variable {α : Type}
/-- 回文を表す帰納的述語 -/
@[grind]
inductive Palindrome : List α → Prop
/-- 空リストは回文 -/
| nil : Palindrome []
/-- 要素が一つだけのリストは回文 -/
| single (a : α) : Palindrome [a]
/-- 回文の両端に同じ要素を追加しても回文 -/
| sandwich {a : α} {as : List α} (ih : Palindrome as) : Palindrome ([a] ++ as ++ [a])
これと同様の定義を再帰関数によって行うことは可能ですが、sandwich のケースが少し複雑になってしまいます。これは、match 式が受け入れるパターンマッチの形式が限定されているためです。（as.revers = as で判定することもできますが、それが Palindrome と同値であることは自明ではないことです）
-- `DecidableEq` を仮定したくないので古典論理を利用する
open scoped Classical in
/-- 回文判定を行う再帰関数 -/
def isPalindrome (as : List α) : Prop :=
match as with
| [] => true
| [a] => true
| a₁ :: a₂ :: as =>
let xs := (a₂ :: as).dropLast
let x := (a₂ :: as).getLast (by simp)
if a₁ = x then
isPalindrome xs
else
false
termination_by as.length
使用例: プログラムの BigStep 意味論
帰納的述語として定義することの更なるメリットとしては、再帰が停止することを保証しなくて良いことが挙げられます。実際、帰納的述語は本質的に停止する保証がない再帰的な操作でも扱うことができます。以下は、少し複雑ですがプログラムの BigStep 意味論を表現する例です。1
/-- 変数。ここでは簡単のために、すべての文字列が変数として存在するものとする -/
abbrev Variable := String
/-- プログラムの状態。すべての変数の値を保持したもの。
ここでは簡単にするために、変数の値はすべて自然数だとしている。 -/
def State := Variable → Nat
/-- `1 + x` のような算術式。変数の値を決めるごとに値が決まる。-/
def Arith := State → Nat
/-- 抽象化された単純なプログラミング言語のプログラム -/
inductive Stmt : Type where
/-- 何もしないコマンド -/
| skip
/-- `x := a` のような代入文。-/
| assign (v : Variable) (expr : Arith)
/-- 2つのコマンドを続けて実行する。`;;` で表される。-/
| seq (S T : Stmt)
/-- while 文 -/
| whileDo (B : State → Prop) (S : Stmt)
@[inherit_doc] infix:60 ";; " => Stmt.seq
-- 技術的な理由で必要
set_option quotPrecheck false in
/-- 状態 `s : State` があったとき、変数 `x` に対してだけ値を更新したものを表す記法 -/
notation s:70 "[" x:70 "↦" n:70 "]" => (fun v ↦ if v = x then n else s v)
open Stmt
/-- プログラムの BigStep 意味論。`BigStep c s t` は、
プログラム `c` を状態 `s` の下で実行すると状態が `t` になって停止することを表す。
-/
inductive BigStep : Stmt → State → State → Prop where
/-- skip コマンドの意味論。-/
| skip (s : State) : BigStep skip s s
/-- 代入文 `x := a` の実行前に状態が `s` であったなら、
代入文の実行後には状態は変数 `x` についてだけ更新される。-/
| assign (x : Variable) (a : State → Nat) (s : State) :
BigStep (assign x a) s (s[x ↦ a s])
/-- seq コマンドの意味論。-/
| seq {S T : Stmt} {s t u : State} (hS : BigStep S s t) (hT : BigStep T t u) :
BigStep (S;; T) s u
/-- while 文の、条件式が真のときの意味論。
`whileDo B S` は、開始時に `B` が成り立っているなら、
`S` を実行してから `whileDo B S` を実行するのと同じ意味になる。-/
| while_true {B S s t u} (hcond : B s) (hbody : BigStep S s t)
(hrest : BigStep (whileDo B S) t u) : BigStep (whileDo B S) s u
/-- while 文の、条件式が偽のときの意味論。-/
| while_false {B S s} (hcond : ¬ B s) : BigStep (whileDo B S) s s
「プログラムを評価する」という操作は while 文の評価が終わらない可能性があるため、証明可能な再帰関数として定義することができません。そのため上記の BigStep 意味論の例は帰納的述語が真に有用なケースであるといえます。
使用例: 反射的閉包
型 α 上の二項関係 R : α → α → Prop が与えられたとします。このとき、R が反射的であるとは、∀ x, R x x が成り立つことを意味します。典型的な例として、等号 = や不等号 ≤ は反射的です。
一般の二項関係は反射的とは限りませんが、任意の二項関係 R に対して、R を含むような最小の反射的な二項関係が存在します。これを R の 反射的閉包 と呼びます。ここでは仮に、R の反射的閉包を #R と書くことにします。ただし、二項関係 R と S に対して、S が R を含むとは、∀ x y, R x y → S x y が成り立つことであると定義します。
このとき #R を帰納的述語として表現することができます。一見しただけでは「～を含むような最小の…」という表現を帰納的述語として表現できることは見えてこないかもしれません。しかし、冷静に考えてみると #R については、以下の性質が成り立ちます。
#RはRを含む。つまり∀ x y, R x y → #R x yが成り立つ。#Rは反射的である。つまり∀ x, #R x xが成り立つ。
そして、#R はこれを満たすような最小の二項関係であるわけです。それを考えると、反射的閉包は次のように定義することができます。
variable {α : Type} (R : α → α → Prop)
/-- 反射的閉包 -/
inductive ReflCl : α → α → Prop where
/-- `R` を含む -/
| base {x y : α} (h : R x y) : ReflCl x y
/-- 反射的 -/
| refl {x : α} : ReflCl x x
実際ここで定義した ReflCl は、R を含むような最小の反射的二項関係であることを証明できます。
variable {α : Type} (R : α → α → Prop)
/-- `α`上の二項関係の全体 -/
abbrev BinRel (α : Type) := α → α → Prop
/-- `R` が `S` に含まれるという関係を `R ≤ S` と書けるようにする -/
instance : LE (BinRel α) where
le := fun R S => ∀ x y, R x y → S x y
/-- `R`の反射的閉包は`R`を含む -/
theorem le_reflCl (R : BinRel α) : R ≤ ReflCl R := by
dsimp [(· ≤ ·)]
grind [ReflCl]
/-- `ReflCl R` は反射的二項関係 -/
theorem reflCl_refl (R : BinRel α) : ∀ x : α, ReflCl R x x := by
grind [ReflCl]
/-- `ReflCl R` は `R` を含むような反射的二項関係の中で最小 -/
theorem reflCl_is_minimal (R S : BinRel α) (hle : R ≤ S) (hrefl : ∀ x, S x x) :
ReflCl R ≤ S := by
dsimp [(· ≤ ·)] at *
intro x y h
induction h with grind
使用例: アクセス可能性
ある二項関係 r : α → α → Prop が与えられたとします。このとき、r に関して x : α がアクセス可能であるとは、x から始まる無限降下列が存在しないことをいいます。
つまり、r y₀ x, r y₁ y₀, r y₂ y₁, … と無限に続くような列 y₀, y₁, y₂, ... が存在しないということです。わかりやすさのために r = (· < ·) とすると、これは ... < y₂ < y₁ < y₀ < x のような無限降下列が存在しないことを意味します。
この「アクセス可能性」を帰納型として表現することができます。少し見えづらいと思いますが、実際にアクセス可能性述語は次のように帰納的に定義することができます。
x : αに対して、r y xとなるy : αが存在しないのであれば、xはアクセス可能。r y xを満たす任意のy : αがアクセス可能であるならば、xもアクセス可能。
技術的には r y x を満たす y が存在しないケースは ∀ y, r y x が成り立つケースに含めることができるため、アクセス可能性述語は次のように帰納的述語として定義することができます。
/-- `r` に関するアクセス可能性述語 -/
inductive Acc {α : Type} (r : α → α → Prop) : α → Prop where
/-- `r y x` が成り立つような任意の `y : α` がアクセス可能であるならば、`x` もアクセス可能。-/
| intro (x : α) (h : (y : α) → r y x → Acc r y) : Acc r x
帰納型の仕様
再帰子
inductive コマンドで帰納型 T を定義すると、再帰子(recursor) T.rec が自動生成されます。再帰子は induction タクティクで使用されるほか、[induction_eliminator] 属性にも関係があります。
たとえば列挙型である Bool の場合、再帰子は次のようになっています。
/-
info: Bool.rec.{u} {motive : Bool → Sort u} (false : motive false) (true : motive true) (t : Bool) : motive t
-/
#check Bool.rec
この再帰子の型をよく見ると、Bool から型 motive _ への依存関数 (t : Bool) → motive t を構成する手段を提供していることがわかります。
Nat の場合はもっとわかりやすいです。
/-
info: Nat.rec.{u} {motive : Nat → Sort u} (zero : motive Nat.zero) (succ : (n : Nat) → motive n → motive n.succ) (t : Nat) :
motive t
-/
#check Nat.rec
Nat から型 motive _ への依存関数 (t : Nat) → motive t を構成する手段を提供しているのは同じなのですが、よく見ると帰納法の原理そのものの形をしています。
型 motive t が棲んでいる宇宙 Sort u に Prop を代入してみましょう。このとき motive Nat.zero 型の引数というのは、命題 motive Nat.zero : Prop の証明にほかならず、(n : ℕ) → motive n → motive n.succ 型の引数というのは、命題 ∀ n, motive n → motive (n + 1) の証明にほかなりません。この条件の下で関数 (t : Nat) → motive t つまり ∀ t, motive t の証明が得られると主張しているのですから、帰納法の原理そのものであることがわかります。
noConfusion
帰納型のコンストラクタは必ず単射になり、異なるコンストラクタの像は決して重なりません。このルールは、injection タクティクで利用することができます。
/-- Peano の公理によって定義された自然数 -/
inductive MyNat : Type where
| zero
| succ (n : MyNat)
/-- コンストラクタの像は重ならない -/
example (n : MyNat) : .succ n ≠ MyNat.zero := by
intro h
injection h
/-- コンストラクタは必ず単射である -/
example (n m : MyNat) : MyNat.succ n = MyNat.succ m → n = m := by
intro h
injection h
show_term を使用して証明項を出してみると、injection タクティクにより noConfusion という名前の定理が呼ばれていることがわかります。
/-
info: Try this:
[apply] fun h => False.elim (noConfusion_of_Nat MyNat.ctorIdx h)
-/
example (n : MyNat) : .succ n ≠ MyNat.zero := show_term by
intro h
injection h
/-
info: Try this:
[apply] MyNat.succ.noConfusion h fun n_eq => n_eq
-/
example (n m : MyNat) (h : MyNat.succ n = MyNat.succ m) : n = m := show_term by
injection h
strictly positive 要件
帰納型を定義しようとした際に、次のようなエラーになることがあります。
/-
error: (kernel) arg #1 of 'Foo.mk' has a non positive occurrence of the datatypes being declared
-/
inductive Foo where
| mk (f : Foo → Nat)
エラーメッセージには「Foo.mk の引数の中に、定義しようとしている型が non positive に現れている」と書かれています。この positive とは、引数における位置のことで、一般に関数型 X → Y があるとき X は 負の位置(negative position) であり、Y は 正の位置(positive position) であると呼びます。ただし関数の型が入れ子になっていると正負が変わります。たとえば (X → Y) → Z という型の場合、X は負の位置の負の位置にあるので、正の位置と見なされます。上記の Foo のコンストラクタには Foo 自身が現れていますが、コンストラクタの引数の型の中で正の位置に現れていないので、それがルール違反であるとエラーメッセージは言っているわけです。
次の例では、Bar のコンストラクタの引数の型の中で Bar 自身が正の位置に現れていますが、これも同じエラーになります。
/-
error: (kernel) arg #1 of 'Bar.mk' has a non positive occurrence of the datatypes being declared
-/
inductive Bar where
| mk (f : (Bar → Nat) → Nat)
どの → から見ても正の位置にあるときには狭義の正の位置(strictly positive position)と呼ばれるのですが、Lean は実際には狭義の正の位置でなければ定義を拒否します。帰納型 T のコンストラクタの引数の中に T 自身が現れる場合、狭義の正の位置つまり A → T の形で現れるのは許容されますが T → A の形で現れるのは許されません。これを strictly positive 要件と本書では呼びます。
仮に strictly positive 要件に違反するような帰納型をなんでも定義できたとすると、矛盾が導かれてしまいます。unsafe 修飾子で実際に試してみましょう。2
import Mathlib.SetTheory.Cardinal.Basic
-- 任意に型 A が与えられたとして固定する
opaque A : Type
/-- strictly positive 要件を破っている帰納型 -/
unsafe inductive Bad where
| mk (f : Bad → A)
section
/- ## A が空の場合
`A` が空なら、`A` は `False` と同じなので矛盾が導かれる。
-/
unsafe def selfApply (b : Bad) : A :=
match b with
| Bad.mk f => f b
-- A の項が A の情報を使わずに構成できてしまった
unsafe def ω : A := selfApply (Bad.mk selfApply)
/-- `A` が空なら矛盾が導かれる -/
unsafe example [IsEmpty A] : False :=
IsEmpty.false ω
end
section
/- ## A に２つ以上の要素があるとき -/
/-- `Bad` と `Bad → A` の間に全単射がある -/
unsafe def equiv : Bad ≃ (Bad → A) where
toFun := fun ⟨f⟩ => f
invFun := Bad.mk
left_inv := by
intro ⟨f⟩
rfl
right_inv := by
intro f
rfl
open scoped Cardinal
unsafe example [Nontrivial A] : False := by
-- `Bad` と `Bad → A` は全単射があるので濃度(`#`)が同じ
have h : # Bad = # (Bad → A) :=
Cardinal.mk_congr equiv
-- 特に、`# Bad = # A ^ # Bad` が成り立つ
replace h : # Bad = #A ^ # Bad := by
simpa [Cardinal.mk_pi, Cardinal.prod_const, Cardinal.lift_id] using h
-- しかしカントール(Cantor)の定理により、`# A ≥ 2` ならば
-- `# Bad < # A ^ # Bad` が成り立つ
have : # Bad < #A ^ # Bad := by
apply Cardinal.cantor' (a := # Bad) (b := # A)
rw [Cardinal.one_lt_iff_nontrivial]
infer_instance
-- これは矛盾
apply ne_of_lt this h
end
-- ω を簡約すると ω 自身が出てくる
-- つまり無限ループしている
/-
error: maximum recursion depth has been reached
use `set_option maxRecDepth <num>` to increase limit
use `set_option diagnostics true` to get diagnostic information
-/
#reduce ω
-
The Hitchhiker’s Guide to Logical Verification を参考にいたしました。 ↩
-
以下の証明は、Lean 公式 Zulip の strictly positive requirement というトピックで Markus Himmel さんが示した証明を参考にしています。 ↩
infix
infix は、中置記法を定義するコマンドです。
-- 中置記法の2項演算子を定義。中身はただの掛け算
infix:60 " ⋄ " => Nat.mul
#guard 2 ⋄ 3 = 6
: の後に付けている数字は パース優先順位(parsing precedence) で、高いほど結合するタイミングが早くなります。等号 = のパース優先順位は 50 であることを覚えておくと良いかもしれません。
-- 等号より微妙にパース優先順位が高い
infix:51 " strong " => Nat.add
-- きちんと 1 + (2 strong 3) = 6 と解釈される。
-- これは、 等号のパース優先順位が 51 未満であることを意味する
#check 1 + 2 strong 3 = 6
-- パース優先順位を 50 より低くすると等号より低くなる
-- したがってエラーになる
infix:49 " weak " => Nat.add
#check_failure 1 + 2 weak 3 = 6
infix で定義される記法は左結合でも右結合でもなく、必ず括弧が必要です。
open Lean Parser in
/-- `s : String` をパースして `Syntax` の項を得る。`cat` は構文カテゴリ。-/
def parse (cat : Name) (s : String) : MetaM Syntax := do
ofExcept <| runParserCategory (← getEnv) cat s
-- 単に連結するとパース不可でエラーになる
/- error: <input>:1:6: expected end of input -/
#eval parse `term "1 ⋄ 2 ⋄ 3"
-- 括弧を付ければOK
#eval parse `term "1 ⋄ (2 ⋄ 3)"
舞台裏
infix は notation コマンドに展開されるマクロとして実装されています。
def lxor (l r : Bool) : Bool := !l && r
section
open Lean
/-- `#expand` の入力に渡すための構文カテゴリ -/
syntax macro_stx := command <|> tactic <|> term
/-- マクロを展開するコマンド -/
elab "#expand " "(" stx:macro_stx ")" : command => do
let t : Syntax :=
match stx.raw with
| .node _ _ #[t] => t
| _ => stx.raw
match ← Elab.liftMacroM <| Macro.expandMacro? t with
| none => logInfo m!"Not a macro"
| some t => logInfo m!"{t}"
end
/- info: notation:50 lhs✝:51 " LXOR " rhs✝:51 => lxor lhs✝ rhs✝ -/
#expand (infix:50 " LXOR " => lxor)
infixl
infixl は、左結合の中置記法を定義するためのコマンドです。
-- 中置記法の2項演算子を定義。中身はただの引き算
infixl:60 " ⋄ " => fun x y => x - y
-- 左結合になっている
#guard (16 ⋄ 5) ⋄ 4 = 7
#guard 16 ⋄ (5 ⋄ 4) = 15
#guard 16 ⋄ 5 ⋄ 4 = 7
舞台裏
infixl は notation コマンドに展開されるマクロとして実装されています。
section
open Lean
/-- `#expand` の入力に渡すための構文カテゴリ -/
syntax macro_stx := command <|> tactic <|> term
/-- マクロを展開するコマンド -/
elab "#expand " "(" stx:macro_stx ")" : command => do
let t : Syntax :=
match stx.raw with
| .node _ _ #[t] => t
| _ => stx.raw
match ← Elab.liftMacroM <| Macro.expandMacro? t with
| none => logInfo m!"Not a macro"
| some t => logInfo m!"{t}"
end
/- info: notation:60 lhs✝:60 " ⋄ " rhs✝:61 => (fun x y => x - y) lhs✝ rhs✝ -/
#expand (infixl:60 " ⋄ " => fun x y => x - y)
infixr
infixr は、右結合の中置記法を定義するためのコマンドです。
-- 中置記法の2項演算子を定義。中身はただの引き算
infixr:60 " ⋄ " => fun x y => x - y
-- 右結合になっている
#guard (16 ⋄ 5) ⋄ 4 = 7
#guard 16 ⋄ (5 ⋄ 4) = 15
#guard 16 ⋄ 5 ⋄ 4 = 15
舞台裏
infixr は notation コマンドに展開されるマクロとして実装されています。
section
open Lean
/-- `#expand` の入力に渡すための構文カテゴリ -/
syntax macro_stx := command <|> tactic <|> term
/-- マクロを展開するコマンド -/
elab "#expand " "(" stx:macro_stx ")" : command => do
let t : Syntax :=
match stx.raw with
| .node _ _ #[t] => t
| _ => stx.raw
match ← Elab.liftMacroM <| Macro.expandMacro? t with
| none => logInfo m!"Not a macro"
| some t => logInfo m!"{t}"
end
/- info: notation:60 lhs✝:61 " ⋄ " rhs✝:60 => (fun x y => x - y) lhs✝ rhs✝ -/
#expand (infixr:60 " ⋄ " => fun x y => x - y)
instance
instance は、型クラスのインスタンスを定義するためのコマンドです。
/-- 平面 -/
structure Point (α : Type) where
x : α
y : α
/-- 原点 -/
def origin : Point Int := { x := 0, y := 0 }
-- 数値のように足し算をすることはできない
#check_failure (origin + origin)
/-- 平面上の点の足し算ができるようにする -/
instance {α : Type} [Add α] : Add (Point α) where
add p q := { x := p.x + q.x, y := p.y + q.y }
-- 足し算ができるようになった
#check (origin + origin)
インスタンスの連鎖
インスタンスは連鎖させることができます。言い換えると、「a が C のインスタンスならば、f a も C のインスタンスである」というようなインスタンス宣言ができます。Lean コンパイラは再帰的にインスタンスを探します。
/-- 偶数 -/
inductive Even : Type where
| zero
| succ (n : Even)
deriving DecidableEq
/-- 偶数から自然数への変換 -/
def Even.toNat : Even → Nat
| zero => 0
| succ n => 2 + (Even.toNat n)
/-- Even を文字列に変換することを可能にする。
同時に #eval も可能になる。-/
instance : ToString Even where
toString := toString ∘ Even.toNat
/-- Even.zero を 0 と書けるようにする -/
instance : OfNat Even 0 where
ofNat := Even.zero
-- 実際に Even.zero を 0 と書けるようになった
#guard (0 : Even) = Even.zero
/-- インスタンス連鎖を利用して OfNat を実装。
n について OfNat の実装があれば、n + 2 についても OfNat の実装を得る。-/
instance {n : Nat} [OfNat Even n] : OfNat Even (n + 2) where
ofNat := Even.succ (OfNat.ofNat n)
#guard (2 : Even) = Even.succ Even.zero
-- 奇数については OfNat の実装はない
#check_failure (3 : Even)
なお、インスタンス連鎖の回数には上限があります。
-- ギリギリセーフ
#eval (254 : Even)
-- 上限を超えてしまった
#check_failure (256 : Even)
インスタンス優先度
概要
Lean では、同じ型と型クラスの組に対して複数のインスタンスを定義することができます。たとえば、次のようにモノイドという型クラスを定義したとします。
/-- モノイド -/
class Monoid (α : Type) where
/-- 単位元 -/
unit : α
/-- 演算 -/
op : α → α → α
/-- 結合法則 -/
assoc : ∀ x y z : α, op (op x y) z = op x (op y z)
このとき Nat という一つの型に対して、２つの Monoid のインスタンスを定義することができ、後から定義した方が優先されます。
section
/- ## 優先度を指定しないインスタンスを２つ重ねた例 -/
local instance : Monoid Nat where
unit := 0
op x y := x + y
assoc x y z := by ac_rfl
local instance : Monoid Nat where
unit := 1
op x y := x * y
assoc x y z := by ac_rfl
-- 後から宣言した方が優先される
#guard (Monoid.unit : Nat) = 1
end
しかし、priority 構文を使うとインスタンス優先度を設定することができます。たとえば、priority := low とするとインスタンス優先度が low に設定されて、優先されなくなります。
section
/- ## priority := low の使用例 -/
local instance : Monoid Nat where
unit := 0
op x y := x + y
assoc x y z := by ac_rfl
local instance (priority := low) : Monoid Nat where
unit := 1
op x y := x * y
assoc x y z := by ac_rfl
-- 後から宣言した方が優先されなくなる！
#guard (Monoid.unit : Nat) = 0
end
逆に priority := high とするとインスタンス優先度が high に設定されて、優先されるようになります。
section
/- ## priority := high の使用例 -/
local instance (priority := high) : Monoid Nat where
unit := 0
op x y := x + y
assoc x y z := by ac_rfl
local instance : Monoid Nat where
unit := 1
op x y := x * y
assoc x y z := by ac_rfl
-- 後から宣言した方が優先されなくなる！
#guard (Monoid.unit : Nat) = 0
end
使用例: アリティの計算
インスタンス優先度を活用する例として、関数型のアリティ（引数の数）を計算する型クラスを定義する例をご紹介します。1
/-- `Arity α` は「型 `α` のアリティ（引数の数）」を与える型クラス。 -/
class Arity (α : Type) where
/-- `α` のアリティ -/
arity : Nat
/--
汎用の（デフォルト）インスタンス:
あらゆる型を「関数でない」とみなし、アリティを `0` とする。
関数型に対しては、このインスタンスより **優先度の高い** 関数用インスタンスが使われる。
-/
instance (priority := low) (α : Type) : Arity α where
arity := 0
/--
関数型 `α → β` のインスタンス:
帰結型 `β` のアリティに 1 を足す。
（`β` に対して再帰的に `Arity` を使うことで、多引数カリー化を数え上げる）
-/
instance (α β : Type) [Arity β] : Arity (α → β) where
arity := 1 + (Arity.arity β)
-- 関数でない型のアリティは 0
#guard Arity.arity Nat = 0
-- 1引数関数型のアリティは 1
#guard Arity.arity (Nat → Bool) = 1
-- 2引数関数型のアリティは 2
#guard Arity.arity (Nat → Bool → String) = 2
-- タプルを受け取る関数型は「引数が１つ」なので１
#guard Arity.arity (Nat × Bool → String) = 1
舞台裏
instance は [instance] 属性を付与された def と同じようにはたらきます。ただし instance はインスタンス名を省略することができるという違いがあります。
-- `List` 同士を足すことはできない
#check_failure [1] + [2]
-- インスタンスを宣言する
instance instListAdd {α : Type} : Add (List α) where
add := List.append
-- リスト同士を足すことができるようになった
-- 実装としては、上で指定した通り `List.append` が使われる
#guard [1] + [2] = [1, 2]
-- インスタンスを削除する
attribute [-instance] instListAdd
-- リスト同士を足すことができなくなった
#check_failure [1] + [2]
-
ルールとして、より具体的なインスタンスが優先されるので、この関数型のアリティについての例では
priority := lowを指定する必要はありません。しかし、コードの意図を明確にするためには指定したほうがわかりやすいでしょう。 ↩
macro_rules
macro_rules はマクロ展開を定義するためのコマンドです。類似のコマンドに macro コマンドがあります。
/-- `#hello` コマンドの構文の定義。
オプションの引数を受け取るようにしておく。 -/
syntax "#hello" (str)? : command
macro_rules
| `(#hello) => `(command| #eval "Hello, Lean!")
| `(#hello $name) => `(command| #eval s!"Hello, {$name}!")
/- info: "Hello, Lean!" -/
#hello
/- info: "Hello, world!" -/
#hello "world"
macro_rules コマンドは上記の例のように、=> 記号を境に分かれており、左辺の構文を右辺の構文に変換するというルールを定義します。
展開ルールの上書きと追加
一つの構文に対して macro_rules で複数の展開ルールを宣言することができます。このとき、最後に宣言されたルールから先に適用されます。
/-- 挨拶するコマンド -/
syntax "#greet" : command
-- `#greet` という構文に2つの展開ルールを定義
macro_rules
| `(command| #greet) => `(#eval "Hello, Lean!")
macro_rules
| `(command| #greet) => `(#eval "Good morning, Lean!")
-- 最後に宣言されたルールが適用される
/- info: "Good morning, Lean!" -/
#greet
このとき古い方の展開ルールは常に上書きされて消えるわけではありません。macro_rules で宣言されたルールは最後に宣言されたものから順に試され、展開に失敗するとスキップされ、最初に展開に成功したルールが採用されます。具体例でこの挙動を確認してみましょう。
/-- `trivial` というタクティクの類似物 -/
syntax "my_trivial" : tactic
-- `assumption` タクティクを呼び出す
macro_rules
| `(tactic| my_trivial) => `(tactic| assumption)
-- `rfl` タクティクを呼び出す
macro_rules
| `(tactic| my_trivial) => `(tactic| rfl)
-- 後から追加されたルールが先に適用されるので、Lean はまず `rfl` に展開しようとする。
-- しかし `rfl` はゴールの形が不適切なので失敗する。
-- その後 `assumption` が試され、それは通る。
example (P : Prop) (h : P) : P := by
my_trivial
-- `rfl` が使われて通る
example {α : Type} (x : α) : x = x := by
my_trivial
再帰的展開
macro_rules の右辺に、これから解釈しようとしている構文自身を含めることができます。これにより、再帰的なマクロ展開を定義することができます。
example {α : Type} {P : Prop} (x : α) (h : P) : x = x ∧ P := by
-- 最初は示せない
fail_if_success my_trivial
-- 手動で示す
apply And.intro
· rfl
· assumption
-- 再帰的なマクロ展開を定義。
-- `P` と `Q` が両方 `my_trivial` で示せるなら、
-- `P ∧ Q` が `my_trivial` で示せるようになる。
macro_rules
| `(tactic| my_trivial) => `(tactic| apply And.intro <;> my_trivial)
example {α : Type} {P : Prop} (x : α) (h : P) : x = x ∧ P := by
-- `my_trivial` で示せるようになった！
my_trivial
使用例
macro_rules を理解する一番の近道は、具体例をたくさん見ることです。以下に、macro_rules のシンプルな使用例をいくつか紹介します。
集合の波括弧記法
macro_rules を使用して、集合の波括弧記法 {{ a₁, a₂, ..., aₙ }} を解釈するマクロを定義する例を以下に示します。
/-- 部分集合。`α` の部分集合 `A ⊆ α` は、任意の要素 `x : α` に対して
それが `A` の要素かどうか判定する述語 `A : α → Prop` と同一視できる。-/
def Set (α : Type) := α → Prop
namespace Set
variable {α : Type}
/-- 1つの要素だけからなる集合 -/
def singleton (a : α) : Set α := fun x => x = a
/-- 集合に１つ要素を追加する -/
def insert (a : α) (s : Set α) := fun x => x = a ∨ s x
end Set
-- 集合の波括弧記法の定義。
-- 既存の記号と被らないようにするために二重にしている。
-- なお `term,*` は `term` が `,` 区切りで0個以上続く列を表す。
syntax "{{" term,* "}}" : term
-- `syntax` コマンドは記法の解釈方法を決めていないので、エラーになる
#check_failure {{2, 3}}
-- 集合の波括弧記法をどう解釈するかのルールを定める
macro_rules
| `(term| {{$x}}) => `(Set.singleton $x)
| `(term| {{$x, $xs:term,*}}) => `(Set.insert $x {{$xs,*}})
-- 集合の波括弧記法が使えるようになった
#check ({{2, 3, 4, 5}} : Set Nat)
入れ子リスト
Lean 標準の List : Type → Type はリストの要素が同じ型であることを要求しており、「リストのリスト」にリストではない要素を混入させることを許しませんが、それを許すような入れ子リストを定義して、そのための構文を用意する例を示しましょう。1
/-- 入れ子になったリスト -/
inductive NestedList (α : Type) : Type
/-- 空リスト -/
| nil : NestedList α
/-- NestedList に要素を追加する -/
| conse : α → NestedList α → NestedList α
/-- NestedList に NestedList を追加する -/
| consl : NestedList α → NestedList α → NestedList α
deriving DecidableEq
namespace NestedList
/- ## NestedList を定義する構文を作る -/
/-- NestedList を定義するための構文。 -/
syntax "《" term,* "》" : term
-- `syntax` コマンドは記法の解釈方法を決めていないので、エラーになる
#check_failure 《1, 《2, 3》, 4》
macro_rules
| `(《》) => `(NestedList.nil)
| `(《《$xs,*》》) => `(NestedList.consl 《$xs,*》 NestedList.nil)
| `(《《$xs,*》, $ys,*》) => `(NestedList.consl 《$xs,*》 《$ys,*》)
| `(《$x》) => `(NestedList.conse $x NestedList.nil)
| `(《$x, $xs,*》) => `(NestedList.conse $x 《$xs,*》)
-- NestedList を見やすく定義できるようになった！
#check 《1, 《2, 3》, 4》
#guard
let xs := 《1, 2》
let ys := NestedList.conse 1 <| .conse 2 NestedList.nil
-- 両者は同じものを表している！
xs = ys
end NestedList
リスト内包表記
マクロとして リスト内包表記(list comprehension) を導入する例を以下に示します。2
namespace ListComp
/- # リスト内包表記 -/
/-- リスト内包表記 -/
declare_syntax_cat compClause
syntax "for " term " in " term : compClause
syntax "if " term : compClause
syntax "[" term " | " compClause,* "]" : term
-- `syntax` コマンドは記法の解釈方法を決めていないので、エラーになる
#check_failure [x | for x in [1, 2, 3, 4, 5]]
#check_failure [x | if x < 2]
#check_failure [x | for x in [1, 2, 3], if x < 2]
macro_rules
| `([$t |]) => `([$t])
| `([$t | for $x in $xs]) => `(List.map (fun $x => $t) $xs)
| `([$t | if $x]) => `(if $x then [$t] else [])
| `([$t | $c, $cs,*]) => `(List.flatten [[$t | $cs,*] | $c])
-- for 構文のテスト
#guard [x ^ 2 | for x in [1, 2, 3, 4, 5]] = [1, 4, 9, 16, 25]
-- ２重の for 構文のテスト
#guard
let lhs := [(x, y) | for x in [1, 2, 3], for y in [4, 5]]
let rhs := [(1, 4), (1, 5), (2, 4), (2, 5), (3, 4), (3, 5)]
lhs = rhs
-- if 構文のテスト
#guard [x | for x in [1, 2, 3], if x < 2] = [1]
end ListComp
数式を Lean に埋め込む
1 + 2 * 3 のような数式（値ではなくて式そのもの）を Lean の式として解釈するマクロを以下に示します。
/-- 2項演算の集合 -/
inductive Op where
/-- 加法 -/
| add
/-- 乗法 -/
| mul
deriving DecidableEq
/-- 数式 -/
inductive Arith where
/-- 数値リテラル -/
| val (n : Nat) : Arith
/-- 演算子の適用 -/
| app (op : Op) (lhs rhs : Arith) : Arith
deriving DecidableEq
section arith_syntax
/-- `Arith` のための構文カテゴリ -/
declare_syntax_cat arith
/-- `Arith` を見やすく定義するための構文 -/
syntax "[arith| " arith "]" : term
-- 数値リテラルは数式
syntax:max num : arith
-- 数式を `+` または `*` で結合したものは数式
-- `+` と `*` のパース優先順位を指定しておく
syntax:30 arith:30 " + " arith:31 : arith
syntax:35 arith:35 " * " arith:36 : arith
-- 数式を括弧でくくったものは数式
syntax:max "(" arith ")" : arith
-- `syntax` コマンドは記法の解釈方法を決めていないのでエラーになるが、
-- パースはできるようになった
#check_failure [arith| 1 + 2]
#check_failure [arith| 1 * 2]
#check_failure [arith| (1 + 2) * 3]
end arith_syntax
section arith_macro
macro_rules
| `([arith| $n:num]) => `(Arith.val $n)
| `([arith| $l:arith + $r:arith]) => `(Arith.app Op.add [arith| $l] [arith| $r])
| `([arith| $l:arith * $r:arith]) => `(Arith.app Op.mul [arith| $l] [arith| $r])
| `([arith| ($e:arith)]) => `([arith| $e])
open Arith
-- 足し算は左結合になる
#guard
let expected := app Op.add (app Op.add (val 1) (val 2)) (val 3)
let actual := [arith| 1 + 2 + 3]
actual = expected
-- 掛け算は左結合になる
#guard
let expected := app Op.mul (app Op.mul (val 1) (val 2)) (val 3)
let actual := [arith| 1 * 2 * 3]
actual = expected
-- 足し算と掛け算が混在する場合は、掛け算が優先される
#guard
let expected := app Op.add (app Op.mul (val 1) (val 2)) (val 3)
let actual := [arith| 1 * 2 + 3]
actual = expected
end arith_macro
IMP 言語の構文
簡単な命令型プログラミング言語（ここでは IMP と呼ばれるものを使用します）を Lean の中に埋め込んでしまうことができます。3
namespace IMP
/- ## IMPのASTを定義する -/
/-- リテラル -/
inductive Lit where
/-- 数値リテラル -/
| nat (n : Nat)
/-- 真偽値リテラル -/
| bool (b : Bool)
/-- 単項演算子 -/
inductive UnOp where
/-- 否定演算子 -/
| not
inductive BinOp where
/-- 論理積 -/
| and
/-- 和 -/
| add
/-- 順序関係 `<` -/
| less
/-- IMPの式 -/
inductive Expr where
/-- リテラル式 -/
| lit (l : Lit)
/-- 変数 -/
| var (x : String)
/-- 単項演算子の適用 -/
| un (op : UnOp) (e : Expr)
/-- 二項演算子の適用 -/
| bin (op : BinOp) (e1 e2 : Expr)
inductive Program where
/-- 何もしないプログラム -/
| skip
/-- 変数代入 `v := e` -/
| assign (v : String) (e : Expr)
/-- 逐次実行 `p1; p2` -/
| seq (p1 p2 : Program)
/-- 条件分岐 `if e then p1 else p2` -/
| ite (e : Expr) (p1 p2 : Program)
/-- ループ `while e do p` -/
| while (e : Expr) (p : Program)
end IMP
namespace IMP
/- ## リテラルのための構文を定義する -/
/-- IMPのリテラルのための構文 -/
declare_syntax_cat imp_lit
syntax num : imp_lit
syntax "true" : imp_lit
syntax "false" : imp_lit
syntax "[imp_lit|" imp_lit "]" : term
macro_rules
| `([imp_lit| $n:num]) => `(Lit.nat $(n))
| `([imp_lit| true]) => `(Lit.bool $(Lean.mkIdent ``Bool.true))
| `([imp_lit| false]) => `(Lit.bool $(Lean.mkIdent ``Bool.false))
#check [imp_lit| 42]
#check [imp_lit| true]
#check [imp_lit| false]
end IMP
namespace IMP
/- ## 単項演算子のための構文を定義する -/
/-- 単項演算子のための構文 -/
declare_syntax_cat imp_unop
syntax "!" : imp_unop
syntax "[imp_unop|" imp_unop "]" : term
macro_rules
| `([imp_unop| !]) => `(UnOp.not)
#check [imp_unop| !]
end IMP
namespace IMP
/- ## 2項演算子のための構文を定義する -/
/-- 2項演算子のための構文 -/
declare_syntax_cat imp_binop
syntax "+" : imp_binop
syntax "&&" : imp_binop
syntax "<" : imp_binop
syntax "[imp_binop|" imp_binop "]" : term
macro_rules
| `([imp_binop| +]) => `(BinOp.add)
| `([imp_binop| &&]) => `(BinOp.and)
| `([imp_binop| <]) => `(BinOp.less)
#check [imp_binop| +]
#check [imp_binop| &&]
#check [imp_binop| <]
end IMP
namespace IMP
/- ## 式のための構文を定義する -/
open Lean
declare_syntax_cat imp_expr
syntax imp_lit : imp_expr
syntax ident : imp_expr
syntax imp_unop imp_expr : imp_expr
syntax imp_expr imp_binop imp_expr : imp_expr
syntax "(" imp_expr ")" : imp_expr
syntax "[imp_expr|" imp_expr "]" : term
-- 余計な警告が出るので消す
set_option linter.unusedVariables false in
macro_rules
| `([imp_expr| $lit:imp_lit]) => `(Expr.lit [imp_lit| $lit])
| `([imp_expr| $x:ident]) => `(Expr.var $(quote x.getId.toString))
| `([imp_expr| !$e]) => `(Expr.un UnOp.not [imp_expr| $e])
| `([imp_expr| $e1 $op:imp_binop $e2]) => `(Expr.bin [imp_binop| $op] [imp_expr| $e1] [imp_expr| $e2])
| `([imp_expr| ($e)]) => `([imp_expr| e])
#check [imp_expr| a]
#check [imp_expr| a + 5]
#check [imp_expr| 1 + true]
end IMP
namespace IMP
/- ## IMPプログラムのための構文を定義する -/
declare_syntax_cat imp_program
syntax "skip" : imp_program
syntax ident ":=" imp_expr : imp_program
syntax imp_program ";" imp_program : imp_program
syntax "if" imp_expr "then" imp_program "else" imp_program : imp_program
syntax "while" imp_expr "do" imp_program : imp_program
syntax "[IMP|" imp_program "]" : term
open Lean
macro_rules
| `([IMP| skip]) => `(Program.skip)
| `([IMP| $x:ident := $e]) => `(Program.assign $(quote x.getId.toString) [imp_expr| $e])
| `([IMP| $p1; $p2]) => `(Program.seq [IMP| $p1] [IMP| $p2])
| `([IMP| if $e then $p1 else $p2]) => `(Program.ite [imp_expr| $e] [IMP| $p1] [IMP| $p2])
| `([IMP| while $e do $p]) => `(Program.while [imp_expr| $e] [IMP| $p])
#check [IMP|
a := 5;
if ! a && 3 < 4 then
c := 5
else
a := a + 1;
b := 10;
while 1 < 2 do
b := b + 1
]
end IMP
-
ここで紹介しているコード例は、Lean 公式 Zulip の “macro parser for nested lists” というトピックで Kyle Miller さんが挙げていたコードを参考にしています。 ↩
-
ここで紹介しているコード例は、 lean4-samplesリポジトリのListComprehension.leanというファイルの内容を参考にしています。 ↩
-
ここで紹介しているコード例は、Metaprogramming in Lean 4 の Embedding DSLs By Elaboration という章の記述を参考にしています。 ↩
macro
macro は、その名の通りマクロを定義するためのコマンドです。ただしマクロとは、構文を構文に変換する機能のことです。
open Lean Parser in
/-- `s : String` をパースして `Syntax` の項を得る。`cat` は構文カテゴリ。-/
def parse (cat : Name) (s : String) : MetaM Syntax := do
ofExcept <| runParserCategory (← getEnv) cat s
-- 最初は `#greet` が未定義なので、合法的なLeanのコマンドとして認識されない
/- error: <input>:1:0: expected command -/
#eval parse `command "#greet"
-- `#greet` コマンドを定義する
macro "#greet " : command => `(command| #eval "Hello World!")
-- `#greet` コマンドが使用可能になった
/- info: "Hello World!" -/
#greet
舞台裏
syntax コマンドとmacro_rules コマンドを使用すれば、macro コマンドと同様のことが実現できます。macro_rules コマンドと比較すると、macro コマンドはマクロのための構文と展開ルールを同時に定義しているところが異なります。
namespace Macro
scoped macro "#hello " : command => `(command| #eval "Hello Lean!")
-- `#hello` コマンドが使用可能になった
/- info: "Hello Lean!" -/
#hello
end Macro
namespace MacroRules
-- 構文の定義
scoped syntax "#hello " : command
-- 構文は認識されるが、解釈方法が定義されていないのでエラーになる
/- error: elaboration function for `MacroRules.«command#hello»` has not been implemented -/
#hello
scoped macro_rules
| `(#hello) => `(command| #eval "Hello Lean!")
-- `#hello` コマンドが使用可能になった
/- info: "Hello Lean!" -/
#hello
end MacroRules
マクロ作例
マクロでどのようなことができるのかを理解するには、例を見るのが最高の近道です。以下に、macro コマンドでマクロを定義する例をいくつか示します。なお macro_rules コマンドを使用すれば、より複雑なマクロも定義できます。
引数を取るマクロ
冒頭の例の #greet コマンドは引数を持ちませんが、引数を取るようなものも定義できます。引数は $ を付けることでマクロ内で展開することができます。
-- 引数を取って、引数に対して挨拶するコマンドを定義する
-- 引数は `$` を付けると展開できる
macro "#hello " id:term : command => `(command| #eval s!"Hello, {$id}!")
/- info: "Hello, Lean!" -/
#hello "Lean"
タクティクを自作する
マクロを使用すると、コマンドだけでなくタクティクの定義も行うことができます。
-- 平方根の計算
example : √4 = 2 := by
rw [Real.sqrt_eq_cases]
norm_num
-- 平方根の簡約
example : √18 = 3 * √ 2 := by
rw [Real.sqrt_eq_cases]
ring_nf
norm_num
-- 新たなタクティクを定義する
macro "norm_sqrt" : tactic => `(tactic| focus
rw [Real.sqrt_eq_cases]
try ring_nf
norm_num
)
-- 新しいタクティクにより一発で証明が終わるようになった！
example : √4 = 2 := by norm_sqrt
example : √18 = 3 * √ 2 := by norm_sqrt
do 構文を追加する
マクロで do 構文を追加することができます。
/-- 自前で定義した累積代入構文 -/
macro x:ident " += " e:term : doElem => `(doElem| ($x) := ($x) + $e)
/-- 0からnまでの和 -/
def sum (n : Nat) : Nat := Id.run do
let mut sum := 0
for i in [0:n+1] do
sum += i
return sum
#guard sum 3 = 6
#guard sum 4 = 10
引数の値ではなく名前を参照
Quote と組み合わせることで、マクロ展開時に、マクロの引数として与えられた変数の値だけでなく名前も参照することができます。
-- 通常の dbg_trace の挙動。
-- 与えられた式の値だけを返し、与えられた式が何だったかは教えてくれない
/- info: 1 -/
#eval
let x := 1
dbg_trace x
return ()
/-- 与えられている変数の名前も出力するような `dbg_trace` の変種 -/
macro "dbg_trace!" x:ident body:term : term =>
-- 与えられている引数 `x` の名前を取得する
let ident := Lean.quote x.getId.toString
`(term| dbg_trace s!"{$ident} = {$x}"; $body)
-- 与えられた変数の名前を出力するようになった！
/- info: y = 1 -/
#eval
let y := 1
dbg_trace! y
return ()
mutual
mutual は、相互再帰を定義するために使用されます。
以下は、作為的ではあるものの簡単な例です。
mutual
/-- 偶数であることを表す述語 -/
inductive Even : Nat → Prop where
| zero : Even 0
| succ {n : Nat} (h : Odd n) : Even (n + 1)
/-- 奇数であることを表す述語 -/
inductive Odd : Nat → Prop where
| succ {n : Nat} (h : Even n) : Odd (n + 1)
end
相互再帰を使って定義された概念に対して証明を行う場合、定理も相互再帰的にする必要が生じることがあります。
mutual
theorem Even.exists {n : Nat} (h : Even n) : ∃ a, n = 2 * a := by
cases h with
| zero => exists 0
| @succ n h =>
obtain ⟨a, ha⟩ := h.exists
exists (a + 1)
grind
theorem Odd.exists {n : Nat} (h : Odd n) : ∃ a, n = 2 * a + 1 := by
cases h with
| @succ n h =>
obtain ⟨a, ha⟩ := Even.exists h
exists a
grind
end
使用例
作為的でない相互再帰の使用例としては、以下のようなものがあります。
namespace
namespace は、定義に階層構造を与えて整理するためのコマンドです。名前空間 Foo の中で bar を定義すると、それは Foo.bar という名前になり、名前空間 Foo の中では短い名前 bar でアクセスできますが、名前空間を出るとアクセスにフルネームが必要になります。
なおここでは説明のために namespace の中をインデントしていますが、これは一般的なコード規約ではありません。
-- namespace の外で定義された関数
def greet (name : String) := "Hello, " ++ name
namespace Nat
def isEven (n : Nat) : Bool := n % 2 == 0
-- 同じ名前空間の中なら短い名前でアクセスできる
#check isEven
-- 名前空間の外にある名前にアクセスできる
#check greet
end Nat
-- 名前空間の外に出ると、短い名前ではアクセスできない
#check_failure isEven
-- フルネームならアクセスできる
#check Nat.isEven
名前空間は入れ子にすることができます。
namespace Nat
namespace Even
def thirty := 30
end Even
#check Even.thirty
end Nat
#check Nat.Even.thirty
名前空間を一時的に抜ける
名前空間を一時的に抜けたいとき、_root_ が使用できます。名前空間 Hoge の中で foo を定義すると Hoge.foo という名前になりますが、_root_.foo と定義すればこの挙動を避けて foo という名前にすることができます。
たとえば以下のように名前空間の中で List 配下の関数を定義し、フィールド記法を使おうとしてもうまくいきません。こういう場合に _root_ を使用すると、名前空間を閉じることなくエラーを解消できます。
namespace Root -- 名前空間 `Root` の宣言
variable {α : Type}
def List.unpack (l : List (List α)) : List α :=
match l with
| [] => []
| x :: xs => x ++ unpack xs
/-
error: Invalid field `unpack`: The environment does not contain `List.unpack`, so it is not possible to project the field `unpack` from an expression
[[1, 2], [3]]
of type `List (List Nat)`
-/
#check ([[1, 2], [3]] : List (List Nat)).unpack
-- エラーになる原因は、名前空間 `Root` の中で宣言したので
-- 関数名が `Root.List.unpack` になってしまっているから
#check Root.List.unpack
-- `_root_` を頭につけて再度定義する
def _root_.List.unpack (l : List (List α)) : List α :=
match l with
| [] => []
| x :: xs => x ++ unpack xs
-- 今度は成功する
#eval [[1, 2], [3]].unpack
end Root
notation
notation は、新しい記法を導入するためのコマンドです。
/-- 各 `k` に対して、二項関係 `a ≃ b mod k` を返す -/
def modulo (k a b : Int) : Prop :=
k ∣ (a - b)
-- mod という記法を導入する
notation:60 a:60 " ≃ " b:60 " mod " k:60 => modulo k a b
-- 定義した記法が使える
#check (3 ≃ 7 mod 4)
notation 記号で定義した記法が実際にどのように展開されているのか確かめるには、pp.notation というオプションを無効にします。
section
/-- 階乗関数 -/
def factorial : Nat → Nat
| 0 => 1
| n+1 => (n+1) * factorial n
/-- 階乗関数を表す記法 -/
notation:100 a:100 "!" => factorial a
-- 表示する際に導入された記法を無効にする
set_option pp.notation false
/- info: factorial 5 : Nat -/
#check 5!
end
パース優先順位
notation コマンドで記法を定義するときに、その記法の他の演算子などと比べた パース優先順位(parsing precedence) を数値で指定することができます。パース優先順位が高い演算子ほど、他の演算子より先に適用されます。言い換えれば、パース優先順位を正しく設定することにより、括弧を省略しても意図通りに式が解釈されるようにすることができます。
/-- 結合が弱い方。中身は足し算 -/
notation:min a:min " weak " b:min => Nat.add a b
/-- 結合が強い方。中身は掛け算 -/
notation:70 a:70 " strong " b:70 => Nat.mul a b
example : (3 weak 1 strong 2) = 5 := calc
-- weak と strong のパース優先順位は strong の方が高いので、
-- まず 1 strong 2 が計算されて 2 になり、
_ = (3 weak 2) := rfl
-- その後 3 weak 2 が計算されて 5 になる。
_ = 5 := rfl
example : (2 strong 2 weak 3) = 7 := calc
_ = (4 weak 3) := rfl
_ = 7 := rfl
パース優先順位についての構文は syntax コマンドでも同様です。
プレースホルダのパース優先順位
プレースホルダのパース優先順位の数字は、「この位置に来る記号は、指定された数字以上のパース優先順位を持たなければならない」ことを意味します。下記の例の場合、仮に右結合になるとすると LXOR 自身のパース優先順位が 60 でしかなくて 61 以上という制約を満たさないため、右結合になることがありえないことがわかります。
-- 右側のプレースホルダのパース優先順位を１だけ高くした
notation:60 a:60 " LXOR " b:61 => !a && b
-- 左結合だった場合の値
#guard (true LXOR false) LXOR true = true
-- 右結合だった場合の値
#guard true LXOR (false LXOR true) = false
-- 左結合になることがわかる
#guard true LXOR false LXOR true = true
逆にすると右結合になります。
notation:60 a:61 " RXOR " b:60 => a && !b
-- 左結合だった場合の値
#guard (true RXOR false) RXOR true = false
-- 右結合だった場合の値
#guard true RXOR (false RXOR true) = true
-- 右結合になることがわかる
#guard true RXOR false RXOR true = true
パース優先順位を省略する場合
パース優先順位を省略することもできます。Lean は結合順序に指定がなければ右結合になるようにするようです。
/-- パース優先順位を全く指定しないで定義した記法。中身はべき乗 -/
notation a " -^ " b => Nat.pow a b
-- この場合は `weak` (優先順位最低)が先に適用される
example : (2 -^ 1 weak 3) = 16 := calc
_ = (2 -^ 4) := rfl
_ = 16 := rfl
-- 一方で次の書き方だと `-^` の方が先に適用される
example : (2 weak 1 -^ 3) = 3 := calc
_ = (2 weak 1) := rfl
_ = 3 := rfl
-- ここでも右結合になっている
example : (2 weak 3 -^ 1 weak 2) = 29 := calc
_ = (2 weak 3 -^ 3) := rfl
_ = (2 weak 27) := rfl
_ = 29 := rfl
パース優先順位を一部だけ指定することもできます。
/-- パース優先順位を部分的に省略した足し算 -/
notation:min a " -+ " b => Nat.add a b
/-- パース優先順位を部分的に省略した掛け算 -/
notation a " -* " b:70 => Nat.mul a b
-- この場合だと、`-*` が先に適用される
-- 仮に `-+` が先に適用されたとすると、
-- `-*` の `b:70` の部分に `(2 -+ 3):min` が来ることになるのでおかしい。
-- だから `-*` が先に適用される。
example : (2 -* 2 -+ 3) = 7 := calc
_ = (4 -+ 3) := rfl
_ = 7 := rfl
記法の重複問題
notation を使って定義した記法のパース優先順位が意図通りに反映されないことがあります。
section
-- 排他的論理和の記号を定義
local notation:60 x:60 " ⊕ " y:61 => xor x y
-- 等号（パース優先順位 50）より優先順位が低いという問題でエラーになる
-- 上では60で定義しているのに、なぜ？
#check_failure true ⊕ true = false
-- 括弧を付けるとエラーにならない
#check (true ⊕ true) = false
end
ここでのエラーの原因は、記法が被っていることです。⊕ という記法は型の直和に対して既に使用されており、直和記法のパース優先順位が等号より低いためにエラーが発生していました。
-- 集合の直和の記号と被っていた。
-- 集合の直和記号は等号よりパース優先順位が低いからエラーになっていた
#check Nat ⊕ Fin 2
このケースの場合、priority で記法の優先度を指定しても解決されません。
section
-- 排他的論理和の記号を定義
local notation:60 (priority := high) x:60 " ⊕ " y:61 => xor x y
-- やっぱりエラーになる
#check_failure true ⊕ true = false
-- 括弧を付けるとエラーにならない
#check (true ⊕ true) = false
end
この問題の解決策は、まず第一に括弧を付けることですが、裏技として記法を上書きしてしまうこともできます。
section
-- ⊕ という記号をオーバーライドする
-- local コマンドを使っているのは、セクション内でだけ有効にするため
local macro_rules
| `($x ⊕ $y) => `(xor $x $y)
-- もう ⊕ が Sum として解釈されることはなく、エラーにならない
#guard true ⊕ true = false
#guard true ⊕ false = true
#guard false ⊕ true = true
#guard false ⊕ false = false
-- 上書きされたので、 Sum の意味で ⊕ を使うことはできなくなった
#check_failure Nat ⊕ Fin 2
end
半角スペースの扱い
なお、notation を定義する際に半角スペースを入れることがしばしばありますが、これは表示の際に使われるだけで記法の認識には影響しません。
section
-- 足し算を ⋄ で表す
-- local コマンドを付けているのは、この記法をセクション内でだけ有効にするため
local notation a "⋄" b => Add.add a b
-- ⋄ の左右に半角スペースが入っていない！
-- 違いはそれだけで、記法としては同様の書き方で認識される
/- info: 1⋄2 : Nat -/
#check 1 ⋄ 2
end
opaque
opaque は、定義に展開できない名前を宣言するコマンドです。具体的な実装を与えずに特定の型を持つ項が「とりあえず何かある」という表現ができます。
def との違い
def コマンドと異なり opaque コマンドを使用して宣言した名前は、#reduce コマンドで簡約できません。
-- def を使って定義
def greet : String := "hello world!"
-- reduce の結果と eval の結果が一致する
/- info: "hello world!" -/
#eval greet
/- info: "hello world!" -/
#reduce greet
-- opaque を使った定義
opaque opaque_greet : String := "hello world!"
-- 簡約できないので eval と一致しなくなる
/- info: "hello world!" -/
#eval opaque_greet
/- info: opaque_greet -/
#reduce opaque_greet
opaque で宣言された名前は partial で修飾された名前と同様に証明の中で簡約できなくなり、コンパイラを信頼しないとそれに関する証明ができなくなります。
-- 等しいものだという判定はできる
#eval opaque_greet == greet
example : opaque_greet = greet := by
-- 等しいことの証明が rfl ではできない
fail_if_success rfl
-- greet は展開できるが
dsimp [greet]
-- opaque はできない。
fail_if_success dsimp [opaque_greet]
-- コンパイラを信頼することにすれば証明ができる
native_decide
opaque で名前を宣言するとき、型だけを指定して値を指定しないということができます。このとき、その型が Inhabited 型クラスのインスタンスであることを暗黙のうちに使用します。
-- 値なしの宣言ができる
opaque some_string : String
-- 値は空文字列
/- info: "" -/
#eval some_string
-- 適当な構造体を用意する
structure Something where
val : String
-- Inhabited インスタンスがないのでエラーになる
/-
error: failed to synthesize 'Inhabited' or 'Nonempty' instance for
Something
If this type is defined using the 'structure' or 'inductive' command, you can try adding a 'deriving Nonempty' clause to it.
-/
opaque something : Something
variable との違い
opaque と同じく variable コマンドも「特定の型を持つ項がとりあえず何かある」という表現をするために使用されることがありますが、両者には重要な違いがあります。
たとえば、Lean の型システムにおいて「自分自身に適用することができる関数 f : (A → B) → C は存在しない」ということをコードで確かめたかったとします。このとき「何でもいいので」型 A, B, C と関数 f が存在すると仮定を置きたくなります。
ここで型の宣言に variable を使用すると上手くいきません。
variable {A B C : Type} [Inhabited C]
opaque f : (A → B) → C
-- エラーにならない！
#check f f
これは、２つの f のそれぞれの引数としての A, B, C が異なる値を持ちうるためです。型を opaque で宣言すると固定されるので、想定通りエラーになります。
opaque A : Type
opaque B : Type
opaque C : Type
-- 実装は与えないが C は Inhabited のインスタンスだと仮定
variable [Inhabited C]
opaque f : (A → B) → C
-- 想定通りエラーになる
#check_failure f f
open
open は名前空間を開くためのコマンドです。
名前空間 N の中にある定義 S を使いたいとき、通常はフルネームの N.S を使う必要がありますが、open N とすることで短い別名 S でアクセスできるようになります。
namespace Hoge
def foo := "hello"
end Hoge
-- 名前空間の外からだと `foo` という短い名前が使えない
#check_failure foo
section
-- 名前空間 `Hoge` をオープン
open Hoge
-- `open` することで `foo` という短い名前が使えるようになる
#check foo
end
-- セクションが終わると再び短い名前は使えなくなる
#check_failure foo
入れ子になった名前空間
名前空間 N₁ と N₂ が入れ子になっているとき、その下にある定義に短い名前でアクセスするには、open N₁ N₂ とすればよいです。
namespace Foo
namespace Bar
def baz := "world"
end Bar
end Foo
-- 入れ子の名前空間を開く
-- `Foo` の後に `Bar` を開く必要がある
open Foo Bar
#check baz
名前空間と公理
また名前空間 Foo 内に bar という公理(axiom で宣言されたもの)が存在する場合、Foo を開くと同時に公理 Foo.bar もインポートされます。
open Classical
-- 選択原理
#print choice
variable (P : Prop)
-- 選択原理が仮定された状態になっているため、
-- 任意の命題が決定可能になっている
#synth Decidable P
postfix
postfix は、後置記法を定義するコマンドです。
/-- 階乗 -/
def factorial : Nat → Nat
| 0 => 1
| n + 1 => (n + 1) * factorial n
-- 後置記法を定義する
postfix:200 "!" => factorial
-- 定義した記法が使える
#guard 5! = 120
舞台裏
postfix は notation コマンドに展開されるマクロとして実装されています。
section
open Lean
/-- `#expand` の入力に渡すための構文カテゴリ -/
syntax macro_stx := command <|> tactic <|> term
/-- マクロを展開するコマンド -/
elab "#expand " "(" stx:macro_stx ")" : command => do
let t : Syntax :=
match stx.raw with
| .node _ _ #[t] => t
| _ => stx.raw
match ← Elab.liftMacroM <| Macro.expandMacro? t with
| none => logInfo m!"Not a macro"
| some t => logInfo m!"{t}"
end
/- info: notation:200 arg✝:200 "!" => factorial arg✝ -/
#expand (postfix:200 "!" => factorial)
prefix
prefix は、前置記法を定義するためのコマンドです。
-- 前置記法を定義
-- 中身は Nat.succ
prefix:90 "⋄" => Nat.succ
-- 上で定義した記法が使える
#guard ⋄3 = 4
舞台裏
prefix は notation コマンドに展開されるマクロとして実装されています。
section
open Lean
/-- `#expand` の入力に渡すための構文カテゴリ -/
syntax macro_stx := command <|> tactic <|> term
/-- マクロを展開するコマンド -/
elab "#expand " "(" stx:macro_stx ")" : command => do
let t : Syntax :=
match stx.raw with
| .node _ _ #[t] => t
| _ => stx.raw
match ← Elab.liftMacroM <| Macro.expandMacro? t with
| none => logInfo m!"Not a macro"
| some t => logInfo m!"{t}"
end
/- info: notation:90 "⋄" arg✝:90 => Nat.succ arg✝ -/
#expand (prefix:90 "⋄" => Nat.succ)
proof_wanted
proof_wanted はその名の通り、証明を公募するためのコマンドです。
sorry とよく似た機能を持つコマンドです。構文的には theorem に似ていますが、証明を書く必要がありません。証明を書かないで済むという点で sorry と同様です。
import Batteries.Util.ProofWanted
variable (n : Nat)
-- proof_wanted で証明を省略できる
proof_wanted result : n + 0 = n
-- sorry で同様のことができる
theorem another_result : n + 0 = n := by sorry
register_label_attr
register_label_attr コマンドを使用すると、ラベル属性を定義することができます。
Warning
このページの内容は ボタンから Lean 4 Web で実行することができません。
使用例
ラベル属性を作るシンプルな例を示しましょう。
まず、以下のような内容のファイルを作成します。仮に RegisterLabelAttr/Lib.lean というファイル名だとします。
import Lean
register_label_attr my_tag
これで、このファイルを import しているファイルの中で @[my_tag] タグを使用することができます。
import LeanByExample.Declarative.RegisterLabelAttr.Lib
@[my_tag]
def greet := "Hello, world!"
もちろんタグとしてだけでなく attribute コマンドによっても使用可能です。
def foo := 42
attribute [my_tag] foo
タグに対する基本的な操作である、「タグが付与されている宣言をすべて集める」という操作は Lean.labelled 関数で実行することができます。
/- info: #[`greet, `foo] -/
#eval Lean.labelled `my_tag
さらに応用として、「[my_tag] 属性が付与された定理を順に apply してゴールを閉じるタクティク」を自作する例も挙げておきます。
open Lean Elab Tactic
elab "apply_my_tagged" : tactic => do
let taggedDecls ← labelled `my_tag
if taggedDecls.isEmpty then
throwError "`[my_tag]`が付与された定理はありません。"
for decl in taggedDecls do
let declStx : TSyntax `term := mkIdent decl
try
evalTactic <| ← `(tactic| apply $declStx)
-- 成功したら終了する
return ()
catch _ =>
-- 失敗したら単に次の候補に進む
pure ()
throwError "ゴールを閉じることができませんでした。"
@[my_tag]
theorem testThm (P Q : Prop) : P → Q → P ∧ Q := by
simp_all
example (P Q : Prop) : P → Q → P ∧ Q := by
apply_my_tagged
register_option
register_option は、オプションを自作するためのコマンドです。自作したオプションは set_option から設定できるようになります。
Warning
このページの内容は ボタンから Lean 4 Web で実行することができません。
使用例
たとえば、RegisterOption/Lib.lean というファイルを作成して、以下のように記述したとします。
import Lean
open Lean
register_option greeting : String := {
defValue := "Hello World"
descr := "just a friendly greeting"
}
このファイルを読み込めば、greeting というオプションを使用することができます。たとえば、以下のように使用することができます。
import LeanByExample.Declarative.RegisterOption.Lib
open Lean in
elab "#greet" : command => do
let opts ← getOptions
logInfo s!"{opts.get greeting.name greeting.defValue}"
-- デフォルト値が表示される
/- info: Hello World -/
#greet
-- オプションを設定すると
set_option greeting "Hi there"
-- 表示も変更される
/- info: Hi there -/
#greet
設定したオプションを活用する例は、Linter のページを参照のこと。
register_simp_attr
register_simp_attr は、simp タクティクで使うルールセットとタグを登録することができるコマンドで、simp ラッパとして新しいタクティクを作るのに使うことができます。
Warning
このページの内容は ボタンから Lean 4 Web で実行することができません。
使用例
以下では、型クラスによって導入される記法を定義に展開するタクティクを自作する例を示します。
このコマンドは属性タグを作るので、まず別のファイルを作って以下のように書き込みます。ファイル名は何でも良いのですが、仮に RegisterSimpAttr/Lib.lean であるとします。
import Lean
/-- `+`や`≤`など、演算子や記法を定義に展開するためのルールを登録する -/
register_simp_attr notation_simp
その後、このファイルをインポートすれば @[notation_simp] タグとルールセットが利用可能になります。以下のように、macro_rules コマンドを使用すれば simp ラッパを作成することができます。
import LeanByExample.Declarative.RegisterSimpAttr.Lib -- インポートで有効になる
section
open Lean Meta Parser.Tactic Elab.Tactic
/-- `+`や`≤`など、演算子や記法を定義に展開する -/
syntax (name := notation_simp_stx) "notation_simp" (simpArgs)? (location)? : tactic
macro_rules
| `(tactic| notation_simp $[[$simpArgs,*]]? $[at $location]?) =>
let args := simpArgs.map (·.getElems) |>.getD #[]
`(tactic| simp only [notation_simp, $args,*] $[at $location]?)
end
これで、たとえば以下のように使用することができます。
example {n m : Nat} (h : n < m) : n + 1 ≤ m := by
-- notation_simp を使わない場合の方法。
-- これを `(· < ·)` を展開したいときに毎回書く。
dsimp [(· < ·), Nat.lt] at h
assumption
@[notation_simp]
theorem Nat.lt_def (n m : Nat) : n < m ↔ (n + 1) ≤ m := by rfl
example {n m : Nat} (h : n < m) : n + 1 ≤ m := by
-- これだけで展開が行えるようになった！
notation_simp at h
assumption
notation_simp? タクティクも自作するには、次のようにすればできます。
section
open Lean Meta Parser.Tactic Elab.Tactic
@[inherit_doc notation_simp_stx]
syntax (name := notation_simp?) "notation_simp?" (simpArgs)? (location)? : tactic
macro_rules
| `(tactic| notation_simp? $[[$simpArgs,*]]? $[at $location]?) =>
let args := simpArgs.map (·.getElems) |>.getD #[]
`(tactic| simp? only [notation_simp, $args,*] $[at $location]?)
end
/-
info: Try this:
[apply] simp only [Nat.lt_def] at h
-/
example {n m : Nat} (h : n < m) : n + 1 ≤ m := by
notation_simp? at h
assumption
section
section は、有効範囲を制限するためのコマンドです。以下に挙げるような効果があります。
variableで定義された引数の有効範囲を制限する。openで開いた名前空間の有効範囲を制限する。set_optionで設定したオプションの有効範囲を制限する。localで修飾されたコマンドの有効範囲を制限する。
section コマンドで開いたセクションは end で閉じることができますが、end は省略することもできます。end を省略した場合はそのファイルの終わりまでが有効範囲となります。
なお以下の例ではセクションの中をインデントしていますが、インデントするのは一般的なコード整形ルールではありません。
以下は variable の有効範囲を区切る例です。
section
variable (a : Type)
-- 宣言したので有効
#check a
end
-- `section` の外に出ると無効になる
#check_failure a
次は open の有効範囲を区切る例です。
section
open Classical
-- open されているのでアクセスできる
#check choice
end
-- `end` 以降は無効になる
#check_failure choice
次は set_option の有効範囲を区切る例です。
section
set_option autoImplicit true
-- α が暗黙引数になる
def nilList : List α := []
end
-- `end` 以降は無効になり、α が未定義だというエラーになる
/-
error: Unknown identifier `α`
Note: It is not possible to treat `α` as an implicitly bound variable here because the `autoImplicit` option is set to `false`.
-/
def nilList' : List α := []
次は local で修飾されたコマンドの有効範囲を区切る例です。
section
-- Nat の inhabited インスタンスを上書きする
local instance : Inhabited Nat := ⟨1⟩
-- 上記のインスタンスが有効
#guard (default : Nat) = 1
end
-- セクションが終わると上記のインスタンスが無効になる
#guard (default : Nat) = 0
また、セクションに名前を付けることもできます。名前を付けた場合は、閉じるときにも名前を指定する必要があります。
section hoge
variable (a : Type)
#check a
end hoge
セクションは入れ子にすることもできます。
section parent
variable (a : Type)
section child
variable (b : Type)
-- 親セクションで定義された引数は子セクション内でも有効
#check a
end child
-- child セクションの外なので無効
#check_failure b
end parent
-- parent セクションの外なので無効
#check_failure a
set_option
set_option は、オプションを変更・設定するために使われるコマンドです。
set_option option_name value という構文で使用すれば option_name という名前のオプションの値を value に設定することができます。使用できる option_name は #help コマンドまたは Mathlib4 Help で確認できます。
有効範囲はそのセクションの内部またはそのファイルの最後までです。
/- info: ¬1 + 1 = 2 : Prop -/
#check ¬ (1 + 1 = 2)
section
-- 定義された記法を使わないように設定する
set_option pp.notation false
-- 表示される内容が変わった！
/- info: Not (Eq (HAdd.hAdd 1 1) 2) : Prop -/
#check ¬ (1 + 1 = 2)
end
-- `section` を抜けると元に戻る
/- info: ¬1 + 1 = 2 : Prop -/
#check ¬ (1 + 1 = 2)
simproc
simproc コマンドは、simproc を宣言するコマンドの一つです。
simproc は、ある式 expr にマッチする部分を見つけたときに、より単純な式 result を動的に計算し、expr = result の証明も同時に構成するような、simp タクティクから呼び出される書き換え規則のことです。
使用例
たとえば、simp タクティクには if 式に対する単純化機能が標準で備わっていますが、これを行う simproc を自前で定義してみましょう。
import Lean
import Qq
example : (if 1 = 1 then 2 else 3) = 2 := by
-- if式の単純化を行うことができる
simp
まず前段階として、標準の if と混ざらないように if 式そのものを自前で構成します。
section
variable {α : Type}
/-- 標準の`ite`(if式の内部実装)を真似て自作したもの -/
def myIte (cond : Prop) [h : Decidable cond] (t e : α) : α :=
match decide cond with
| true => t
| false => e
@[inherit_doc myIte]
notation "mif " cond " then " t " else " e => myIte cond t e
-- 動作テスト
#guard (mif 1 < 2 then 3 else 4) == 3
#guard (mif 1 = 2 then 3 else 4) == 4
variable (cond : Prop) [h : Decidable cond]
/-- 条件式が真なら、mif式は`then`部分に等しい -/
theorem myIte_cond_eq_true (t e : α) (i : cond = True) : myIte cond t e = t := by
dsimp [myIte]
have : decide cond = true := by simp_all
rw [this]
/-- 条件式が偽なら、mif式は`else`部分に等しい -/
theorem myIte_cond_eq_false (t e : α) (i : cond = False) : myIte cond t e = e := by
dsimp [myIte]
have : decide cond = false := by simp_all
rw [this]
end
続いて、simproc の本体を構成します。単に単純化の結果を返せばよいわけではなく、元の式との等価性を証明する必要があることに気を付けてください。1
open Lean Meta Simp Qq
/-- `mif`式を単純化するsimproc。 -/
simproc ↓reduceMyIte (myIte _ _ _) := .ofQ fun u α expr => do
-- パターンマッチ。`myIte _ _ _`の形であることを確認する。
-- そうでなければ即終了する。
match u, α, expr with
| 1, _, ~q(@myIte _ $cond $h $t $e) =>
-- 条件式の部分を単純化する
have simp_cond : Result := ← simp cond -- 右辺が`Qq`を使用していないので`have`を使う
have simp_cond_prop : Q(Prop) := simp_cond.expr
trace[debug] "条件式の部分が {simp_cond_prop} に単純化されました。"
-- 単純化された結果`cond`が`True`または`False`として評価されていなければ、
-- その時点で終了する
if !simp_cond_prop.isTrue && !simp_cond_prop.isFalse then
return .continue
-- 単純化なので`cond = simp_cond_prop`という命題が成り立つ。
-- その証明を取得して名前を付けておく。
have cond_eq_simp_cond : Q($cond = $simp_cond_prop) := ← simp_cond.getProof
trace[debug] "条件式に対して {← inferType cond_eq_simp_cond} という単純化が行われました。"
-- 条件式が真と評価された場合
if simp_cond_prop.isTrue then
-- このとき`simp_cond_prop`は`True`であることを`Qq`に教えておく
have : $simp_cond_prop =Q True := ⟨⟩
-- このとき`myIte cond t e = t`が成り立つので、結果の`Expr`としては`t`を返すべき。
have result_expr := t
trace[debug] "{expr} を単純化した結果は {result_expr} であるべきです。"
-- 結果の`Expr`が元の`Expr`と同じであることの証明も必要。
-- つまり`myIte cond t e = t`の証明が必要。
let target : Q(Prop) := q(myIte $cond $t $e = $t) -- 証明したい命題
trace[debug] "単純化のために {target} を証明する必要があります。"
-- `target`の証明を構成する。
-- これは定理`myIte_cond_eq_true`を使って構成できる。
let target_proof : Q($target) := q(myIte_cond_eq_true $cond $t $e $cond_eq_simp_cond)
trace[debug] "{← inferType target_proof} の証明を構成しました。"
return .visit { expr := result_expr, proof? := target_proof }
-- 条件式が偽と評価された場合(説明は省略)
if simp_cond_prop.isFalse then
have : $simp_cond_prop =Q False := ⟨⟩
have result_expr := e
let target_proof := q(myIte_cond_eq_false $cond $t $e $cond_eq_simp_cond)
return .visit { expr := result_expr, proof? := target_proof }
return .continue
| _, _, _ =>
return .continue
-- これで`[debug]`とマークされたトレースメッセージが表示される
set_option trace.debug true
/-
trace: [debug] 条件式の部分が True に単純化されました。
[debug] 条件式に対して (1 < 1 + 1) = True という単純化が行われました。
[debug] mif 1 < 2 then 3 else 4 を単純化した結果は 3 であるべきです。
[debug] 単純化のために (mif 1 < 2 then 3 else 4) = 3 を証明する必要があります。
[debug] (mif 1 < 2 then 3 else 4) = 3 の証明を構成しました。
-/
example : (mif 1 < 2 then 3 else 4) = 3 := by
simp
example : (mif 1 = 2 then 3 else 4) = 4 := by
simp
-
こちらのコードを書くにあたり、Zulip 上で Eric Wieser 氏に多くの助言をいただきました。ありがとうございました。 ↩
structure
structure は構造体を定義するためのコマンドです。構造体とは、大雑把に説明すれば複数のデータをまとめて一つの型として扱えるようにしたものです。
/-- 2次元空間の点 -/
structure Point (α : Type) : Type where
x : α
y : α
構造体を定義すると、自動的に作られる関数があります。代表的なものは以下の２つです。
- フィールドにアクセスするための関数。
- コンストラクタ。
フィールドへのアクセサはフィールドの名前で、コンストラクタは mk という名前で作られます。
-- アクセサ
#check (Point.x : {α : Type} → (Point α) → α)
#check (Point.y : {α : Type} → (Point α) → α)
def origin : Point Int := { x := 0, y := 0 }
/-- アクセサを使用する -/
example : Point.x origin = 0 := by rfl
-- コンストラクタ
#check (Point.mk : {α : Type} → α → α → Point α)
コンストラクタに mk 以外の名前を使いたい場合、:: を使って次のようにします。
structure MyProd (α : Type) (β : Type) where
gen ::
fst : α
snd : β
-- コンストラクタの名前が gen になっている
#check MyProd.gen
項を定義する様々な構文
構造体の項を定義したい場合、複数の方法があります。構造体インスタンス記法(structure instance notation) が好まれますが、フィールド名が明らかな状況であれば無名コンストラクタを使用することもあります。
-- コンストラクタを使う
def sample0 : Point Int := Point.mk 1 2
-- 構造体インスタンス記法を使う
def sample1 : Point Int := { x := 1, y := 2 }
-- 無名コンストラクタを使う
def sample2 : Point Int := ⟨1, 2⟩
-- `where` を使う
def sample : Point Int where
x := 1
y := 2
値の部分的変更
既存の構造体のフィールドの一部だけを変更した新しい構造体の項を作ることができます。
variable {α : Type} [Add α]
/-- `p : Point` の x 座標を 2 倍にする -/
def Point.doubleX (p : Point α) : Point α :=
{ p with x := p.x + p.x}
#check Point.doubleX origin
継承
既存の構造体に新しいフィールドを追加した新しい構造体を定義することができます。多重継承(複数の親を持つ構造体を作ること)も行うことができます。
structure Point3D (α : Type) extends Point α where
z : α
structure RGBValue where
red : Nat
green : Nat
blue : Nat
structure ColorPoint3D (α : Type) extends Point α, RGBValue where
z : α
舞台裏
構造体は、コンストラクタが一つしかない帰納型であると見なすことができます。
帰納型による模倣
structure コマンドを使って定義した上記の Point を、inductive コマンドで模倣してみましょう。まず mk という単一のコンストラクタだけを持つ帰納型を定義します。このコンストラクタの各引数がフィールドに相当します。
inductive Point' (α : Type) : Type where
| mk (x y : α)
アクセサ関数が自動的に作られませんが、自分で作ることができます。
-- アクセサ関数が利用できない
#check_failure Point'.x
/-- 自前で定義した `Point'` へのフィールドへのアクセサ -/
def Point'.x {α : Type} (p : Point' α) : α :=
match p with
| Point'.mk x _ => x
-- アクセサ関数が使えるようになった
#eval
let p := Point'.mk 1 2
p.x
用途
この structure コマンドの代わりに inductive コマンドを用いる方法は、定義しようとしている構造体が命題をパラメータに持っているときに必要になります。Prop の Large Elimination が許可されていないことにより、この場合はアクセサ関数が生成できないので structure コマンドが使用できず、エラーになります。
-- `w` はデータなので、アクセサ関数が生成できなくてエラーになる
/-
error: failed to generate projection `MyExists.w` for the 'Prop'-valued type `MyExists`, field must be a proof, but it has type
α
-/
structure MyExists.{v} {α : Sort v} (p : α → Prop) : Prop where
intro ::
w : α
h : p w
syntax
syntax コマンドは新しい構文を定義することができます。
import Lean
open Lean Parser
/-- `s : String` をパースして `Syntax` の項を得る。`cat` は構文カテゴリ。-/
def parse (cat : Name) (s : String) : MetaM Syntax := do
ofExcept <| runParserCategory (← getEnv) cat s
-- 最初は `#greet` などというコマンドは定義されていないので
-- そもそも Lean の合法な構文として認められない。
/- error: <input>:1:0: expected command -/
#eval parse `command "#greet"
-- `#greet` というコマンドのための構文を定義
syntax "#greet" : command
-- まだエラーになるが、少なくとも `#greet` というコマンドが Lean に認識されるようにはなった。
-- エラーメッセージは、`#greet` コマンドの解釈方法がないと言っている。
/- error: elaboration function for `«command#greet»` has not been implemented -/
#greet
Lean に構文を認識させるだけでなく、解釈させるには macro_rules などの別のコマンドが必要です。
-- `#greet` コマンドの解釈方法を定める
macro_rules
| `(command| #greet) => `(#eval "Hello, Lean!")
/- info: "Hello, Lean!" -/
#greet
パース優先順位
syntax コマンドは Lean に新しい構文解析ルールを追加しますが、導入した構文が意図通りに解釈されないことがあります。
section
/-- `a = b as T` という構文を定義 -/
local syntax term " = " term " as " term : term
/-- `a = b as T` という構文を、型 `T` 上で `a = b` が成り立つと解釈させる -/
local macro_rules
| `(term| $a = $b as $c) => `(@Eq (α := $c) $a $b)
-- メタ変数の番号を表示しない
set_option pp.mvars false
-- `1 + (1 = 2)` だと認識されてしまっている
/- info: 1 + (1 = 2) : ?_ -/
#check (1 + 1 = 2 as Nat)
end
パース優先順位(parsing precedence) を設定することで、どの構文から順に解釈されるかを指定することができ、問題を修正できることがあります。このあたりは notation コマンドと同様です。
section
-- 十分低いパース優先順位を設定する
local syntax:10 term:10 " = " term:10 " as " term:10 : term
local macro_rules
| `(term| $a = $b as $c) => `(@Eq (α := $c) $a $b)
-- 意図通りに構文解析が通るようになる
#guard (1 + 1 = 2 as Nat)
#guard (3 - 5 + 4 = 2 as Int)
-- Nat だと 3 - 5 = 0 となるので結果が変わる
#guard (3 - 5 + 4 = 4 as Nat)
end
name 構文
(name := ...) という構文により、名前を付けることができます。名前を付けると、その名前で Lean.ParserDescr の項が生成されます。実際、syntax コマンドは Lean のパーサーを拡張するコマンドであるといえます。
-- 最初は存在しない
#check_failure (hogeCmd : ParserDescr)
-- `#hoge` というコマンドを定義する
-- `name` 構文で名前を付けることができる
syntax (name := hogeCmd) "#hoge" : command
-- 構文に対して付けた名前で、ParserDescr 型の項が生成されている
#check (hogeCmd : ParserDescr)
Lean のパーサーを流用する
syntax コマンドや declare_syntax_cat コマンドで生成された Lean のパーサーを利用して、String を引数に取るようなパーサーを定義することができます。1
具体例を挙げましょう。まず Syntax.lean というファイルを作成して次のように書きます。
-- # Syntax.lean ファイル
/-- 2項演算の集合 -/
inductive Op where
/-- 加法 -/
| add
/-- 乗法 -/
| mul
deriving DecidableEq, Repr
/-- 数式 -/
inductive Arith where
/-- 数値リテラル -/
| val (n : Nat) : Arith
/-- 演算子の適用 -/
| app (op : Op) (lhs rhs : Arith) : Arith
deriving DecidableEq, Inhabited, Repr
section arith_syntax
/-- `Arith` のための構文カテゴリ -/
declare_syntax_cat arith
/-- `Arith` を見やすく定義するための構文 -/
syntax "[arith| " arith "]" : term
-- 数値リテラルは数式
syntax:max num : arith
-- 数式を `+` または `*` で結合したものは数式
-- `+` と `*` のパース優先順位を指定しておく
syntax:30 arith:30 " + " arith:31 : arith
syntax:35 arith:35 " * " arith:36 : arith
-- 数式を括弧でくくったものは数式
syntax:max "(" arith ")" : arith
end arith_syntax
macro_rules
| `([arith| $n:num ]) => `(Arith.val $n)
| `([arith| $l:arith + $r:arith]) => `(Arith.app Op.add [arith| $l] [arith| $r])
| `([arith| $l:arith * $r:arith]) => `(Arith.app Op.mul [arith| $l] [arith| $r])
| `([arith| ($e:arith) ]) => `([arith| $e ])
次に、Environment.lean というファイルを作成して次のように書きます。
-- # Environment.lean ファイル
import LeanByExample.Declarative.Syntax.Syntax
import Lean
open Lean
/-- import先のファイル名 -/
private def fileName : Name := `LeanByExample.Declarative.Syntax.Syntax
/-- `Arith`のための構文とマクロの定義が終わった直後の状態の`Environment` -/
initialize env_of_arith_stx : Environment ← do
-- コンパイル時にLeanにoleanファイルを見つけさせるために必要
initSearchPath (← findSysroot)
-- importModulesの前で初期化を許可する必要がある
unsafe Lean.enableInitializersExecution
importModules #[{module := fileName}] {} (loadExts := true)
そうすると、以下のように Lean のパーサーとマクロ展開ルールを利用して String 上のパーサーを定義することができます。
-- Parser.lean ファイル
import LeanByExample.Declarative.Syntax.Environment
open Lean Elab Term Command
/-- Leanのマクロ展開ルールを使って、`input : String` から `Arith` の項を生成する -/
def TermElabM.parseArith (input : String) : TermElabM (Except String Arith) := do
let stx := Parser.runParserCategory env_of_arith_stx `term s!"[arith| {input}]"
match stx with
| .error err => return Except.error err
| .ok stx =>
let result ← unsafe evalTerm Arith (.const ``Arith []) stx
return Except.ok result
/-- `TermElabM` に包まれた値をむりやり取り出す -/
unsafe def TermElabM.unsafeRun {α : Type} [Inhabited α] (env : Environment) (m : TermElabM α) : α :=
let core := liftCommandElabM <| liftTermElabM m
let ctx : ContextInfo := { env := env, fileMap := ⟨"", #[]⟩, ngen := { } }
let io := ContextInfo.runCoreM ctx core
match unsafeIO io with
| .error e => panic! s!"{e}"
| .ok a => a
/-- 文字列をパースして`Arith`の項を生成する -/
def parseArith (s : String) : Except String Arith := unsafe
TermElabM.unsafeRun env_of_arith_stx (TermElabM.parseArith s)
-- パーサーのテストのためのコード
section ParserTest
open Arith
instance : ToString Op where
toString := fun op =>
match op with
| Op.add => "+"
| Op.mul => "*"
/-- `Arith`を文字列化する。ただし、全体を括弧で囲う。-/
protected def Arith.toStringAux (arith : Arith) : String :=
match arith with
| Arith.val n => toString n
| Arith.app op lhs rhs =>
"(" ++ Arith.toStringAux lhs ++ s!" {op} " ++ Arith.toStringAux rhs ++ ")"
protected def Arith.toString (arith : Arith) : String :=
match arith with
| Arith.val n => toString n
| Arith.app op lhs rhs =>
Arith.toStringAux lhs ++ s!" {op} " ++ Arith.toStringAux rhs
instance : ToString Arith where
toString := Arith.toString
private def testParseArith (input : String) (expected : Arith) : IO Unit := do
let .ok actual := parseArith input
| throw <| .userError s!"{input} のパースに失敗しました"
if expected != actual then
throw <| .userError s!"{input} のパース結果が期待値と一致しません。期待値: {expected}, 実際の値: {actual}"
IO.println s!"✅ テスト成功!"
#eval testParseArith "1 + 2" (app Op.add (val 1) (val 2))
#eval testParseArith "3 * (4 + 5)" (app Op.mul (val 3) (app Op.add (val 4) (val 5)))
end ParserTest
-
このコード例を用意するにあたって、伊勢村哲司さんおよび Adam Topaz さんにご助力をいただきました。ありがとうございました。 ↩
theorem
theorem は名前付きで命題を証明するためのコマンドです。より正確には、theorem は証明項を定義するためのコマンドだといえます。
/-- 自然数に右から0を足しても変わらない -/
theorem add_zero {n : Nat} : n + 0 = n := by simp
-- `add_zero` という項の型が、命題の内容になっている
#check (add_zero : ∀ {n : Nat}, n + 0 = n)
def との違い
theorem コマンドは特定の型を持つ項を定義するという意味で、def と同じです。実際、def を使っても証明項を定義することは可能です。しかし theorem を使っても関数などを定義することはできません。theorem で宣言できる項は命題のみです。
def add_zero' {n : Nat} : n + 0 = n := by simp
/-
error: type of theorem `frac` is not a proposition
Nat → Nat
-/
theorem frac (n : Nat) : Nat :=
match n with
| 0 => 1
| n + 1 => (n + 1) * frac n
universe
universe は、宇宙レベルを表す変数を宣言するコマンドです。universe u と宣言すると、そのスコープ内で u を宇宙変数として使えるようになります。
universe u
#check (Type u)
ここで 宇宙(universe) とは、項が再び型であるような型のことです。たとえば Nat や Bool は型ですが、Lean ではそのような型も項として扱われ、Type という型を持ちます。
#check (Nat : Type)
#check (Bool : Type)
Type 自身も型ですが、Type : Type ではなく Type : Type 1 です。Type 1 の型は Type 2 です。以下、Type 2 の型は Type 3 等と無限に続きます。
#check (Type : Type 1)
#check (Type 1 : Type 2)
#check (Type 2 : Type 3)
一般に Type u の型は Type (u + 1) になります。
#check (Type u : Type (u + 1))
宇宙多相
宇宙変数 u を明示的に宣言することによって、定義を 宇宙多相(universe polymorphic) にすることができます。複数の型宇宙で同じように動作する定義が得られるということです。Type u を使えば Type 上で宇宙多相にできますし、Sort u を使えば Prop も含めることができます。
例: Size 型クラス
たとえば、size という関数を提供する以下のような型クラスを考えてみます。1
class Size (A : Type u) where
size : A → Nat
export Size (size)
配列やリストなどのコレクションの大きさを取得する統一的な手段を提供する型クラスというイメージです。
instance : Size (List A) where
size l := l.length
instance : Size (Array A) where
size a := a.size
#guard size [1, 2, 3] = 3
#guard size #["a", "b", "c"] = 3
この size 関数を型に対しても適用できるようにしたいと思ったとします。size Bool = 2 や size Unit = 1 といった具合にです。
この場合最も直接的な実装は Type に対して Size のインスタンスを定義することですが、任意の A : Type に対してそのサイズを計算することは不可能であるため、この方法では実装できません。
instance : Size (Type u) where
size A := sorry -- 実装を与える方法がない
Size の実装を与える型を選択できるようにしなければいけないので、size 関数の引数となる型を Size の定義に含めるように書き直します。
/-- 書き直した Size 型クラス -/
class Size {A : Type u} (a : A) where
size : Nat
export Size (size)
instance (l : List A) : Size l where
size := l.length
instance (a : Array A) : Size a where
size := a.size
#guard size [1, 2, 3] = 3
#guard size #["a", "b", "c"] = 3
このようにすると、size 関数を型に対しても定義できるようになります。
instance : Size Bool where
size := 2
instance : Size Unit where
size := 1
#guard size Bool = 2
#guard size Unit = 1
上記の Size 型クラスの定義では、宇宙多相であることが必要です。実際に推論された宇宙レベルを表示してみると、異なる宇宙レベルが使用されていることがわかります。.{u} と表示されている部分が宇宙レベルを表しています。
-- 推論された宇宙レベルを表示する
set_option pp.universes true
/- info: size.{1} Bool : Nat -/
#check size Bool
/- info: size.{0} (List.cons.{0} 1 List.nil.{0}) : Nat -/
#check size [1]
例: *.rec
Lean の標準ライブラリにある例でいうなら、帰納型を定義したときに自動生成される *.rec という関数も宇宙多相です。定義を見ると、.{u} と書かれており宇宙多相であることがわかります。
/-
info: Nat.rec.{u} {motive : Nat → Sort u} (zero : motive Nat.zero) (succ : (n : Nat) → motive n → motive n.succ) (t : Nat) :
motive t
-/
#check Nat.rec
単に宇宙多相であるだけでなく、この関数は宇宙多相であることが必要な例になっています。
以下のように、u = 0 とすれば Sort 0 = Prop なので証明に使うことができます。
theorem Nat.add_zero' (n : Nat) : n + 0 = n :=
Nat.rec
(motive := fun (n : Nat) => n + 0 = n)
(by simp)
(fun n ih => by simp)
n
そして、u = 1 とすれば Sort 1 = Type なのでデータを扱う普通の関数が定義できます。
/-- 階乗関数 -/
def Nat.factorial (n : Nat) : Nat :=
Nat.rec
(motive := fun (_ : Nat) => Nat)
1
(fun n ih => (n + 1) * ih)
n
#guard Nat.factorial 5 = 120
なお帰納法と再帰が両方とも *.rec という同じ関数で実現できるのは偶然ではなく、カリー・ハワード同型対応によって「帰納法は再帰」と言えるからです。
-
この
Size型クラスを実装して宇宙多相にする例は、Scientific Computing in Leanの TypeClasses as Interfaces and Function Overloading という章で紹介されている例をそのまま使用しています。 ↩
variable
variable は、定理や関数の引数を宣言するためのコマンドです。
たとえば以下の関数と命題に対して、引数の α : Type と l : List α は共通です。
/-- リストが空であるか判定する -/
def isNil {α : Type} (l : List α) : Bool :=
match l with
| [] => true
| _ => false
theorem nng_list_length {α : Type} (l : List α) : l.length ≥ 0 := by simp
variable コマンドを利用すると、共通の引数を宣言してまとめておくことができます。
variable {α : Type} (l : List α)
def isNil : Bool :=
match l with
| [] => true
| _ => false
theorem nng_list_length : l.length ≥ 0 := by simp
theorem と def での取り込み基準の違い
variable コマンドの挙動は theorem と def で異なります。
theorem コマンドに対しては、定理の型（つまり主張）に現れる変数だけを自動で引数にします。
一方で、def コマンドに対しては、本体に現れる変数も自動で引数にします。
variable (n : Nat)
-- 定理の主張には `m` しか現れていないので、`n` は引数として取り込まれない
/-
error: Unknown identifier `n`
-/
theorem foo (m : Nat) : m = m :=
have : n = n := by rfl
rfl
-- 引数は１つだけ
#check (foo : ∀ m : Nat, m = m)
-- `n` は証明の中にしか現れないが、引数として取り込まれる
def foo' (m : Nat) : m = m :=
have : n = n := by rfl
rfl
-- その証拠に `foo'` には引数が２つある
#check (foo' : ∀ (_n m : Nat), m = m)
明示的に引数に含めるには、include コマンドを使用します。
variable (n : Nat)
include n
theorem foo_included (m : Nat) : m = m :=
have : n = n := by rfl
rfl
-- `n` が引数として含まれた結果
-- 引数が２つになっている
#check (foo_included : ∀ (_n m : Nat), m = m)
再帰と variable
variable コマンドで宣言された引数は、再帰呼び出しの中でも同じ値が使用されます。
したがって、再帰関数の再帰呼び出しで変化する引数を variable で共通化することはできません。
variable {α : Type} (l : List α)
def List.myLength : Nat :=
match l with
| [] => 0
| _ :: xs => by
-- `List.myLength` の型が `List α → Nat` ではなくて、
-- `Nat` になってしまっている。
-- 引数の `List α` の部分には固定された値が入ってしまっているため
guard_hyp List.myLength : Nat
sorry
修飾子
本書では、必ず前後にトップレベルコマンドが続いて、そのコマンドに影響を与える構文要素のことを便宜的に修飾子と呼んでいます。
ドキュメントコメント
Lean では、/-- と -/ で囲まれた部分がドキュメントコメントとして扱われます。
ドキュメントコメントは、コードをわかりやすくするのに役立ちます。直後に来る関数や定義を修飾して、そこに書かれた内容がマウスオーバーしたときに表示されます。
/-- 階乗関数 -/
def Nat.factorial (n : Nat) : Nat :=
match n with
| 0 => 1
| n + 1 => (n + 1) * Nat.factorial n
なお、「コメント」を「コードの動作に影響を与えない人間向けの説明文」と定義するのであれば、Lean のドキュメントコメントはコメントではありません。誤った場所にドキュメントコメントを配置するとエラーになります。
import Lean
open Lean Parser in
/-- `s : String` をパースして `Syntax` の項を得る。`cat` は構文カテゴリ。-/
def parse (cat : Name) (s : String) : MetaM Syntax := do
ofExcept <| runParserCategory (← getEnv) cat s
-- ドキュメントコメントで `namespace` を修飾しようとすると構文エラーになる
/-
error: <input>:1:21: expected '#guard_msgs', 'abbrev', 'add_decl_doc', 'axiom', 'binder_predicate', 'builtin_cbv_simproc', 'builtin_cbv_simproc_decl', 'builtin_dsimproc', 'builtin_dsimproc_decl', 'builtin_grind_propagator', 'builtin_initialize', 'builtin_simproc', 'builtin_simproc_decl', 'cbv_simproc', 'cbv_simproc_decl', 'class', 'coinductive', 'declare_command_config_elab', 'declare_command_config_elab_legacy', 'declare_config_elab', 'declare_config_elab_legacy', 'declare_core_config_elab', 'declare_simp_like_tactic', 'declare_syntax_cat', 'declare_term_config_elab', 'def', 'def_eval_config_item', 'dsimproc', 'dsimproc_decl', 'elab', 'elab_rules', 'example', 'grind_propagator', 'inductive', 'infix', 'infixl', 'infixr', 'initialize', 'instance', 'macro', 'macro_rules', 'notation', 'opaque', 'postfix', 'prefix', 'recommended_spelling', 'register_builtin_option', 'register_error_explanation', 'register_grind_attr', 'register_label_attr', 'register_linter_set', 'register_option', 'register_simp_attr', 'register_sym_simp_attr', 'register_tactic_tag', 'register_try?_tactic', 'simproc', 'simproc_decl', 'structure', 'syntax', 'tactic_extension', 'theorem' or 'unif_hint'
-/
#eval parse `command "/-- これはドキュメントコメント -/ namespace Foo"
ドキュメントコメントを扱う例
ドキュメントコメントは Lean に無視されるわけではなく、他の構文要素と同様にパースされます。したがって特にコードの中で扱うことができます。
たとえば、ドキュメントコメントを取得して内容を表示するコマンドを書くことができます。
import Lean.Elab.Command
open Lean Elab Command in
/-- ドキュメントコメントを取得して表示するコマンド -/
elab "#doc " x:ident : command => do
let name := x.getId
if let some s ← findDocString? (← getEnv) name then
logInfo m!"{s}"
/-
info: Linked lists: ordered lists, in which each element has a reference to the next element.
Most operations on linked lists take time proportional to the length of the list, because each
element must be traversed to find the next element.
`List α` is isomorphic to `Array α`, but they are useful for different things:
* `List α` is easier for reasoning, and `Array α` is modeled as a wrapper around `List α`.
* `List α` works well as a persistent data structure, when many copies of the tail are shared. When
the value is not shared, `Array α` will have better performance because it can do destructive
updates.
-/
#doc List
補足：コメントはパースされている
なお、ドキュメントコメントに限らず、Lean のコメントはパーサに無視されません。ただ実行内容を持たず、コードの動作に影響を与えないだけです。
import Lean.Elab.Command
open Lean Elab Command Parser
/-
info: def foo :
-- ここにコメント
/- ここにもコメント -/
True :=
trivial
-/
run_cmd liftTermElabM do
let s := "def foo : \n\
-- ここにコメント\n\
/- ここにもコメント -/\n\
True := trivial"
let cmd : Command := ⟨← ofExcept <| runParserCategory (← getEnv) `command s⟩
logInfo (← PrettyPrinter.ppCommand cmd)
decreasing_by
decreasing_by は、再帰関数などの停止性（計算が無限に続くことがなく、値が一意に決まること）を示し、Lean に定義を受け入れさせるために使われます。
使用例
たとえば、以下の関数はそのままでは Lean が停止性を示せないためエラーになってしまいます。
-- エラーになってしまう
/-
error: fail to show termination
-/
def Nat.toListNat (n : Nat) : List Nat :=
if n == 0 then
[]
else
Nat.toListNat (n / 10) ++ [(n % 10)]
decreasing_by に続けて停止することの証明を与えれば Lean に受け入れられるようになります。再帰のたびに(無限には減少できない)引数が真に減少することを示せば十分です。
def Nat.toListNat (n : Nat) : List Nat :=
if n == 0 then
[]
else
Nat.toListNat (n / 10) ++ [(n % 10)]
decreasing_by
-- `n ≠ 0 → n / 10 < n` を示す
guard_target =ₛ n / 10 < n
grind
-- 動作テスト
#guard Nat.toListNat 1234 = [1, 2, 3, 4]
あるいは、decreasing_by を使用しなくても、関数内で have などを使って停止性を証明しておいても良いです。
def Nat.toListNat (n : Nat) : List Nat :=
if h : n == 0 then
[]
else
have : n / 10 < n := by
grind
Nat.toListNat (n / 10) ++ [(n % 10)]
部分関数を禁止するのはなぜか？
そもそもなぜ Lean では関数の停止性を示す必要があるのでしょうか？それは、Lean の論理体系の健全性を保つためです。1
カリー・ハワード同型対応によれば「帰納法は再帰」なので、停止しない再帰を許すことは直接的に「終了しない帰納法」を許すことに繋がり、矛盾をもたらすことになってしまいます。
-- unsafe を使うと終わらない帰納法が使えるので、何でも証明できる
unsafe def loop_thm (P : Prop) : P :=
loop_thm P
unsafe example : False := loop_thm False
定理ではなくて通常の関数の場合も、停止しない関数を野放図に許すと矛盾を導くことができます。例として、以下の「Option 値の点列から some であるようなものを探す関数」を考えてみましょう。この関数は引数の点列の f がいつか some になる保証がないので、無限に計算が終わらない可能性があります。
variable {α : Type}
/-- 点列 `f : Nat → Option α` が `some` を返すような最初の `f n` を返す -/
unsafe def search (f : Nat → Option α) (start : Nat) : α :=
match f start with
| .some x => x
| .none => search f (start + 1)
ここで問題なのは、この関数 search を使うと任意の型の項が構成できてしまうということです。
-- `α` は任意なので、どんな型の項でも作れることになる
unsafe def anything : α := search (fun _ => none) 0
したがって特に Empty 型の項を作ることもできて、カリー・ハワード同型対応により「型の項を作る」ことは「命題を証明する」ことに対応するので、矛盾が導かれたことになってしまいます。
unsafe example : False := by
have _ : Empty := anything
contradiction
-
ここで紹介している例は Joachim Breitner さんによる Recursive definitions in Lean というブログ記事から引用しています。 ↩
local
local はコマンドをそのセクションの内部でだけ有効にするための修飾子です。
section foo
-- local を付けて新しい記法を定義
local notation " succ' " => Nat.succ
-- section の中では使用できる
#check succ'
end foo
-- section を抜けると使えなくなる
#check_failure succ'
section foo
-- 同じ名前の section を再度開いても使えない
#check_failure succ'
end foo
コマンドの有効範囲を namespace の内部に限定するのにも使えます。ただし、下記のコードで示しているように、local で修飾したコマンドの効果は同じ名前空間の中で永続するのではなく、end でその名前空間が閉じられたときに消失します。
namespace hoge
-- local を付けて新しい記法を定義
local notation " succ' " => Nat.succ
-- 定義した namespace の中では使用できる
#check succ' 2
end hoge
-- namespace の外では使用できない
#check_failure succ' 2
-- 再び同じ名前の namespace をオープンする
namespace hoge
-- 使用できない！
#check_failure succ'
end hoge
修飾可能なコマンド
local で有効範囲を限定できるコマンドには、次のようなものがあります。
elab,elab_rulesinfix,infixl,infixrmacro,macro_rulesnotationpostfixprefixinstancesyntax- などなど
リストの全体は、local の後に修飾できないコマンドを続けたときのエラーメッセージで確認できます。
open Lean Parser in
/-- `s : String` をパースして `Syntax` の項を得る。`cat` は構文カテゴリ。-/
def parse (cat : Name) (s : String) : MetaM Syntax := do
ofExcept <| runParserCategory (← getEnv) cat s
-- `def` は有効範囲を制限できないのでエラーになる
/-
error: <input>:1:6: expected 'binder_predicate', 'builtin_cbv_simproc', 'builtin_dsimproc', 'builtin_simproc', 'cbv_simproc', 'def_eval_config_item', 'dsimproc', 'elab', 'elab_rules', 'grind_pattern', 'infix', 'infixl', 'infixr', 'instance', 'macro', 'macro_rules', 'notation', 'postfix', 'prefix', 'simproc', 'syntax' or 'unif_hint'
-/
#eval parse `command "local def"
数が多いためすべての例を挙げることはしませんが、いくつか紹介します。たとえば instance の場合、local を付けて登録したインスタンスがそのセクションの内部限定になります。
inductive MyNat : Type where
| zero : MyNat
| succ : MyNat → MyNat
section
-- local を付けてインスタンスを定義
local instance : OfNat MyNat 0 where
ofNat := MyNat.zero
-- その section の中では使用できる
#check (0 : MyNat)
end
-- section を抜けると使えなくなる
#check_failure (0 : MyNat)
属性に対する local
属性付与の効果範囲を限定するためには、attribute コマンドを local で修飾するのではなく、attribute コマンドの中で local を使います。
def MyNat.add (n m : MyNat) : MyNat :=
match m with
| zero => n
| succ m => succ (MyNat.add n m)
theorem MyNat.zero_add (n : MyNat) : MyNat.add .zero n = n := by
induction n with
| zero => rfl
| succ n ih => simp [MyNat.add, ih]
section
-- [simp] 属性をローカルに付与する
attribute [local simp] MyNat.zero_add
-- その section の中では使用できる
example : MyNat.add .zero .zero = .zero := by
simp
end
-- section を抜けると simp 補題が利用できなくなる
example : MyNat.add .zero .zero = .zero := by
-- 使えないのでエラーになる
fail_if_success simp
rw [MyNat.zero_add]
構文的な性質
attrKind のドキュメントコメントに次のように書かれている通り、local と scoped はともに構文的には attrKind に相当します。
attrKindmatches("scoped" <|> "local")?, used before an attribute like@[local simp].
/-- 例示のための意味のないコマンド。直前に `attrKind` のみを受け付ける。-/
macro attrKind "#greet " : command => `(#eval "hello")
-- パース出来るので、`local` と `scoped` は同じカテゴリに属する
local #greet
scoped #greet
noncomputable
noncomputable は、宣言された関数が計算可能でないことを Lean に伝えるために使われます。
Lean は、def コマンドで定義された関数はすべて計算可能であると想定しています。したがって、計算可能でない関数を定義すると、エラーが発生します。
計算可能でない関数が生じるのは、選択原理 Classical.choice を使用したときです。選択原理は、型が「空ではない」という証明だけから、その型の項を魔法のように構成できると主張している公理です。Prop の証明無関係という特性により、空ではないという情報から具体的な項の情報は得られないため、選択原理を使用した関数は計算不能になります。
variable {X Y : Type}
-- 写像 `f : X → Y` が全射であること
def Surjective (f : X → Y) : Prop := ∀ y, ∃ x, f x = y
-- 全射な関数の逆写像を構成する
-- しかし、全射という情報だけからは逆写像を具体的に作ることはできないので、
-- 計算不能になりエラーになってしまう
/-
error: `Classical.choice` not supported by code generator; consider marking definition as `noncomputable`
-/
def inverse' (f : X → Y) (hf : Surjective f) : Y → X := by
-- `y : Y` が与えられたとする
intro y
-- `f` は全射なので `{x // f x = y}` は空ではない
have : Nonempty {x // f x = y} := by
let ⟨x, hx⟩ := hf y
exact ⟨⟨x, hx⟩⟩
-- 選択原理を用いて、`f x = y` なる `x : X` を構成する
have x := Classical.choice this
exact x.val
-- `noncomputable` という修飾子を付ければ、エラーは回避できる
noncomputable def inverse (f : X → Y) (hf : Surjective f) : Y → X := by
intro y
have : Nonempty {x // f x = y} := by
let ⟨x, hx⟩ := hf y
exact ⟨⟨x, hx⟩⟩
have x := Classical.choice this
exact x.val
noncomputable とマークされた式を含む式は文字通り評価不能になり、#eval に渡すことができなくなります。
-- 補助として `id` という恒等写像が全射であることを示しておく
theorem id_surjective : Surjective (id : Nat → Nat) := by
intro y
exists y
-- `id` の逆写像を構成する
noncomputable def id_inverse := inverse (id : Nat → Nat) id_surjective
-- 逆写像の `3` での値を評価しようとするとエラーになる
/-
error: failed to compile definition, consider marking it as 'noncomputable' because it depends on 'id_inverse', which is 'noncomputable'
-/
#eval id_inverse 3
partial_fixpoint
partial_fixpoint は、partial と同様に「すべての入力に対して必ずしも停止しないような関数」を定義することを可能にしますが、partial とは異なり定義した関数を証明に使うことが可能です。
variable {α : Type}
/-- `partial` で定義された検索関数 -/
partial def searchP (f : Nat → Option α) (start : Nat) : Option Nat :=
match f start with
| some _ => some start
| none => searchP f (start + 1)
/-- `partial_fixpoint` で定義された検索関数 -/
@[grind]
def searchF (f : Nat → Option α) (start : Nat) : Option Nat :=
match f start with
| some _ => some start
| none => searchF f (start + 1)
partial_fixpoint
-- `partial` で定義した関数は証明に使うことができない
example (f : Nat → Option α) (n : Nat) (h : (f n).isSome) : (searchP f n).isSome := by
induction n with
| zero =>
-- 全く展開することができず、上手くいかない
fail_if_success unfold searchP
sorry
| succ n ih =>
sorry
-- `searchF` に関しては証明ができる
example (f : Nat → Option α) (n : Nat) (h : (f n).isSome) : (searchF f n).isSome := by
induction n with
| zero =>
unfold searchF
grind
| succ n ih => grind
名前の由来
partial_fixpoint という名前を見て、partial の部分は納得がいくと思います。部分関数(partial function)を定義するための修飾子だからです。では fixpoint の部分は何でしょうか？
これを説明するためには、再帰関数について考える必要があります。たとえば、階乗関数を考えてみましょう。
/-- 階乗関数 -/
def Nat.factorial (n : Nat) : Nat :=
match n with
| 0 => 1
| n + 1 => (n + 1) * factorial n
「引数として n + 1 を渡すと、自分自身を再帰的に呼びだす」という構造を持っています。#print equations コマンドを使うと、ここで定義された関数がどのような関数等式を満たしているかを確認することができます。
/-
info: equations:
@[backward_defeq] theorem Nat.factorial.eq_1 : Nat.factorial 0 = 1
@[backward_defeq] theorem Nat.factorial.eq_2 : ∀ (n_2 : Nat), n_2.succ.factorial = (n_2 + 1) * n_2.factorial
-/
#print equations Nat.factorial
「重要なのはこの関数等式であって、定義の仕方自体は表面的なものである」という視点に立つことができます。Nat.factorial とは、上記の関数等式を満たす何者かであればよいということです。そう考えると、関数等式さえ表現できるのであれば別の定義の仕方がありえることになります。
そこで、たとえば次のような高階関数を考えてみます。
def factBody (f : Nat → Nat) : Nat → Nat :=
fun n =>
match n with
| 0 => 1
| n + 1 => (n + 1) * f n
このようにすると、Nat.factorial が満たしていた関数等式 f 0 = 1 ∧ f (n + 1) = (n + 1) * f n は、f = factBody f という等式に置き換えることができます。
example (f : Nat → Nat) (h : f = factBody f) : f 0 = 1 := calc
_ = factBody f 0 := by rw [h]; grind
_ = 1 := rfl
example (f : Nat → Nat) (h : f = factBody f)
: ∀ n : Nat, f (n + 1) = (n + 1) * f n := by
intro n
calc
_ = factBody f (n + 1) := by rw [h]; grind
_ = (n + 1) * f n := rfl
つまり、階乗関数を「f = factBody f を満たす f」として定義することができるというわけです。
ここで f = factBody f という等式をよく見ると、f が factBody という高階関数の不動点(fixpoint)であると主張していることがわかります。ここでは階乗関数を具体例にしましたが、一般に再帰関数は関数の不動点として捉えられることが知られています。partial_fixpoint の名前は、まさにこの「再帰関数は不動点である」という考え方に由来します。
健全性が保たれるための条件
partial_fixpoint で修飾すれば停止性を証明しなくても許される関数と、そうではない関数があります。どんな関数でも partial_fixpoint で修飾すれば見逃してもらえるわけではありません。
/-
error: failed to compile definition 'search' using `partial_fixpoint`, could not prove that the type
{α : Type} → (Nat → Option α) → Nat → α
is nonempty.
-/
/-- 点列 `f : Nat → Option α` が `some` を返すような最初の `f n` を返す -/
def search (f : Nat → Option α) (start : Nat) : α :=
match f start with
| .some x => x
| .none => search f (start + 1)
partial_fixpoint
許される関数とそうでない関数の違いはどこにあるのでしょうか？実は、partial_fixpoint で修飾することができる関数は、大まかに次の２つの条件のどちらかを満たすものです。1
1-A 返り値の型が Inhabited とは
返り値の型が Inhabited でなければならない、という条件がなぜ必要なのかを見るには、以下のような例を考えると良いでしょう。
unsafe def empty_loop : Empty := empty_loop
unsafe example : False := by
exact empty_loop.elim
停止性の保証なしに再帰関数 f : A → B の定義を許すと、f を使って B の項を作ることができてしまう可能性があります。したがって、B が Inhabited でなければ、矛盾が導かれる可能性があります。これを禁止するのはもっともなことでしょう。
なお、例外として定義域の型も空である場合は、返り値の型が Inhabited でなくても partial_fixpoint で修飾することができるようです。これはカリー・ハワード同型対応から言えば「矛盾を仮定すれば矛盾が示せる」ことに相当し、論理的には妥当なものの応用はないかもしれません。
/-- 停止しないし返り値の型は空だが、`partial_fixpoint` で修飾できる関数 -/
def f : Empty → Empty :=
fun x => f x
partial_fixpoint
1-B 末尾再帰的とは
再帰関数 f : A → B が末尾再帰的でなければならない、という条件がなぜ必要なのか見るために、以下の例を見てください。
/-- 末尾再帰的でない、停止しない関数 -/
unsafe def nonTR_loop (n : Nat) : Nat :=
1 + nonTR_loop n
-- nonTR_loop の定義から、以下の関数等式が成り立つはず
-- (deep recursion になるので証明できず、やむを得ず axiom としている)
unsafe axiom nonTR_loop.def (n : Nat) : nonTR_loop n = 1 + nonTR_loop n
-- 矛盾が導かれる
unsafe example : False := by
have lem : ∀ x, x ≠ 1 + x := by
intro x
grind
let y := nonTR_loop 0
have : y = 1 + y := by
dsimp [y]
rw [← nonTR_loop.def 0]
exact lem y this
返り値の型 Nat は当然ながら Inhabited ですが、末尾再帰的でなかったために、関数等式 f x = 1 + f x を満たす関数 f が存在することになってしまい、そんな自然数 f x は存在しないので矛盾が導かれてしまいました。
もしこれが末尾再帰的であれば、どうだったか？を考えるとより明確になります。たとえば以下の例を考えてみましょう。
/-- 末尾再帰的な、停止しない再帰関数 -/
def tr_loop (n : Nat) : Nat :=
tr_loop (n + 1)
partial_fixpoint
f 0 = f 1 = f 2 = ... という関数等式を満たす f は確かに一意には定まらない（再帰が停止しないため）のですが、この関数の存在を仮定しても矛盾が導かれることはありません。なぜなら、定数関数という解がきちんと存在するからです。partial_fixpoint は、この関数 tr_loop の値を具体的に特定することなく、ただ tr_loop n = tr_loop (n + 1) という関数等式を満たす何者かであるとするだけなので、矛盾が導かれることはありません。
-- tr_loop の定義から得られるのは以下の関数等式だけ
/-
info: equations:
theorem tr_loop.eq_1 : ∀ (n : Nat), tr_loop n = tr_loop (n + 1)
-/
#print equations tr_loop
これだけでは「なぜ末尾再帰なら大丈夫なのか」の完全な説明にはなっていませんが、とりあえず以上の例から「末尾再帰なら、f x = f y という形の等式が得られるだけなので、関数が停止しなくても値が一意に定まらなくなるだけで矛盾は生じない」ということが窺えるのではないでしょうか。
用途
通常 Lean で再帰関数を定義する際には「停止性を証明できるチャンスは定義したその瞬間だけ」ですが、partial_fixpoint を利用すると「定義した後で停止性を証明する」ことができます。2
/-- McCarthy の 91 関数の返り値を `Option` で包んだもの。
返り値を `Option` で包んであるので、`partial_fixpoint` で定義を通すことができる。-/
def f91? (n : Nat) : Option Nat :=
if n > 100 then
some (n - 10)
else do
let m ← f91? (n + 11)
f91? m
partial_fixpoint
@[simp]
theorem f91?_91 : f91? 91 = some 91 := by cbv
@[simp]
theorem f91?_spec_true (n : Nat) (h : 100 < n) :
f91? n = some (n - 10) := by
unfold f91?
simp [h]
@[simp]
theorem f91?_spec_false (n : Nat) (h : n ≤ 100) :
f91? n = some 91 := by
unfold f91?
rw [ite_eq_right (by omega)]
by_cases hn : n < 90
· rw [f91?_spec_false (n + 11) (by omega)]
simp
· simp [f91?_spec_true (n + 11) (by omega)]
by_cases h100 : n = 100
· simp [h100]
· exact f91?_spec_false (n + 1) (by omega)
termination_by 100 - n
theorem f91?_spec (n : Nat) :
f91? n = some (if n ≤ 100 then 91 else n - 10) := by
grind only [= f91?_spec_false, = f91?_spec_true]
/-- `f91?` は必ず停止する -/
theorem f91?_total (n : Nat) : f91? n |>.isSome := by
simp [f91?_spec]
-- 停止性が保証できたので、`Option` を外すことができる
def f91 (n : Nat) : Nat :=
(f91? n).get (f91?_total n)
-
Lean 公式リファレンスの「Partial Fixpoint Recursion」の項目を参照：https://lean-lang.org/doc/reference/latest/Definitions/Recursive-Definitions/#partial-fixpoint ↩
-
この例と証明は、F91 in Lean という Joachim Breitner さんのブログ記事を参考にしました。 ↩
partial
partial は部分関数(partial function)を定義するための修飾子です。部分関数とは、全ての入力に対しては必ずしも停止しないような関数のことです。
Lean では再帰関数も再帰的でない関数と同様に定義できますが、扱いは異なります。再帰的な関数 f を定義すると、Lean は f がすべての入力に対して必ず有限回の再帰で停止することを証明しようとします。自動的な証明が失敗すると、エラーになってしまいます。（そもそもなぜ部分関数が許可されないのかについては部分関数を禁止するのはなぜか？を参照のこと。）
-- 何も指定しないと、停止することが Lean にはわからないのでエラーになる
/-
error: fail to show termination for
WithoutPartial.M
-/
/-- McCarthy の 91 関数 -/
def M (n : Nat) : Nat :=
if n > 100 then
n - 10
else
M (M (n + 11))
エラーを消すには、以下のどちらかの対応が必要です。
- 停止することを手動で証明するか。
- 停止性は保証しないと明示的にマークするか。
関数の定義に partial とマークすると、停止性は保証しないとマークしたことになります。
-- `partial` を使うと、停止性の証明が不要になる
partial def M (n : Nat) : Nat :=
if n > 100 then
n - 10
else
M (M (n + 11))
#eval M 91
舞台裏
なお、partial とマークされた定義を元に新たに関数を定義するとき、再度 partial とマークする必要はありません。
/-- 階乗っぽいが停止しない関数 -/
partial def forever (x : Int) : Int :=
if x = 0 then 1
else x * forever (x - 1)
-- more 関数も停止しないが、partial は不要である
def more := @forever
これは意外に思えます。partial とマークされた関数は停止性が保証されていないので、それを使用した関数も停止性を保証できなくなるはずだからです。なぜこうなるのかというと、partial はそもそも「停止性が保証されていない」ことを表すものではなく、opaque コマンドと同様に「名前が定義に展開できない」ことを表すものだからです。
-- 実際に #print してみると、`opaque` と表示される
/- info: opaque forever : Int → Int -/
#print forever
/-- 正しい階乗関数 -/
def factorial (x : Nat) : Nat :=
match x with
| 0 => 1
| x + 1 => (x + 1) * factorial x
-- 正しい階乗関数と比較してみると、
-- 正しい方は `opaque` ではなく、中身が表示されることがわかる
/-
info: def factorial : Nat → Nat :=
fun x => Nat.brecOn x factorial._f
-/
#print factorial
ある関数・定数が partial な関数に依存しているかチェックしたい場合は、#print opaque コマンドを使用することでできます。
import Batteries.Tactic.PrintOpaques
/-- 無限ループする関数 -/
partial def endless {α : Type u} (a : α) : α :=
endless a
def exampleFunc (a : Nat) : Nat :=
endless a + 1
/- info: 'exampleFunc' depends on opaque or partial definitions: [endless] -/
#print opaques exampleFunc
例外的な挙動
再帰的でない関数を partial とマークしても何も起こりません。
partial def square (x : Int) := x * x
-- 簡約が実行される
/- info: Int.ofNat 1024 -/
#reduce square 32
private
private は、その定義があるファイルの中でだけ参照可能になるようにする修飾子です。他のファイルからはアクセス不能になります。不安定なAPIなど、外部に公開したくないものに対して使うのが主な用途です。
Warning
このページの内容は ボタンから Lean 4 Web で実行することができません。
たとえば、以下のように書かれているファイル Private/Lib.lean があったとしましょう。
structure Point where
x : Nat
y : Nat
namespace Point
protected def sub (p q : Point) : Point :=
{ x := p.x - q.x, y := p.y - q.y }
private def private_sub := Point.sub
end Point
このとき、モジュール PrivateLib を読み込んでいるファイルからは、protected で修飾された名前はアクセス可能ですが、private で修飾された名前はアクセスできません。
import LeanByExample.Modifier.Private.Lib -- private が使用されているモジュールをインポート
-- private を使わずに定義した内容にはアクセスできる
#check Point.sub
-- private とマークした定義にはアクセスできない
#check_failure Point.private_sub
なお private コマンドで定義した名前は、同じファイル内であればそのセクションや名前空間を出ても普通にアクセスすることができます。特に、private は protected の効果を持ちません。
namespace Hoge
section
-- private とマークした定義
private def addOne (n : Nat) : Nat := n + 1
end
end Hoge
open Hoge
-- 外からでもアクセスできる
#check addOne
補足: privateで隠された定義に一時的にアクセスする
private で隠された定義にアクセスする方法はあります。手軽なのは、open private コマンドを使う方法です。
import LeanByExample.Modifier.Private.Lib
import Batteries.Tactic.OpenPrivate
-- 最初はアクセスできない
#check_failure Point.private_sub
-- `open private` コマンドを使用する
open private Point.private_sub from LeanByExample.Modifier.Private.Lib
-- アクセスできるようになった
#check Point.private_sub
protected
protected は、ある名前空間 Hoge にある定義 foo に対して、短い名前 foo でアクセスすることを禁止するものです。
namespace Playground
/-- protected が付いていない定義 -/
def ordianal_hoge := "hoge"
/-- protected が付いている定義 -/
protected def protected_hoge := "hoge"
end Playground
namespace Playground
-- 名前空間の中なので、短い名前でアクセスできる
-- (通常の挙動)
#check ordianal_hoge
-- 名前空間を開いているが、短い名前ではアクセスできない
#check_failure protected_hoge
-- 名前空間名を補えばアクセスできる
#check Playground.protected_hoge
end Playground
section
open Playground
-- 名前空間を `open` しているので、
-- 短い名前でアクセスできる（通常の挙動）
#check ordianal_hoge
-- 名前空間を `open` しているが、短い名前ではアクセスできない
#check_failure protected_hoge
end
構文
def コマンドに対してだけでなく、indudctive コマンドで生成されるコンストラクタに対しても使用可能です。
/-- 2分木 -/
inductive BinTree (α : Type) where
| empty : BinTree α
| protected node : α → BinTree α → BinTree α → BinTree α
section
-- 名前空間を開く
open BinTree
-- 名前空間を open しているが、
-- コンストラクタに短い名前でアクセスできない
#check_failure node
#check BinTree.node
-- protected でない方は短い名前でアクセスできる
#check empty
end
また structure コマンドで生成されるアクセサ関数やコンストラクタに対しても使用可能です。
structure Sample where
-- コンストラクタも protected にできる
protected mk ::
bar : Nat
protected hoge : String
section
open Sample
-- 名前空間を open しているので bar には短い名前でアクセスできる
#check bar
-- hoge には短い名前でアクセスできない
#check_failure hoge
end
用途
機能から想像がつくと思いますが、protected は混同を避けるために使用されます。
protected を使うべき典型的な状況は、型クラスのメソッドが export されている場合です。
/-- 文字列をパースして `α` 型の項を得る方法を提供する型クラス -/
class OfString (α : Type) where
ofString : String → Option α
export OfString (ofString)
型クラスのメソッドを用意するときに、関数名は往々にしてそのメソッドと同じ名前にするので、紛らわしさが生じます。
namespace Bool
-- `Bool` 名前空間の中にいると、
-- `Bool.ofString` と `OfString.ofString` が紛らわしい
def ofString (s : String) : Option Bool :=
match s with
| "true" => some true
| "false" => some false
| _ => none
instance : OfString Bool where
ofString := ofString
-- `Bool.ofString` の方を指している
/- info: Bool.ofString (s : String) : Option Bool -/
#check ofString
end Bool
-- `OfString.ofString` の方を指している
/- info: OfString.ofString {α : Type} [self : OfString α] : String → Option α -/
#check ofString
protected を使用すると、「型クラスのメソッドの具体的な実装の方を指したいときは、明示的に名前空間を補う」というルールにできるので、紛らわしさが改善されます。
namespace Unit
protected def ofString (s : String) : Option Unit :=
match s with
| "()" => some ()
| _ => none
instance : OfString Unit where
ofString := Unit.ofString
-- `OfString.ofString` の方を指している
/- info: OfString.ofString {α : Type} [self : OfString α] : String → Option α -/
#check ofString
end Unit
名前空間がネストしているとき
名前空間がネストしていないとき、protected は「フルネームを強制する」と説明しても問題ありません。しかし、名前空間がネストしているときにはその説明は誤りになります。
以下に示すように、Outer.Inner.sample という名前を protected で修飾すると、最も近い名前空間の修飾名である Inner を省略することができなくなります。
namespace Outer
namespace Inner
protected def sample := "sample"
-- フルネームを強制するのであれば失敗するべきだが、成功する。
#check Inner.sample
-- Inner 名前空間を省略することはできない
#check_failure sample
end Inner
end Outer
scoped
scoped は、コマンドの有効範囲を現在の名前空間に限定します。
-- #greet をコマンドとして認識させる
-- 実装は与えない
syntax "#greet" : command
namespace Scoped
-- scoped を付けて greet コマンドをマクロとして定義
scoped macro "#greet" : command => `(#eval "hello, world!")
-- その名前空間の中では greet コマンドが利用できる
#greet
end Scoped
-- 名前空間を抜けると使えなくなる
/- error: elaboration function for `«command#greet»` has not been implemented -/
#greet
-- 再び同じ名前で名前空間を開く
namespace Scoped
-- その名前空間の中では greet コマンドが利用できる
#greet
end Scoped
section
open Scoped
-- 単に open するだけでも利用できるようになる
#greet
end
修飾可能なコマンド
scoped で有効範囲を限定できるコマンドには、次のようなものがあります。
elab,elab_rulesinfix,infixl,infixrinstancemacro,macro_rulesnotationpostfixprefix,syntax- などなど
リストの全体は、scoped の後に修飾できないコマンドを続けたときのエラーメッセージで確認できます。
open Lean Parser
/-- `s : String` をパースして `Syntax` の項を得る。`cat` は構文カテゴリ。-/
def parse (cat : Name) (s : String) : MetaM Syntax := do
ofExcept <| runParserCategory (← getEnv) cat s
-- `def` は有効範囲を制限できないのでエラーになる
/-
error: <input>:1:7: expected 'binder_predicate', 'builtin_cbv_simproc', 'builtin_dsimproc', 'builtin_simproc', 'cbv_simproc', 'def_eval_config_item', 'dsimproc', 'elab', 'elab_rules', 'grind_pattern', 'infix', 'infixl', 'infixr', 'instance', 'macro', 'macro_rules', 'notation', 'postfix', 'prefix', 'simproc', 'syntax' or 'unif_hint'
-/
#eval parse `command "scoped def"
open scoped
open scoped コマンドを利用すると、特定の名前空間にある scoped が付けられた名前だけを有効にすることができます。単に open コマンドを利用するとその名前空間にあるすべての名前が有効になります。
namespace Foo
-- Foo の中でのみ有効な add' という名前を定義
scoped infix:55 " add' " => Nat.add
-- 動作する
#guard 30 add' 12 = 42
-- Foo の中で greet も定義
def greet := "hello"
end Foo
section
-- 単に open した場合、どちらも使用可能
open Foo
#check (30 add' 12)
#check greet
end
section
-- open scoped とした場合
open scoped Foo
-- scoped がついた宣言は使用可能
#check (30 add' 12)
-- greet は使えないまま
#check_failure greet
end
属性に対する scoped
attribute コマンドの中で scoped を使用すると、属性付与の効果範囲を限定することができます。
namespace Bar
@[scoped simp]
def bar : Nat := 12
example : bar = 12 := by
simp
end Bar
example : Bar.bar = 12 := by
-- `scoped`が付いているので、使えない
fail_if_success simp
dsimp [Bar.bar]
section
-- 名前空間を開く
open Bar
example : bar = 12 := by
-- 名前空間を開いたので、`simp`が使える
simp
end
構文的な性質
attrKind のドキュメントコメントに次のように書かれている通り、local と scoped はともに構文的には attrKind に相当します。
attrKindmatches("scoped" <|> "local")?, used before an attribute like@[local simp].
/-- 例示のための意味のないコマンド。直前に `attrKind` のみを受け付ける。-/
macro attrKind "#greet " : command => `(#eval "hello")
-- パース出来るので、`local` と `scoped` は同じカテゴリに属する
local #greet
scoped #greet
termination_by
termination_by 句(termination_by clause)は、再帰関数が有限回の再帰で停止することを Lean にわかってもらうために、「再帰のたびに減少する指標」を指定します。
-- 何も指定しないと、停止することが Lean にはわからないのでエラーになる
/-
error: fail to show termination for
M
-/
/-- McCarthy の 91 関数 -/
def M (n : Nat) : Nat :=
if n > 100 then
n - 10
else
M (M (n + 11))
以下のように、termination_by で「再帰適用で減少していくもの」を指定することができ、うまくいけばエラーがなくなります。1
/-- McCarthy の 91 関数 -/
def Mc91 (n : Nat) : Nat :=
(M n).val
where
M (n : Nat) : { m : Nat // m ≥ n - 10 } :=
if h : n > 100 then
⟨n - 10, by omega⟩
else
have : n + 11 - 10 ≤ M (n + 11) := (M (n + 11)).property
have lem : n - 10 ≤ M (M (n + 11)) := calc
_ ≤ (n + 11) - 10 - 10 := by omega
_ ≤ (M (n + 11)) - 10 := by omega
_ ≤ M (M (n + 11)) := (M (M (n + 11)).val).property
⟨M (M (n + 11)), lem⟩
-- 再帰のたびに n が 101 に近づいていくことを Lean に教えてあげる
termination_by 101 - n
構造的再帰と整礎再帰
構造的再帰
再帰関数を定義しようとすると、Lean はその関数が「どんな入力に対しても有限回の再帰で停止すること」を証明しようとします。関数によって、その自動証明が簡単なことと難しいことがあります。
簡単な場合の代表例は、引数が帰納型 T の項になっていて、再帰呼び出しによって T の「より小さい」項を引数として渡す場合です。ここで、「より小さい」というのは帰納型の基底ケースからのコンストラクタの適用回数によって測ります。このような再帰は 構造的再帰(structural recursion) と呼ばれます。
構造的再帰の場合は停止性の証明は簡単なので、基本的に Lean が自動で証明してくれます。
/-- 構造的再帰の例。階乗関数。-/
def Nat.factorial (n : Nat) : Nat :=
-- Nat の帰納的定義の構造に基づいて再帰しているので、
-- 引数が「より小さくなる」ことは明らかで、 Lean は自動で停止性を証明できる
match n with
| 0 => 1
| m + 1 => (m + 1) * Nat.factorial m
example : Nat.factorial 5 = 120 := by rfl
構造的再帰の場合 Lean は何も指定しなくても構造的再帰であることを理解してくれるのですが、構造的再帰であると明示することもできて、その場合は termination_by structural と書きます。
/-- 構造的再帰の例。 -/
def swapAlt {α : Type} (xs : List α) : List α :=
match xs with
| [] => []
| [x] => [x]
| x :: y :: zs => y :: x :: swapAlt zs
termination_by structural xs
example : swapAlt [1, 2, 3, 4] = [2, 1, 4, 3] := by
rfl
整礎再帰
構造的再帰では停止性は証明できなくても、別の方法で停止性が自動的に保証できる場合があります。
例えば、配列のインデックスを左から見ていく操作のように、「再帰呼び出しのたびに引数が増加していてもある上限を超えないことが分かっている場合」は停止性が保証できます。
/-- `Array.search`のための補助関数。
再帰呼び出しのたびに `i` が増加するが、増加に上限があるので必ず停止する -/
def Array.searchAux {α : Type} (as : Array α) (i : Nat) (P : α → Bool) : Bool :=
if h : i < as.size then
if P (as[i]) then
true
else
Array.searchAux as (i + 1) P
else
true
-- 再帰のたびに i は増加するが、
-- 配列のサイズを超えることはないので停止することを Lean に教えてあげる
termination_by as.size - i
/-- 配列の要素であって、述語 `P` を満たすものを探す -/
def Array.search {α : Type} (as : Array α) (P : α → Bool) : Bool :=
Array.searchAux as 0 P
#guard #[1, 2, 3].search (· % 2 = 0)
一般に（無限に小さくなり続けることはない）ある指標が、再帰呼び出しのたびに減少していく場合、停止性を保証するのに利用することができます。このような再帰は 整礎再帰(well-founded recursion) と呼ばれます。termination_by 句は、整礎再帰のためにどの指標を利用するかを Lean に伝えるための構文であると言うことができます。
Lean は賢いので、多くのシンプルなケースについては termination_by 句を省略することができますが、その場合でも整礎再帰であることに変わりはありません。
/-- 整除関数。
構造的再帰ではないが、Lean が自動的に停止性を証明できる -/
def div (x y : Nat) : Nat :=
if h : y = 0 then
0
else if x < y then
0
else
1 + div (x - y) y
#guard div 10 3 = 3
整礎再帰と [irreducible] 属性
整礎再帰を使って定義した関数は自動的に [irreducible] 属性が付与されます。
/-- 文字列の左側を指定文字で埋めて、指定長にそろえる（整礎再帰バージョン）-/
def String.padLeftWF (input : String) (padChar : Char) (length : Nat) : String :=
if input.length ≥ length then
input
else
String.padLeftWF (padChar.toString ++ input) padChar length
termination_by length - input.length
/-
info: @[irreducible] def String.padLeftWF : String → Char → Nat → String
-/
#print String.padLeftWF
したがって、その関数について何か証明しようとしても rfl タクティクや decide タクティクが使えません。
example : String.padLeftWF "42" '0' 5 = "00042" := by
-- `rfl` では示せない
fail_if_success rfl
-- `decide` でも示せない
fail_if_success decide
sorry
もしも整礎再帰を回避して同じことができるのであれば、回避すると良いでしょう。
/-- 文字列の左側を指定文字で埋めて、指定長にそろえる（非再帰バージョン）-/
def String.padLeftSimple (input : String) (padChar : Char) (length : Nat) : String :=
if input.length ≥ length then
input
else
let padding : String := String.pushn "" padChar (length - input.length)
padding ++ input
-- [irreducible] ではない
/-
info: def String.padLeftSimple : String → Char → Nat → String
-/
#print String.padLeftSimple
example : String.padLeftSimple "42" '0' 5 = "00042" := by
-- こちらは定義に展開できるので `rfl` が通る
rfl
帰納法と整礎再帰
Lean では関数と証明項の間に大きな違いはないため、termination_by を再帰関数ではなくて theorem に対して使うこともできます。この場合、「再帰のたびに小さくなる指標」は「帰納法のステップごとに大きくなっていく指標」に相当します。これを利用することにより、証明の中で複雑な帰納法を書くことができます。
以下は、整数に対して「絶対値に関する帰納法」をこの手法で実装している例です。
/-- 素数 -/
@[grind =]
def Int.Prime (p : Int) : Prop :=
p > 1 ∧ ∀ a : Int, a > 0 → a ∣ p → a = 1 ∨ a = p
grind_pattern Int.le_of_dvd => a ∣ b where
guard 0 < b
/-- 1 より大きい整数には素因数が存在する -/
theorem Int.exists_prime_factor (n : Int) (hn : 1 < n) :
∃ p : Int, p.Prime ∧ p ∣ n := by
-- `n : Int` の絶対値に関する帰納法で示す。
-- 絶対値として `Nat` 値の `natAbs` を使用していることに注意
-- n 自身が素数であれば明らかなので、n は素数でないとして良い。
by_cases hprime : n.Prime
case pos =>
exists n
simp_all
-- n は素数ではないので、非自明な約数 k が存在する
have ⟨k, hk⟩ : ∃ k : Int, 1 < k ∧ k < n ∧ k ∣ n := by
have : ∃ x, 0 < x ∧ x ∣ n ∧ ¬x = 1 ∧ ¬x = n := by
simp [Int.Prime] at hprime
exact hprime hn
replace ⟨x, hx⟩ := this
exists x
grind
-- `|k| < |n|` なので、帰納法の仮定を `k` に適用できる。
-- （証明中の定理自身を呼びだしていることに注意。これは再帰呼び出しの構文と同じ）
-- したがって `k` の素因数 `p` が存在する。
have hlt : k.natAbs < n.natAbs := by grind
obtain ⟨p, hp, hpdvd⟩ := Int.exists_prime_factor k (by grind)
-- p は k の約数なので、p は n の約数でもある
grind only [Int.dvd_trans]
-- ここで `natAbs` を再帰の進捗指標に指定している。
-- この部分が「絶対値に関する帰納法」に対応している。
termination_by Int.natAbs n
-
このコード例は、Lean 公式 Zulip の how to show termination of McCarthy
Mというトピックにおける Timo Carlin-Burns さんの投稿を参考にしています。 ↩
unsafe
unsafe は、Leanのルールを破るような操作を許可するのに使う修飾子です。
たとえば、次のような帰納型は strictly positive 要件というLeanのルールに反するのでエラーになり、定義することができません。
/-
error: (kernel) arg #1 of 'Bad'.mk' has a non positive occurrence of the datatypes being declared
-/
inductive Bad' where
| mk : (Bad' → Bad') → Bad'
unsafe で修飾すれば定義が通るようになります。
unsafe inductive Bad where
| mk : (Bad → Bad) → Bad
ptrAddrUnsafe
ptrAddrUnsafe 関数は、値のメモリ上での位置を返す関数ですが、unsafe で修飾されています。
/- info: unsafe opaque ptrAddrUnsafe.{u} : {α : Type u} → α → USize -/
#print ptrAddrUnsafe
これは、ptrAddrUnsafe が 参照透過性(referential transparency) を壊してしまうからです。参照透過性とは、「引数の値が同じならば関数の値も同じ」という性質です。ptrAddrUnsafe は等しい引数でも異なる値を返すことがあります。
/- info: true -/
#eval show Bool from Id.run do
let u := ptrAddrUnsafe ([1, 2, 3])
let v := ptrAddrUnsafe ([1, 2] ++ [3])
-- 引数の値は同じだが
assert! [1, 2, 3] == [1, 2] ++ [3]
-- 返り値が異なる!
return u != v
Functional but in-place
unsafe が付与されていない通常の関数は参照透過性を持ち、したがって特に Lean ではグローバル変数の値を変更することは通常できません。
-- foo という変数を定義する
def foo := "hello"
-- 再定義しようとするとエラーになる
/- error: `foo` has already been declared -/
def foo := "hello world"
しかし、ローカル変数は破壊的に変更することができます。
/-- フィボナッチ数列を計算する -/
def fibonacci (n : Nat) : Array Nat := Id.run do
-- 可変な配列 `fib` を宣言する
let mut fib : Array Nat := Array.mkEmpty n
fib := fib.push 0
fib := fib.push 1
for i in [2:n] do
-- 更新前の配列 `fib` のメモリアドレスを取得
let old := unsafe ptrAddrUnsafe fib
-- `fib` を更新
fib := fib.push (fib[i-1]! + fib[i-2]!)
-- 更新後のメモリアドレスを取得
let new := unsafe ptrAddrUnsafe fib
-- メモリアドレスが一致する
assert! old = new
return fib
-- 値がコピーされていれば panic するはずだが...?
/- info: #[0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377] -/
#eval fibonacci 15
なぜこのようなことができるのかというと、Lean が値の不要なコピーを行わないからです。具体的には、Lean は 参照カウント がちょうど１であるような値を更新する際に、コピーして新しい値を生成する代わりに破壊的変更を行います。これを指して、Lean 言語のパラダイムのことを Functional but in-place と呼ぶことがあります。
where
where 句(where clause)を使うと、定義をする前に変数を使用することができます。主に、ヘルパー関数を宣言するために使用されます。
/-- 自然数 `n` の素因数とその重複度のリストを返す -/
partial def primeFactorsMult (n : Nat) : List (Nat × Nat) :=
loop 2 n [] |>.reverse
where
/-- 自然数 `d` に対して、`n` の重複度 `μ` と `d` のペア `(d, μ)` を返す。-/
extract (d n : Nat) : Nat × Nat :=
if d ≤ 1 then
(1, 0)
else if n % d != 0 then
(d, 0)
else
let (d, m) := extract d (n / d)
(d, m + 1)
/-- ヘルパー関数 -/
loop (d target : Nat) (acc : List (Nat × Nat)) : List (Nat × Nat) :=
if target ≤ 1 then
acc
else
let (d, m) := extract d target
if m = 0 then
loop (d + 1) target acc
else
loop (d + 1) (target / (d ^ m)) ((d, m) :: acc)
属性
属性は、attribute コマンドや @[...] という構文で扱うことができるものです。
本書では属性の完全なリストは示しません。Mathlib において利用可能な属性の一覧は Mathlib4 Help で確認できます。
aesop
[aesop] は aesop タクティクに追加のルールを登録するための属性です。同様の機能を持つコマンドに add_aesop_rules があります。
import Aesop
/-- 自然数 n が正の数であることを表す帰納的述語 -/
inductive Pos : Nat → Prop where
| succ n : Pos (n + 1)
example : Pos 1 := by
-- 最初はルールが足りなくて示せない
fail_if_success aesop
-- 手動でコンストラクタを `apply` することで証明できる
apply Pos.succ
-- `Pos` 関連のルールを `aesop` に憶えさせる
attribute [aesop safe constructors] Pos
-- aesop で示せるようになった！
example : Pos 1 := by aesop
なお aesop をカスタマイズしたものを専用のタクティクにまとめることも可能ですが、それについてはここでは詳しく述べません。declare_aesop_rule_sets コマンドのページを参照してください。
[aesop] 属性は、[aesop <phase>? <priority>? <builder_name>? <builder_option>? <rule_sets>?] という構文で使用できます。
phase について
phase は norm と safe と unsafe の３通りです。「ルールを適用した後、ダメそうだとわかったら引き返せ」「常に最初に適用せよ」など試行錯誤のやり方を指示します。
open Lean Parser Category in
-- `Aesop.phase` という構文カテゴリが存在する
#check (Aesop.phase : Category)
norm
norm は正規化(normalisation)ルールを表します。最初に適用されるルール群であり、適用によりゴールが増えないようなルールだけを登録することが推奨されます。[simp] 補題と同様に使用されます。
/-- And を模倣して自作した型 -/
structure MyAnd (a b : Prop) : Prop where
intro ::
left : a
right : b
/-- `P ∧ P ↔ P` に相当するルール -/
theorem erase_duplicate {P : Prop} : MyAnd P P ↔ P := by
constructor <;> intro h
· rcases h with ⟨h⟩
exact h
· exact MyAnd.intro h h
example (P : Prop) (hp : P) : MyAnd P P := by
-- 最初は aesop で証明できない
fail_if_success solve
| aesop
sorry
-- aesop に登録する
attribute [aesop norm simp] erase_duplicate
example (P : Prop) (hp : P) : MyAnd P P := by
-- aesop で証明できるようになった!
aesop
safe
safe ルールは、norm ルールの実行後に適用されます。あるゴールが証明可能であるとき、それに safe ルールを適用しても生成されるゴールは依然として証明可能であるように、safe ルールを選ぶことが推奨されます。
/-- 自前で定義したリスト -/
inductive MyList (α : Type) where
| nil
| cons (head : α) (tail : MyList α)
/-- リストが空ではないことを表す帰納的述語 -/
inductive NonEmpty {α : Type} : MyList α → Prop where
| cons x xs : NonEmpty (MyList.cons x xs)
example : NonEmpty (MyList.cons 1 MyList.nil) := by
-- 最初は aesop で証明できない
fail_if_success aesop
sorry
attribute [aesop safe apply] NonEmpty.cons
-- aesop で示せるようになった！
example : NonEmpty (MyList.cons 1 MyList.nil) := by aesop
unsafe
unsafe ルールは、すべての safe ルールが失敗した場合に適用されます。失敗したらバックトラックして他の unsafe ルールを試します。priority として成功する確率(%)を指定する必要があります。
variable (a b c d e : Nat)
example (h1 : a ≤ b) (h2 : b ≤ c) (h3 : c ≤ d) (h4 : d ≤ e) : a ≤ e := by
-- 最初は aesop で証明できない
fail_if_success aesop
sorry
-- 推移律を `unsafe` ルールとして登録する
attribute [local aesop unsafe 10% apply] Nat.le_trans
example (h1 : a ≤ b) (h2 : b ≤ c) (h3 : c ≤ d) (h4 : d ≤ e) : a ≤ e := by
-- aesop で証明できるようになった！
aesop
safe ルールは適用すると後戻りができないため、特定の状況でのみ適用したいルールは unsafe とすることが推奨されます。誤って safe ルールに登録してしまうと上手く動作しないことがあります。
-- 同じ推移律を今度は `safe` ルールとして登録する
attribute [local aesop safe apply] Nat.le_trans
variable (a b c d e : Nat)
example (h1 : a ≤ b) (h2 : b ≤ c) (h3 : c ≤ d) (h4 : d ≤ e) : a ≤ e := by
-- aesop で証明できない
-- 同じ命題を同じように登録したが、safe にしてしまったからダメだった
fail_if_success aesop
sorry
builder_name について
builder_name は、登録されるルールに対して「ゴールを分解する」「仮定から推論を進める」といった方向性を決めます。複数の選択肢がありますが、ここではその一部を紹介します。
open Lean Parser Category in
-- `Aesop.builder_name` という構文カテゴリが存在する
#check (Aesop.builder_name : Category)
apply
apply タクティクと同様にはたらくルールを登録します。
variable (a b c d e : Nat)
example (h1 : a < b) (h2 : b < c) (h3 : c < d) (h4 : d < e) : a < e := by
-- 最初は aesop で示せない
fail_if_success aesop
-- 手動で示すならこのように apply を繰り返すことになる
apply Nat.lt_trans (m := d) <;> try assumption
apply Nat.lt_trans (m := c) <;> try assumption
apply Nat.lt_trans (m := b) <;> try assumption
-- 推移律を登録する
attribute [aesop unsafe 10% apply] Nat.lt_trans
example (h1 : a < b) (h2 : b < c) (h3 : c < d) (h4 : d < e) : a < e := by
-- aesop で証明できるようになった!
aesop
constructors
constructors ビルダーは、帰納型 T の形をしたゴールに遭遇した際に、コンストラクタを適用するように指示します。
/-- 自前で定義した偶数を表す帰納的述語 -/
inductive Even : Nat → Prop where
| zero : Even 0
| succ m : Even m → Even (m + 2)
example : Even 2 := by
-- 最初は aesop で証明できない
fail_if_success aesop
-- 手動でコンストラクタを適用することで示せる
apply Even.succ
apply Even.zero
-- aesop にルールを登録する
attribute [aesop safe constructors] Even
example : Even 2 := by
-- aesop で証明できるようになった!
aesop
cases
cases ビルダーは、帰納型 T の形をした仮定がローカルコンテキストにある場合に、それに対して再帰的に cases タクティクを使用して分解するように指示します。
/-- 自前で定義した奇数を表す帰納的述語 -/
inductive Odd : Nat → Prop where
| one : Odd 1
| succ m : Odd m → Odd (m + 2)
example (n : Nat) (h : Odd (n + 2)) : Odd n := by
-- 最初は aesop で証明できない
fail_if_success aesop
-- 手動で cases を使って分解することで証明できる
cases h
assumption
-- aesop にルールを登録する
attribute [aesop safe cases] Odd
example (n : Nat) (h : Odd (n + 2)) : Odd n := by
-- aesop で証明できるようになった
aesop
destruct
destruct ビルダーは、A₁ → ⋯ → Aₙ → B という形の命題を登録することで、仮定に A₁, ..., Aₙ が含まれている場合に、元の仮定を消去して B を仮定に追加します。
/-- 自前で定義した偶数を表す帰納的述語 -/
inductive Even : Nat → Prop where
| zero : Even 0
| succ m : Even m → Even (m + 2)
/-- 任意の数 n について、n か n + 1 のどちらかは偶数 -/
theorem even_or_even_succ (n : Nat) : Even n ∨ Even (n + 1) := by
induction n with
| zero => left; apply Even.zero
| succ n ih =>
rcases ih with ih | ih
· right
apply Even.succ
assumption
· left
assumption
example {n : Nat} (h0 : ¬ Even n) (h1 : ¬ Even (n + 1)) : False := by
-- 最初は aesop で証明できない
fail_if_success aesop
-- 手動で補題を示すことで証明する
have := even_or_even_succ n
simp_all
attribute [aesop unsafe 30% destruct] even_or_even_succ
example {n : Nat} (h0 : ¬ Even n) (h1 : ¬ Even (n + 1)) : False := by
-- aesop で示せるようになった！
aesop
app_unexpander
[app_unexpander] 属性を Unexpander 型の関数に付与すると、#check コマンドおよびinfoviewでの表示のされ方を変更することができます。
一般に、[app_unexpander c] 属性を Unexpander 型の関数に付与することで、c の（関数適用の）表示を変更することができます。
/-- 人に挨拶をする関数 -/
def greet (x : String) := s!"Hello, {x}!"
open Lean PrettyPrinter in
/-- すべての挨拶の表示を強制的に hello world に変えてしまう -/
@[app_unexpander greet]
def unexpGreet : Unexpander := fun stx =>
match stx with
| `(greet $x) => `("hello world")
| _ => throw ()
-- #check の表示が上書きされて変わる
/- info: "hello world" : String -/
#check greet "Alice"
-- infoview における表示も変わってしまう
/-
trace: s : String
h : s = "hello world"
⊢ String
-/
example (s : String) (h : s = greet "Alice" ) : String := by
trace_state
exact "hello"
-- #eval の表示は変わらない
/- info: "Hello, Alice!" -/
#eval greet "Alice"
使用例
集合の内包表記
macro_rules コマンドで定義した集合の内包記法の表示のされ方を制御する例を挙げます。
/-- α を全体集合として、その部分集合の全体。
α の部分集合と α 上の述語を同一視していることに注意。 -/
def Set (α : Type) := α → Prop
/-- 述語 `p : α → Prop` に対応する集合 -/
def setOf {α : Type} (p : α → Prop) : Set α := p
-- ## 集合の内包表記
/-- 内包表記 `{ x : α | p x }` の `x : α` の部分のための構文。
`: α` の部分はあってもなくてもよいので `( )?` で囲っている。-/
syntax extBinder := ident (" : " term)?
/-- 内包表記 `{ x : α | p x }` の `{ | }` の部分のための構文。 -/
syntax (name := setBuilder) "{" extBinder " | " term "}" : term
/-- 内包表記の意味をマクロとして定義する -/
macro_rules
| `({ $x:ident : $type | $p }) => `(setOf (fun ($x : $type) => $p))
| `({ $x:ident | $p }) => `(setOf (fun ($x : _) => $p))
-- 内包表記が使えるようになったが、#check コマンドの出力では
-- いま定義した記法が使われないという問題がある
/- info: setOf fun n => ∃ m, n = 2 * m : Set Nat -/
#check {n : Nat | ∃ m, n = 2 * m}
open Lean PrettyPrinter in
/-- #check コマンドの出力でも内包表記を使用するようにする -/
@[app_unexpander setOf]
def setOf.unexpander : Unexpander := fun stx =>
match stx with
| `($_ fun $x:ident => $p) => `({ $x:ident | $p })
| `($_ fun ($x:ident : $ty:term) => $p) => `({ $x:ident : $ty:term | $p })
| _ => throw ()
-- ## app_unexpander のテスト
/- info: {n | ∃ m, n = 2 * m} : Set Nat -/
#check {n | ∃ m, n = 2 * m}
/- info: {n | ∃ m, n = 2 * m} : Set Nat -/
#check {n : Nat | ∃ m, n = 2 * m}
リストリテラル
List 型の項を作る構文である、リストリテラルを自作して、リストリテラルの表示を調整する例を挙げます。
/-- 自前で定義した`List` -/
inductive MyList (α : Type) where
/-- 空のリスト -/
| nil
/-- リストの先頭に要素を追加する -/
| cons (head : α) (tail : MyList α)
deriving DecidableEq
/-- 空の`MyList` -/
notation:max "⟦⟧" => MyList.nil
/-- `MyList`に要素を追加する -/
infixr:70 " ::: " => MyList.cons
/-- 自作のリストリテラル構文。なお末尾のカンマは許可される -/
syntax "⟦" term,*,? "⟧" : term
macro_rules
| `(⟦ ⟧) => `(⟦⟧)
| `(⟦ $x ⟧) => `($x ::: ⟦⟧)
| `(⟦ $x, $xs,* ⟧) => `($x ::: (⟦ $xs,* ⟧))
-- 構文は正しく動作しているが、`#check` コマンドの出力に構文が反映されていない
/- info: 1 ::: 2 ::: 3 ::: ⟦⟧ : MyList Nat -/
#check ⟦1, 2, 3⟧
namespace MyList
open Lean PrettyPrinter
@[app_unexpander MyList.cons]
def unexpandCons : Unexpander := fun stx =>
match stx with
| `($(_) $head $tail) =>
match tail with
| `(⟦⟧) => `(⟦ $head ⟧)
| `(⟦ $xs,* ⟧) => `(⟦ $head, $xs,* ⟧)
| `(⋯) => `(⟦ $head, $tail ⟧)
| _ => throw ()
| _ => throw ()
/- info: ⟦1, 2, 3⟧ : MyList Nat -/
#check ⟦1, 2, 3⟧
/- info: ⟦1⟧ : MyList Nat -/
#check ⟦1, ⟧
end MyList
cases_eliminator
[cases_eliminator] 属性は、cases タクティクで場合分けをした際の枝を変更します。
より詳しくいうと、cases タクティクの using キーワードのデフォルトの引数を変更することができます。デフォルトでは、帰納型 T に対して T.casesOn という定理が自動生成されてそれが暗黙の裡に using キーワードの引数として使われますが、[cases_eliminator] 属性で別な定理を指定すると、それが使われるようになります。
/-- 遅延評価のリストもどき -/
inductive Many (α : Type u) where
| none
| more (x : α) (xs : Unit → Many α)
example (xs : Many α) : True := by
cases xs with
| none => trivial
| more x xs =>
-- xs の型が Unit → Many α になっており、
-- 必要なとき毎回 xs () で取り出さなければならず面倒
guard_hyp xs : Unit → Many α
trivial
/-- Unit が登場しないように工夫した関数 -/
def Many.cons (x : α) (xs : Many α) : Many α :=
.more x (fun () => xs)
-- Many を定義したときに自動生成される定理
/-
info: Many.casesOn.{u_1, u} {α : Type u} {motive : Many α → Sort u_1} (t : Many α) (none : motive Many.none)
(more : (x : α) → (xs : Unit → Many α) → motive (Many.more x xs)) : motive t
-/
#check Many.casesOn
/-- Many.casesOn の more を cons に置き換えたバージョン。
この定理に `[cases_eliminator]` 属性を与えることで、
`casesOn` の代わりにこれがデフォルトで使われるようになる。 -/
@[cases_eliminator]
protected def Many.cons_casesOn {motive : Many α → Sort u} (t : Many α) (none : motive Many.none)
(cons : (a : α) → (b : Many α) → motive (Many.cons a b)) : motive t := by
match t with
| .none => assumption
| .more x xs =>
exact cons x (xs ())
example (xs : Many α) : True := by
cases xs
case none => trivial
-- case で分割したときのデフォルトのコンストラクタが cons に変わる
case cons x xs =>
-- xs の型が Many α になっている！
guard_hyp xs : Many α
trivial
デフォルトの挙動に戻すには、using キーワードに .casesOn を渡します。
example (x : Many α) : True := by
cases x using Many.casesOn
case none => trivial
case more x => trivial
なお rcases には影響しません。
example (xs : Many α) : True := by
rcases xs with _ | _
case none => trivial
case more _ xs =>
-- xs の型が Unit → Many α になっている
guard_hyp xs : Unit → Many α
trivial
coe
[coe] 属性は、特定の関数を型強制を行う関数として登録し、↑ 記号で表示されるようにします。
/-- 自前で定義した自然数 -/
inductive MyNat where
| zero
| succ (n : MyNat)
-- `MyNat.succ` を（意味をなしていないが）型強制として登録する
attribute [coe] MyNat.succ
-- `MyNat.succ` ではなく `↑` と表示されるようになった
/- info: ↑MyNat.zero : MyNat -/
#check (MyNat.succ .zero : MyNat)
また、[coe] 属性は norm_cast タクティクとも関係があります。
用途
型強制を Coe 型クラスで登録しただけでは、必ずしも型強制を行う関数が ↑ 記号で表示されるわけではありません。[coe] 属性を付与することにより、より「型強制らしく」表示されるようになります。
例として、以下に Quotient によって構成した整数への変換を挙げます。
/-- 自然数の組 -/
def IntBase := Nat × Nat
/-- 自然数の組に対する同値関係 -/
def IntBase.equiv : IntBase → IntBase → Prop :=
fun (a₁, b₁) (a₂, b₂) => a₁ + b₂ = b₁ + a₂
/-- `IntBase` 上の同値関係として `IntBase.equiv` を登録する -/
instance IntBase.sequiv : Setoid IntBase where
r := IntBase.equiv
iseqv := by
constructor
case refl =>
intro ⟨x, y⟩
dsimp [IntBase.equiv]
ac_rfl
case symm =>
intro ⟨x, y⟩ ⟨x', y'⟩ h
dsimp [IntBase.equiv] at *
omega
case trans =>
intro ⟨x, y⟩ ⟨x', y'⟩ ⟨x'', y''⟩ hxy hyz
dsimp [IntBase.equiv] at *
omega
/-- 整数を表す型 -/
abbrev myInt := Quotient IntBase.sequiv
/-- 自然数を `myInt` に変換する -/
def myInt.ofNat (n : Nat) : myInt := Quotient.mk' (n, 0)
/-- `Nat → myInt` という型強制 -/
instance : Coe Nat myInt where
coe := myInt.ofNat
-- この時点では、`myInt.ofNat` が型強制として表示されない
/- info: myInt.ofNat Nat.zero : myInt -/
#check (Nat.zero : myInt)
-- `[coe]` 属性を付与する
attribute [coe] myInt.ofNat
-- `myInt.ofNat` ではなく `↑` と表示されるようになった！
/- info: ↑Nat.zero : myInt -/
#check (Nat.zero : myInt)
command_elab
[command_elab] 属性は、コマンドの実装である CommandElab 型の関数とコマンドの構文を結び付け、コマンドとして動作するようにします。
import Lean
open Lean Elab Command in
/-- 挨拶をするコマンド -/
syntax (name := helloCommand) "#hello" : command
open Lean Elab Command in
def evalHello : CommandElab := fun _stx => do
let msg := s!"Hello, Lean!"
logInfo msg
-- 実装がないので #hello コマンドはまだ使えない
/- error: elaboration function for `helloCommand` has not been implemented -/
#hello
-- 属性を使って実装と構文を紐づける
attribute [command_elab helloCommand] evalHello
-- コマンドが使えるようになった
/- info: Hello, Lean! -/
#hello
csimp
[csimp] 属性は、コンパイラに単純化を指示します。
A = B という形の定理に付与することでコンパイラに A の計算を B の計算に置き換えさせることができます。非効率な関数を効率的な実装に置き換えるために使用されます。
/-- フィボナッチ数列の非効率な実装 -/
def fibonacci : Nat → Nat
| 0 => 0
| 1 => 1
| n + 2 => fibonacci n + fibonacci (n+1)
-- `#eval fibonacci 32` は１秒以上かかる
#eval fibonacci 32
/-- フィボナッチ数列のより高速な実装 -/
def fib (n : Nat) : Nat :=
(loop n).1
where
-- ヘルパー関数
loop : Nat → Nat × Nat
| 0 => (0, 1)
| n + 1 =>
let p := loop n
(p.2, p.1 + p.2)
/-- `fib` は `fibonacci` と同じ漸化式を満たす -/
theorem fib_add (n : Nat) : fib (n + 2) = fib n + fib (n + 1) := by rfl
/-- `fibonacci` と `fib` は同じ結果を返す。
`[csimp]` 属性を与えることで、`fibonacci` の計算を `fib` の計算に置き換えることができる。-/
@[csimp]
theorem fib_eq_fibonacci : fibonacci = fib := by
ext n
induction n using fibonacci.induct
case case1 => rfl
case case2 => rfl
case case3 n ih1 ih2 =>
rw [fib_add, fibonacci]
simp [ih1, ih2]
-- `fibonacci` の計算が１秒以内に終わるようになった
#eval fibonacci 32
#eval fibonacci 132
注意: [csimp] 属性による公理の隠蔽
[csimp] 属性が付与された定理の証明にどんな公理を使用しているかを、#print axioms コマンドで追跡することはできません。
def one := 1
def two := 2
/-- 何かの公理 -/
axiom my_axiom : False
@[csimp] theorem one_eq_two : one = two := by
exact my_axiom.elim
theorem false_theorem : 1 = 2 := by
rw [show 1 = one from rfl]
native_decide
-- `my_axiom` に依存しているはずだが、`native_decide` により導入された別の公理の陰に隠れて見えなくなっている
/- info: 'false_theorem' depends on axioms: [false_theorem._native.native_decide.ax_1_1] -/
#print axioms false_theorem
default_instance
[default_instance] 属性は、型クラス解決が（型情報の不足などで）上手くいかない場合に、最後の手段としてインスタンス解決に使われるインスタンスを指定します。
-- `Int` は `Mul` 型クラスのインスタンスで、
-- インスタンス名は `Int.instMul`
/- info: Int.instMul -/
#synth Mul Int
-- メタ変数名を表示しない
set_option pp.mvars false
-- エラー。`x, y` の型がわからないので `x * y` をどう解釈すればいいか Lean はわからない。
#check_failure fun y => (fun x => x * y)
-- `y` の型を明示的に与えればエラーは消える
#check fun (y : Nat) => (fun x => x * y)
-- `Mul` のインスタンスを探して見つからなかった際に `Int.instMul` を使うように指定する
attribute [default_instance] Int.instMul
-- エラーが消えた！
#check fun y => (fun x => x * y)
用途
典型的な使用方法は、OfNat 型クラスの（型を指定しない場合の）解釈のされ方を変更することでしょう。
/-- 自然数の対 -/
def NatPair := Nat × Nat
/-- `(0, 0)` を単に `0 : NatPair` と書けるようにする -/
instance instNatPair : OfNat NatPair 0 := ⟨(0, 0)⟩
-- 期待される型を指定しない場合、数値リテラルは `Nat` の項であると解釈される
/- info: 0 : Nat -/
#check 0
-- 期待される型を指定しなければ、数値リテラルを `NatPair` の項として解釈する
attribute [default_instance] instNatPair
-- `NatPair` の項として解釈されるようになった！
/- info: 0 : NatPair -/
#check 0
-- 期待される型を指定したときの挙動は変わらない。
-- 相変わらず `Nat` の項として解釈される
/- info: 0 : Nat -/
#check (0 : Nat)
インスタンス優先度との違い
インスタンス優先度(priority) という機能もあります。これも型クラス解決の優先度に関係する機能ですが、[default_instance] 属性とは挙動が異なります。Lean はインスタンス解決の際にまずインスタンス優先度の高いものから試し、すべて失敗した場合にのみ [default_instance] 属性を参照します。つまり、考慮される順番が異なるということです。
/-- ⋄ 記法のための型クラス -/
class Diamond (α : Type) where
dia : α
notation "⋄" => Diamond.dia
/-- `⋄ : Nat` が `0` を表すものとする -/
instance instDiaZero : Diamond Nat where
dia := 0
/-- `⋄ : Nat` が `1` を表すものとする -/
instance instDiaOne : Diamond Nat where
dia := 1
-- 二つのインスタンスが衝突しているが、
-- 後に定義された方が優先される
#guard (⋄ : Nat) = 1
-- `0` と解釈する方をデフォルトにする
attribute [default_instance] instDiaZero
-- デフォルトインスタンスにしても効果がなく、相変わらず `1` の方が優先される！
-- これは、期待される型がわかっていて型クラス解決が早期に成功するから
#guard (⋄ : Nat) = 1
-- 期待される型が不明な状況であれば、
-- デフォルトインスタンスが使用される
/- info: 0 -/
#eval ⋄
/-- `⋄ : Nat` が `2` を表すものとする。優先度を `high` にしておく -/
instance (priority := high) instDiaTwo : Diamond Nat where
dia := 2
/-- `⋄ : Nat` が `3` を表すものとする -/
instance instDiaThree : Diamond Nat where
dia := 3
-- `2` と解釈する方が優先されるようになった！
#guard (⋄ : Nat) = 2
elab_as_elim
[elab_as_elim] 属性を付与すると、除去子(eliminator)としてエラボレートされるようになります。
/-- 標準の再帰子である`Nat.rec`を真似て作った再帰子もどき -/
def Nat.rec' {motive : Nat → Sort u}
(zero : motive 0) (succ : ∀ n, motive n → motive (n + 1))
(t : Nat) : motive t := Nat.rec zero succ t
-- メタ変数を具体的に表示しない
set_option pp.mvars false in
-- 何も付けないとこういうエラーメッセージ
/-
error: Function expected at
Nat.rec' ?_ (fun x b => b + 1) ?_
but this term has type
?_ ?_
Note: Expected a function because this term is being applied to the argument
a
-/
def add (a b : Nat) := Nat.rec' _ (zero := b) (succ := fun _ b => b + 1) a
-- `elab_as_elim` 属性を付与する
attribute [elab_as_elim] Nat.rec'
-- 「eliminatorがエラボレートできません」というエラーメッセージに変わる。
-- eliminatorだと認識されている！
/- error: failed to elaborate eliminator, expected type is not available -/
def add (a b : Nat) := Nat.rec' _ (zero := b) (succ := fun _ b => b + 1) a
implemented_by
[implemented_by] は、仕様（満たしてほしい性質）と実装を分離するための属性です。
[implemented_by] 属性を使うと、実行時の実装を証明なしに置き換えてしまうことができます。
def bar := "world"
-- 実行する際には`bar`を参照してくださいとLeanに指定している
@[implemented_by bar]
def foo := "hello"
/- info: "world" -/
#eval foo
[implemented_by] で置換されるのは実行時の実装であって、証明時のふるまいは変わりません。
-- 証明においては`foo`は`"hello"`のまま
example : foo = "hello" := rfl
native_decide を使用するなどしてコンパイラを信頼することにすれば、置換した内容を証明に利用することもできます。
しかし、当然ながらこれによって証明の健全性は保証されません。
example : foo = "world" := by
native_decide
使用例
典型的な使用場面として、「unsafe だが高速なコード」を安全に使用したい場面というのがあります。
たとえば、２分木を考えます。1
/-- 2分木 -/
inductive Tree (α : Type) where
/-- 空の木 -/
| empty
/-- 左右の部分木とノードの値から、新しい木を得る -/
| branch (left : Tree α) (value : α) (right : Tree α)
2分木t₁ t₂に対して、t₁ == t₂ であるかどうかを判定する関数を考えます。
再帰的に判定すればできるのですが、t₁ と t₂ のメモリアドレスが等しい場合にはそんなことをするのはムダになります。
そこで、次のような関数を定義します。
/-- 高速だが unsafe な BEq の実装 -/
unsafe def Tree.fastBEq {α : Type} [BEq α] (t₁ t₂ : Tree α) : Bool :=
-- メモリアドレスが等しいならば、同じ木である
if ptrEq t₁ t₂ then
true
else
-- それ以外の場合は再帰的に判定する
match t₁, t₂ with
| .empty, .empty => true
| .branch l₁ v₁ r₁, .branch l₂ v₂ r₂ =>
v₁ == v₂ && fastBEq l₁ l₂ && fastBEq r₁ r₂
| _, _ => false
しかし、ptrEq が unsafe なので、Tree.fastBEq 全体が unsafe になってしまいます。
[implemented_by] 属性を使うと、実行時には Tree.fastBEq を使うというのは維持したまま、証明時には安全な定義を使うことができます。
@[implemented_by Tree.fastBEq]
def Tree.beq {α : Type} [BEq α] (t₁ t₂ : Tree α) : Bool :=
match t₁, t₂ with
| .empty, .empty => true
| .branch l₁ v₁ r₁, .branch l₂ v₂ r₂ =>
v₁ == v₂ && Tree.beq l₁ l₂ && Tree.beq r₁ r₂
| _, _ => false
instance {α : Type} [BEq α] : BEq (Tree α) where
beq := Tree.beq
-
このコード例と解説は、The Lean Language Reference を参考にしています。 ↩
induction_eliminator
[induction_eliminator] 属性は、帰納法の枝を変更することを可能にします。
より詳しくいうと、induction タクティクの using キーワードのデフォルトの引数を変更することができます。デフォルトでは、帰納型 T に対して T.rec (および T.recOn )という定理が自動生成されてそれが暗黙の裡に using キーワードの引数として使われますが、[induction_eliminator] 属性で別な定理を指定すると、それが使われるようになります。
/-- 遅延評価のリストもどき -/
inductive Many (α : Type u) where
| none
| more (x : α) (xs : Unit → Many α)
/-- Many に対する合併関数 -/
def Many.union : Many α → Many α → Many α
| .none, ys => ys
| .more x xs, ys => Many.more x (fun () => union (xs ()) ys)
-- Many に関する定理を帰納法で示す例
example (xs : Many α) : Many.union xs Many.none = xs := by
induction xs with
| none => rfl
| more x xs ih =>
-- ここで xs の型は Unit → Many α になっている
-- 必要なとき毎回 xs () で取り出さなければならず面倒
guard_hyp xs : Unit → Many α
simp [Many.union, ih]
/-- Unit が登場しないように工夫した関数 -/
def Many.cons (x : α) (xs : Many α) : Many α :=
.more x (fun () => xs)
-- Many を定義したときに自動生成される定理
/-
info: Many.rec.{u_1, u} {α : Type u} {motive : Many α → Sort u_1} (none : motive Many.none)
(more : (x : α) → (xs : Unit → Many α) → ((a : Unit) → motive (xs a)) → motive (Many.more x xs)) (t : Many α) :
motive t
-/
#check Many.rec
-- Many.rec の `Many.more` の部分を `Many.cons` に置き換えた定理を作る。
-- これに `[induction_eliminator]` 属性を与えることで、
-- コンストラクタ `Many.more` の代わりに `Many.cons` が使えるようになる
@[induction_eliminator]
protected def Many.cons_rec {motive : Many α → Sort u}
(none : motive Many.none)
(cons : (a : α) → (b : Many α) → (motive b) → motive (Many.cons a b))
: (t : Many α) → motive t
| .none => none
| .more x xs => cons x (xs ()) (Many.cons_rec none cons (xs ()))
example (xs : Many α) : Many.union xs Many.none = xs := by
induction xs with
| none => rfl
| cons x xs ih =>
-- ここで xs の型が Many α になっている！
-- 毎回 `xs ()` などと書く必要がなくなった
guard_hyp xs : Many α
simp [Many.union, Many.cons, ih]
[induction_eliminator] を設定する前の挙動に戻すには、using キーワードに明示的に .rec 定理を与えます。
example (xs : Many α) : True := by
-- 明示的に指定すれば， 元の挙動に戻せる
induction xs using Many.rec with
| none => trivial
| more _ xs _ =>
-- 元のように Many.more が使われる
guard_hyp xs : Unit → Many α
trivial
inherit_doc
[inherit_doc] 属性を指定すると、既存の定数などのドキュメントコメントを使いまわすことができます。
import Lean
/-- 最初に与えた doc コメント -/
def greet := "hello"
-- `greet` のドキュメントコメントを引き継ぐ
@[inherit_doc greet] abbrev greet' := greet
open Lean Elab Command in
/-- ドキュメントコメントを取得して表示するコマンド -/
elab "#doc " x:ident : command => do
let name := x.getId
if let some s ← findDocString? (← getEnv) name then
logInfo m!"{s}"
/- info: 最初に与えた doc コメント -/
#doc greet'
[inherit_doc] 属性を使用するのは、記法を導入する際であることが多いでしょう。この場合、ドキュメントコメントの継承元を指定する必要がありません。
/-- `⊔` という記号のための型クラス -/
class Sup (α : Type) where
/-- 最小上界、上限 -/
sup : α → α → α
@[inherit_doc] infixl:68 " ⊔ " => Sup.sup
irreducible
[irreducible] 属性を付与すると、その名前が定義本体に 定義的に等しい(definitionally equal) ということが隠されて、rfl タクティクや dsimp タクティクが通らなくなります。
/-- 階乗関数 -/
def factorial (n : Nat) : Nat :=
match n with
| 0 => 1
| m + 1 => (m + 1) * factorial m
example : factorial 5 = 120 := by
-- 最初は rfl が通る
rfl
example : factorial 5 = 120 := by
-- dsimp も通る
dsimp [factorial]
-- [irreducible]属性を与える
attribute [irreducible] factorial
example : factorial 5 = 120 := by
-- rfl が通らなくなる
fail_if_success rfl
-- dsimp も通らない
fail_if_success dsimp [factorial]
cbv
-- 補足: 名前を定義に展開しなくてもわかる等式は、引き続き rfl で示せる
example : factorial 5 = factorial 5 := by
rfl
なお unfold タクティクは [irreducible] 属性が付与されていても使えます。
example : factorial 5 = 120 := by
repeat unfold factorial
rfl
また、名前からは #reduce コマンドが使えなくなるような印象を受けますが、#reduce は相変わらず使用可能です。
-- `#reduce` は相変わらずできる
/- info: 6 -/
#reduce factorial 3
用途
ユーザが明確に、自分で定義した関数・定数に対して [irreducible] 属性を付与すべき場面はそんなに多くないと筆者は思います。
Lean は整礎再帰な関数や partial_fixpoint により修飾された関数に対して自動的に [irreducible] 属性を付与するのですが、おそらくこの属性を見かけるのはそういう場面が多いでしょう。
#print コマンドを使うと裏で属性が付与されている様子を確認することができます。
def searchF {α : Type} (f : Nat → Option α) (start : Nat) : Option Nat :=
match f start with
| some _ => some start
| none => searchF f (start + 1)
partial_fixpoint
-- `partial_fixpoint` を使ったので irreducible になっている
/-
info: @[irreducible] def searchF : {α : Type} → (Nat → Option α) → Nat → Option Nat :=
fun {α} f =>
Lean.Order.fix
(fun f_1 start =>
match f start with
| some val => some start
| none => f_1 (start + 1))
⋯
-/
#print searchF
/-- 文字列の左側を指定文字で埋めて、指定長にそろえる（整礎再帰バージョン）-/
def String.padLeftWF (input : String) (padChar : Char) (length : Nat) : String :=
if input.length ≥ length then
input
else
String.padLeftWF (padChar.toString ++ input) padChar length
termination_by length - input.length
-- 整礎再帰を使ったので `[irreducible]` になっている
/-
info: @[irreducible] def String.padLeftWF : String → Char → Nat → String :=
fun input padChar length => String.padLeftWF._unary padChar length input
-/
#print String.padLeftWF
macro_inline
[macro_inline] 属性は、関数に付与することでその関数をマクロのように展開させることができます。これにより、関数の引数の評価が、関数の評価前からそれが最初に使われた時点に延期されます。
用途
多くの場合、[macro_inline] 属性は短絡評価(short-circuit evaluation)を実装するのに使われます。短絡評価とは、「引数を全て評価するまでもなく値がわかるときには、残りの引数を評価しない」という評価戦略のことです。この評価戦略が実装されている典型的な関数として、論理演算子 && や || が挙げられます。
-- 第二引数は評価されていない。
/- info: false -/
#eval false && (dbg_trace "hello"; true)
-- 第二引数は評価されていない。
/- info: true -/
#eval true || (dbg_trace "hello"; true)
実際に Bool.and（つまり &&）を真似て関数を自作してみて、[macro_inline] 属性の挙動を確認してみましょう。
/-- `Bool.and` を真似て自作した関数
(わざと冗長な定義を採用している) -/
def Bool.myAnd (a b : Bool) : Bool :=
match a, b with
| false, _ => false
| _, false => false
| _, _ => true
-- 第二引数が評価されており、短絡評価になっていない
/-
info: hello
---
info: false
-/
#eval Bool.myAnd false (dbg_trace "hello"; true)
-- `[macro_inline]` 属性を付与する
attribute [macro_inline] Bool.myAnd
-- 短絡評価になった！！
/- info: false -/
#eval Bool.myAnd false (dbg_trace "hello"; true)
macro
[macro] 属性は、マクロの実装である Macro 型の関数とマクロの構文を結び付け、マクロとして動作するようにします。
import Lean
open Lean
syntax:10 (name := lxor) term:10 " LXOR " term:11 : term
def expandLxor : Macro := fun stx =>
match stx with
| `($l:term LXOR $r:term) => `(term| !$l && $r)
| _ => Macro.throwUnsupported
-- 解釈不能というエラーになる
#check_failure true LXOR false
-- マクロとして登録する
attribute [macro lxor] expandLxor
-- マクロ展開されるので、`!true && false` になる
#guard (true LXOR false) = false
[macro] 属性は低レベルな機能です。多くの用途では macro_rules コマンドや macro コマンドで用が足りることでしょう。
match_pattern
[match_pattern] 属性を付与すると、元々コンストラクタしか使用できない match 式でのパターンマッチの枝に、指定した関数を使うことができるようになります。
/-- 自前で定義したリスト -/
inductive MyList (α : Type u) where
| nil
| cons (head : α) (tail : MyList α)
/-- MyList の `cons` コンストラクタに対するラッパー。中身は同じ -/
def MyList.myCons (a : α) (as : MyList α) : MyList α :=
MyList.cons a as
-- 最初は `match` の中で `MyList.myCons` を使うことはできない
/- error: Invalid pattern: Expected a constructor or constant marked with `[match_pattern]` -/
def badLength : MyList α → Nat
| MyList.nil => 0
| MyList.myCons _ as => 1 + badLength as
-- `[match_pattern]` 属性を付与する
attribute [match_pattern] MyList.myCons
-- これで `match` の中で `MyList.myCons` を使うことができる
def goodLength : MyList α → Nat
| MyList.nil => 0
| MyList.myCons _ as => 1 + goodLength as
simp
[simp] 属性を定理に付与すると、simp タクティクによって単純化ルールとして使用されるようになります。
/-- 標準の`Nat`を真似て自作した型 -/
inductive MyNat where
| zero
| succ (n : MyNat)
/-- `MyNat`上の足し算 -/
def MyNat.add (m n : MyNat) : MyNat :=
match n with
| .zero => m
| .succ n => succ (add m n)
instance : Add MyNat where
add := MyNat.add
instance : Zero MyNat where
zero := MyNat.zero
theorem MyNat.add_zero (n : MyNat) : n + 0 = n := by
rfl
-- 最初は`simp`で示すことができない
example (n : MyNat) : (n + 0) + 0 = n := by
fail_if_success simp
rw [MyNat.add_zero n]
rw [MyNat.add_zero n]
-- `[simp]`属性を付与する
attribute [simp] MyNat.add_zero
-- `simp`で示せるようになった！
example (n : MyNat) : (n + 0) + 0 = n := by
simp
関数に付与した場合
[simp] 属性は定理だけでなく関数定義などにも付与することができます。関数定義に付与した場合、その関数について定義からただちに従う関数等式が自動的に見出だされて simp 補題として登録されます。
/-- フィボナッチ数列 -/
def Nat.fib (n : Nat) : Nat :=
match n with
| 0 => 0
| 1 => 1
| n + 2 => Nat.fib (n + 1) + Nat.fib n
-- `rfl` ですぐ示せる関数等式があるが、`simp` では示せない
example : Nat.fib 0 = 0 := by
fail_if_success simp
rfl
example : Nat.fib 1 = 1 := by
fail_if_success simp
rfl
example (n : Nat) : Nat.fib (n + 2) = Nat.fib (n + 1) + Nat.fib n := by
fail_if_success simp
rfl
-- `Nat.fib` に対する `simp` 補題を生成する
attribute [simp] Nat.fib
-- `simp` で示せるようになる!
example : Nat.fib 0 = 0 := by
simp
example : Nat.fib 1 = 1 := by
simp
example (n : Nat) : Nat.fib (n + 2) = Nat.fib (n + 1) + Nat.fib n := by
simp
simp 補題の優先順位
simp 補題による単純化は、おおむね「内側から外側へ」という順序で行われます。
これはオプションでsimpのトレース情報を出力させてみると確認できます。
/-- フィボナッチ数列 -/
def Nat.fib (n : Nat) : Nat :=
match n with
| 0 => 0
| 1 => 1
| n + 2 => Nat.fib (n + 1) + Nat.fib n
@[simp]
theorem Nat.fib_zero : Nat.fib 0 = 0 := by
rfl
-- `simp`の行った書き換えを追跡する
set_option trace.Meta.Tactic.simp.rewrite true in
-- 内側から外側へという順序で単純化を行っていることがわかる。
/-
trace: [Meta.Tactic.simp.rewrite] Nat.fib_zero:1000:
Nat.fib 0
==>
0
[Meta.Tactic.simp.rewrite] Nat.add_zero:1000:
0 + 0
==>
0
[Meta.Tactic.simp.rewrite] Nat.mul_zero:1000:
37 * 0
==>
0
[Meta.Tactic.simp.rewrite] eq_self:1000:
0 = 0
==>
True
-/
example : 37 * (Nat.fib 0 + 0) = 0 := by
simp
[simp←]
simp 補題は通常「左辺を右辺に」単純化するために使用されますが、逆方向に使用したい場合は [simp←] とします。
/-- モノイド -/
class Monoid (α : Type u) extends Mul α, One α where
mul_one : ∀ a : α, a * 1 = a
one_mul : ∀ a : α, 1 * a = a
mul_assoc : ∀ a b c : α, (a * b) * c = a * (b * c)
variable [Monoid α]
@[simp←]
theorem mul_one_rev (a : α) : a = 1 * a := by
rw [Monoid.one_mul a]
-- `simp?` で確認してみると、該当する補題に `←` が付与されている
/-
info: Try this:
[apply] simp only [← mul_one_rev]
-/
example (a : α) : 1 * (1 * a) = a := by
simp?
[simp↓]
simp はデフォルトでは部分式をすべて単純化した後に全体の式に単純化を適用しています。simp タクティクに、部分式が単純化されるよりも先に前処理として単純化したいルールがある場合は、[simp↓] を使用します。
/-- 整数のような何か -/
opaque MyInt : Type
variable [LE MyInt] [Add MyInt] [Zero MyInt]
@[simp]
axiom MyInt.add_zero (a : MyInt) : a + 0 = a
@[simp]
axiom MyInt.simp_le_add (a b c : MyInt) : a + b ≤ a + c ↔ b ≤ c
example (a b : MyInt) (h : a + 0 ≤ a + b) : 0 ≤ b := by
simp at h
-- `simp` により `add_zero` が先に適用されてしまう
-- 本当は `simp_le_add` が先に適用されて欲しい…
guard_hyp h : a ≤ a + b
sorry
-- `[simp↓]` 属性を付与する
attribute [simp↓] MyInt.simp_le_add
-- `simp`の行った書き換えを追跡する
set_option trace.Meta.Tactic.simp.rewrite true
/-
trace: [Meta.Tactic.simp.rewrite] ↓ MyInt.simp_le_add:1000:
a + 0 ≤ a + b
==>
0 ≤ b
-/
example (a b : MyInt) (h : a + 0 ≤ a + b) : 0 ≤ b := by
-- ちゃんと `simp_le_add` が先に適用されるようになった！
simp at h
assumption
優先度指定
simp 補題の中でも早い段階で適用してほしい補題や、遅い段階で適用してほしい補題があるとき、優先度を指定することができます。
simp high
[simp high] とすると優先度が高まり、他の simp 補題よりも先に適用されるようになります。
/-- 謎の自然数 -/
opaque foo : Nat
/-- 謎の自然数 -/
opaque bar : Nat
/-- 謎の自然数 -/
opaque baz : Nat
@[simp]
axiom foo_eq_bar : foo = bar
@[simp]
axiom foo_eq_baz : foo = baz
example : foo = baz := by
-- 先に宣言された方の `foo_eq_bar` が適用されてしまって、
-- 証明することができない
simp
guard_target =ₛ bar = baz
sorry
attribute [simp high] foo_eq_baz
example : foo = baz := by
-- `foo_eq_baz` の方が優先度が高いため、こちらが先に適用される
simp
simp low
[simp low] とすると優先度が低くなり、他の simp 補題よりも後に適用されるようになります。
/-- 謎の自然数 -/
opaque foo : Nat
/-- 謎の自然数 -/
opaque bar : Nat
/-- 謎の自然数 -/
opaque baz : Nat
@[simp]
axiom foo_eq_bar : foo = bar
@[simp]
axiom foo_eq_baz : foo = baz
example : foo = baz := by
-- 先に宣言された方の `foo_eq_bar` が適用されてしまって、
-- 証明することができない
simp
guard_target =ₛ bar = baz
sorry
-- `foo_eq_bar` の優先度を下げる
attribute [simp low] foo_eq_bar
example : foo = baz := by
-- `foo_eq_baz` の方が優先度が高いため、こちらが先に適用される
simp
simps
補題を simp で使えるようにするのは [simp] 属性を付与することで可能ですが、[simps] 属性(または @[simps] タグ)を利用すると simp で使用するための補題を自動的に生成してくれます。
例えば、ユーザが Point という構造体を定義し、Point 上の足し算を定義したところを考えましょう。このとき、足し算はフィールドの値の足し算で定義されているため、「Point の和の x 座標」は x 座標の和ですが、これはそのままでは simp で示すことができません。[simps] 属性を Point.add 関数に付与することで、simp で示せるようになります。
import Mathlib.Tactic.Simps.Basic -- [simps] 属性を使うため
@[ext]
structure Point where
x : Int
y : Int
/-- Point の和 -/
def Point.add (p q : Point) : Point :=
{ x := p.x + q.x, y := p.y + q.y }
/-- 和の x 座標は x 座標の和 -/
example (a b : Point) : (Point.add a b).x = a.x + b.x := by
-- この状態だと `simp` で示せない
fail_if_success simp
rfl
-- `Point.add` に `[simps]` 属性を付与する
attribute [simps] Point.add
example (a b : Point) : (Point.add a b).x = a.x + b.x := by
-- simp 補題が自動的に生成されて、simp で示せるようになった
simp
上記の例では attribute コマンドで属性を付与していますが、タグも使用できます。
@[simps]
def Point.sub (p q : Point) : Point :=
{ x := p.x - q.x, y := p.y - q.y }
example (a b : Point) : (Point.sub a b).x = a.x - b.x := by simp
@[simps?] に換えると、生成された補題を確認することができます。
/-
trace: [simps.verbose] The projections for this structure have already been initialized by a previous invocation of `initialize_simps_projections` or `@[simps]`.
Generated projections for Point:
Projection x: fun x => x.x
Projection y: fun x => x.y
[simps.verbose] adding projection Point.mul_x:
∀ (p q : Point), (p.mul q).x = p.x * q.x
[simps.verbose] adding projection Point.mul_y:
∀ (p q : Point), (p.mul q).y = p.y * q.y
-/
@[simps?] def Point.mul (p q : Point) : Point :=
{ x := p.x * q.x, y := p.y * q.y }
tactic
[tactic] 属性は、タクティクの実装である Tactic 型の関数とタクティクの構文を結び付け、タクティクとして動作するようにします。
import Lean
import Qq
import Batteries.Tactic.Exact
/-- True というゴールだけを閉じる trivial タクティクの制限版 -/
syntax (name := trivialStx) "my_trivial" : tactic
open Lean Elab Tactic Qq in
def trivialImpl : Tactic := fun _stx => do
-- 現在のゴールを取得する
let goal : MVarId ← getMainGoal
try
-- ゴールが `True.intro` で閉じられるか試す
goal.assignIfDefEq q(True.intro)
catch _error =>
-- 失敗した場合はゴールの型を取得してエラーメッセージを表示する
let goalType ← goal.getType
throwError "my_trivialタクティクが失敗しました。ゴールの型は`{goalType}`であって`True`ではありません。"
-- 未実装というエラーになってしまう
/- error: Tactic `trivialStx` has not been implemented -/
example : True := by
my_trivial
-- [tactic] 属性を使って実装と構文を結びつける
attribute [tactic trivialStx] trivialImpl
-- タクティクとして使えるようになった！
example : True := by
my_trivial
option
オプションは、set_option コマンドで設定することができ、主にデバッグに利用されます。
autoImplicit
autoImplicit オプションは、自動束縛暗黙引数(auto bound implicit arguments)という機能を制御します。類似オプションとして relaxedAutoImplicit があります。
有効にすると、宣言が省略された引数が1文字であるとき、それを暗黙引数として自動的に追加します。
-- `autoImplicit` が無効の時
set_option autoImplicit false in
-- `nonempty` の定義には `α` という未定義の識別子が含まれるため、エラーになる
/-
error: Unknown identifier `α`
Note: It is not possible to treat `α` as an implicitly bound variable here because the `autoImplicit` option is set to `false`.
-/
def nonempty : List α → Bool
| [] => false
| _ :: _ => true
-- `autoImplicit` が有効の時
set_option autoImplicit true in
-- `α` という未定義の識別子を含んでいてもエラーにならない。
-- 勝手に暗黙引数として追加されている
def head : List α → Option α
| [] => none
| x :: _ => some x
1文字の未束縛の識別子であればなんでも対象になるようです。
section autoImpl
-- `autoImplicit` が有効の時
set_option autoImplicit true
-- ギリシャ文字ではなくて1文字の小文字でも暗黙引数として追加される
def nonempty₂ : List a → Bool
| [] => false
| _ :: _ => true
-- `ℱ` も暗黙引数になる
def nonempty₃ : List ℱ → Bool
| [] => false
| _ :: _ => true
-- ２文字の識別子は暗黙引数として追加されない
/-
error: Unknown identifier `AB`
Note: It is not possible to treat `AB` as an implicitly bound variable here because it has multiple characters while the `relaxedAutoImplicit` option is set to `false`.
-/
def nonempty₄ : List AB → Bool
| [] => false
| _ :: _ => true
end autoImpl
hygiene
hygiene オプションは、マクロ衛生機能を有効にするかどうかを制御します。
プログラミング言語に対して、マクロが 衛生的(hygienic) であるとは、マクロ処理の過程で名前衝突の問題が発生しないことを指します。Lean のマクロはデフォルトで衛生的ですが、hygiene オプションは一時的にこれを無効にすることができます。
/-- 定数関数を定義するマクロ -/
macro "const" e:term : term => `(fun x => $e)
def x : Nat := 42
def y : Nat := 42
-- マクロ衛生がきちんと働いているときの挙動
#guard (const x) 0 = 42
#guard (const y) 0 = 42
-- マクロ衛生を保つ機能を無効にする
set_option hygiene false
/-- マクロ衛生が無効になった定数関数マクロ -/
macro "const'" e:term : term => `(fun x => $e)
-- 引数の値が同じでも、識別子の名前によって値が変わるようになってしまった。
-- これはマクロの中で使用されている変数名も `x` であるため。
#guard (const' x) 0 = 0
#guard (const' y) 0 = 42
タクティクにおけるマクロ衛生
タクティクで導入される識別子についても、実行時の環境にある識別子と衝突しないようにする機能が Lean にはあります。
macro "my_intro" : tactic => `(tactic| intro h)
example (P : Prop) : P → P := by
my_intro
-- `h : P` がマクロ展開によって導入されはするが、
-- 死んでいるので使えない
fail_if_success exact h
assumption
-- マクロ衛生を保つ機能を無効にする
set_option hygiene false
macro "my_intro'" : tactic => `(tactic| intro h)
example (P : Prop) : P → P := by
my_intro'
-- `h : P` が使えてしまう
exact h
また、(驚くべきことに)タクティクマクロの中で導入した識別子だけでなく、「参照した」識別子についても Lean が自動的に衝突を回避します。
/-- exfalso タクティクを真似て自作したタクティク -/
macro "my_exfalso" : tactic => `(tactic| apply False.elim)
namespace Foo
/-- `False.elim` とめっちゃよく似た名前の紛らわしい定理 -/
theorem False.elim : 1 + 1 = 2 := by rfl
example (_h : False) : 1 + 1 = 2 := by
-- 普通に `apply` すると上の紛らわしい定理の方が使われてしまう
apply False.elim
done
example (h : False) : 1 + 1 = 2 := by
-- 実行した環境ではなくて宣言した環境における `False.elim` が使われる。
-- 紛らわしい方の定理は使われない！
my_exfalso
show False
contradiction
end Foo
-- マクロ衛生を保つ機能を無効にする
set_option hygiene false
/-- マクロ衛生が無効になったバージョンの `my_exfalso` -/
macro "my_exfalso'" : tactic => `(tactic| apply False.elim)
namespace Bar
/-- `False.elim` とめっちゃよく似た名前の紛らわしい定理 -/
theorem False.elim : 1 + 1 = 2 := by rfl
example (_h : False) : 1 + 1 = 2 := by
-- 紛らわしい方の `False.elim` が使われてしまう。
my_exfalso'
done
end Bar
用途：定義すると同時に記法を使う
通常、notation コマンドなどによって導入された記法は定義の途中では使うことができません。定義が終了した後で記法を宣言するのが一般的です。
namespace Ordinary
inductive Nat.myle (n : Nat) : Nat → Prop where
| refl : myle n n
| step {m : Nat} : myle n m → myle n (m + 1)
scoped notation:50 a:50 " ≤ₘ " b:50 => Nat.myle a b
end Ordinary
もし定義の途中で記法を使いたければ、hygiene オプションと local 修飾子を利用して次のようにすれば可能です。
section
set_option hygiene false
-- 定義の間だけ有効になるように記法を一時的に与える
local notation:50 a:50 " ≤ₘ " b:50 => Nat.myle a b
inductive Nat.myle (n : Nat) : Nat → Prop where
| refl : n ≤ₘ n
| step {m : Nat} : n ≤ₘ m → n ≤ₘ m + 1
end
-- 改めて記法を付与する
notation:50 a:50 " ≤ₘ " b:50 => Nat.myle a b
-- 通常通り証明が行える
example {n m k : Nat} (hnm : n ≤ₘ m) (hmk : m ≤ₘ k) : n ≤ₘ k := by
induction hmk with
| refl => assumption
| step hmk ih =>
apply Nat.myle.step
assumption
linter.flexible
linter.flexible オプションは、ライブラリの変更に対して頑強な証明を作るためのリンタの有効/無効を切り替えます。
背景
証明を書く際のベストプラクティスとして、simp タクティクのような柔軟性のあるタクティクは、証明の末尾以外で使わないほうがよいということが知られています。1 simp タクティクはどういう補題が [simp] 属性で登録されているかに応じて挙動が変わるため、引用しているライブラリに simp 補題が新たに追加されたり、削除されたりするたびに挙動が変わってしまうためです。
たとえば、以下のような証明を考えてみます。
opaque foo : Nat
opaque bar : Nat
/-- `foo` と `bar` が等しいという定理 -/
axiom foo_eq_bar : foo = bar
example {P : Nat → Prop} (hbar : P bar) : True ∧ (P foo) := by
simp
rw [foo_eq_bar]
assumption
ここで、定理 foo_eq_bar は今のところ [simp] 属性が与えられていませんが、与えられると rw タクティクが失敗するようになります。
attribute [simp] foo_eq_bar
example {P : Nat → Prop} (hbar : P bar) : True ∧ (P foo) := by
-- 元々はゴールを `P foo` に変えていた
simp
-- ゴールが変わってしまった
guard_target =ₛ P bar
-- `rw` タクティクが失敗するようになった
fail_if_success rw [foo_eq_bar]
assumption
ここで問題は、simp 補題が追加される前の証明において、元々 simp タクティクがゴールを何から何に変形していたのかわからないということです。この例では foo_eq_bar が追加されたことが分かっていますが、一般にはライブラリにどのような変更があったのかはすぐにわかることではありません。ライブラリの差分のことを知らなくても、証明が壊れる前の simp タクティクが何を行っていたか知る方法が必要です。
これは simp が柔軟(flexible)なタクティクであることが原因で、対策として次のような方法が知られています。
- 証明末でしか
simpタクティクを使わない。証明末であれば、「壊れる前の証明においてsimpが何を行っていたか」は常に「残りのゴールを閉じる」であり明確で、ライブラリの変更があってもどう修正すればいいかがわかりやすいからです。 haveタクティクやsufficesタクティクを使って証明末そのものを増やす。simp only構文を使って、ライブラリ側に変更があってもsimpタクティクの挙動が変わらないようにする。simpaタクティクのような、ゴールを閉じなければならないという制約を持つタクティクで書き換える。
このリンタについて
このリンタを有効にすると、上記のようなライブラリの変更に対して脆弱な証明を自動で検出して、警告を出してくれます。
import Mathlib.Tactic.Linter.FlexibleLinter
set_option linter.flexible true
/-
warning: `simp` is a flexible tactic modifying `⊢`. Try `simp?` and use the suggested `simp only [...]`. Alternatively, use `suffices` to explicitly state the simplified form.
Note: This linter can be disabled with `set_option linter.flexible false`
-/
example {n m : Nat} (h : n = m) : True ∧ (n = m) := by
simp
exact h
example {n m : Nat} (h : n = m) : True ∧ (n = m) := by
-- 書き換えると警告が消える
simpa
linter.style.multiGoal
linter.style.multiGoal は、よくない証明の書き方を指摘するリンターの一つです。
Lean では、複数のサブゴールがあるときにタクティクを実行すると最初のゴールに対して実行されるのですが、証明を構造化するという観点からは、ゴールの一つにフォーカスする（infoview に一つしかゴールが表示されないようにする）べきです。 このリンタはそのような問題を指摘します。
import Mathlib.Tactic.Linter.Multigoal
set_option linter.style.multiGoal true
/-
warning: The following tactic starts with 2 goals and ends with 1 goal, 1 of which is not operated on.
exact hP
Please focus on the current goal, for instance using `·` (typed as "\.").
Note: This linter can be disabled with `set_option linter.style.multiGoal false`
-/
example {P Q : Prop} (hP : P) (hQ : Q) : P ∧ Q := by
-- ゴールが２つ生成される
constructor
-- この時点でサブゴールが２つあるのに、
-- フォーカスせずにタクティクを実行しているので警告が出る
exact hP
exact hQ
-- 良い証明の例
example {P Q : Prop} (hP : P) (hQ : Q) : P ∧ Q := by
constructor
· exact hP
· exact hQ
linter.missingDocs
linter.missingDocs オプションを有効にすると、ドキュメントコメントが与えられていない定義に対して警告が表示されます。
set_option linter.missingDocs true
/-
warning: missing doc string for public def hoge
Note: This linter can be disabled with `set_option linter.missingDocs false`
-/
def hoge := 42
-- ドキュメントコメントを付与すると警告が消える
/- なにがしかのコメント -/
def foo := 11
なお private とマークされた定義には警告が出ません。
private def bar := 99
theorem で宣言された定理や補題に対しても警告が出ません。
theorem foo_hoge : foo + hoge = 53 := by
rfl
補足
上記で述べたように linter.missingDocs オプションは theorem を無視しますが、Linter を自作することによって、theorem に対してドキュメントを要求するようなリンターを自作できます。
まず、以下のようなファイルを作成します。
import Lean
open Lean Elab Command Name
/--
ドキュメントコメントが付与されていない定理に対して警告を発するリンター。
デフォルトでは有効。
-/
register_option linter.docBlameThm : Bool := {
defValue := true
descr := "docBlameThmリンターを有効にする"
}
/--
ある位置 `pos` 以降にソースコード内で登場するすべての宣言名を収集する
-/
private def getNamesFrom (pos : String.Pos.Raw) : CommandElabM (Array Syntax) := do
let drs := declRangeExt.toPersistentEnvExtension.getState (asyncMode := .local) (← getEnv)
let fm ← getFileMap
let mut nms := #[]
for (nm, rgs) in drs do
if pos ≤ fm.ofPosition rgs.range.pos then
let ofPos1 := fm.ofPosition rgs.selectionRange.pos
let ofPos2 := fm.ofPosition rgs.selectionRange.endPos
nms := nms.push (mkIdentFrom (.ofRange ⟨ofPos1, ofPos2⟩) nm)
return nms
/-- ドキュメントコメントが付与されているかどうか判定する -/
def Lean.Name.hasDocString (c : Name) (env : Environment) : CoreM Bool := do
let doc? ← findDocString? env c
return doc?.isSome
/-- ある宣言が `theorem` で宣言されているかどうか判定する -/
def Lean.Name.isTheorem (c : Name) : CommandElabM Bool := do
let info ← getConstInfo c
match info with
| .thmInfo _ => return true
| _ => return false
@[inherit_doc linter.docBlameThm]
def docBlameThmLinter : Linter where
run := withSetOptionIn fun stx ↦ do
-- リンターが有効になっていなければ何もしない
unless Linter.getLinterValue linter.docBlameThm (← Linter.getLinterOptions) do
return
-- どこかにエラーがあれば何もしない
if (← get).messages.hasErrors then
return
-- ユーザが定義した名前を取得する
let names := (← getNamesFrom (stx.getPos?.getD default))
|>.filter (! ·.getId.isInternal)
let env ← getEnv
for constStx in names do
let constName := constStx.getId
-- 定理でなければ無視する
if ! (← constName.isTheorem) then
continue
-- ドキュメントコメントがなければ警告を出す
let hasDocStr ← liftCoreM <| constName.hasDocString env
if ! hasDocStr then
Linter.logLint linter.docBlameThm constStx
m!"`{constName}`にドキュメントコメントを与えてください。"
initialize addLinter docBlameThmLinter
このファイルを読み込むと、次のように使用できます。
import LeanByExample.Option.MissingDocs.DocBlameThm
/-
warning: `ex`にドキュメントコメントを与えてください。
Note: This linter can be disabled with `set_option linter.docBlameThm false`
-/
theorem ex : True := by trivial
-- `private` な定理に対しては warning が出ない
private theorem ex2 : True := by trivial
-- example に対しては warning が出ない
example : True := by trivial
-- `def`に対しては warning が出ない
def hoge := 42
pp.macroStack
pp.macroStack オプションをtrueにすると、マクロの展開過程がステップごとに表示されるようになります。
たとえば、以下のようなマクロを定義したとします。
/-- 自前で定義したリスト型 -/
inductive MyList (α : Type) where
| nil
| cons (head : α) (tail : MyList α)
deriving DecidableEq
/-- 空リスト。標準の`List`のための記法と被るのを避けている。 -/
notation:max " ⟦⟧ " => MyList.nil
/-- `MyList`に要素を追加する。標準の`List`のための記法と被るのを避けている。 -/
infixr:80 " ::: " => MyList.cons
/-- 自作のリストリテラル構文。なお末尾のカンマは許可される。
なお標準の`List`のための記法と被るのを避けている。 -/
syntax "⟦" term,*,? "⟧" : term
macro_rules
| `(⟦$x⟧) => `($x ::: ⟦⟧)
| `(⟦$x, $xs,*⟧) => `($x ::: (⟦$xs,*⟧))
これは一見正しそうに見えますが、実際に使ってみるとエラーになってしまいます。
#check_failure ⟦1, ⟧
こうしたときに、マクロがどういう順に展開されていってどこでエラーになったかを確認するのに pp.macroStack オプションは役に立ちます。
set_option pp.macroStack true
/-
info: elaboration function for `«term⟦_⟧»` has not been implemented
⟦ ⟧
with resulting expansion
⟦ ⟧
while expanding
(⟦ ⟧)
while expanding
1 ::: (⟦ ⟧)
while expanding
⟦1, ⟧
-/
#check_failure ⟦1, ⟧
relaxedAutoImplicit
relaxedAutoImplicit オプションは、autoImplicit オプションの派生オプションであり、自動束縛の対象を広げます。
-- `autoImplicit` は有効にしておく
set_option autoImplicit true
section
-- `relaxedAutoImplicit` が無効の時
set_option relaxedAutoImplicit false
-- 二文字の識別子は自動束縛の対象にならないのでエラーになる
/-
error: Unknown identifier `AB`
Note: It is not possible to treat `AB` as an implicitly bound variable here because it has multiple characters while the `relaxedAutoImplicit` option is set to `false`.
-/
def nonempty₁ : List AB → Bool
| [] => false
| _ :: _ => true
end
section
-- `relaxedAutoImplicit` が有効の時
set_option relaxedAutoImplicit true
-- 二文字の識別子も自動束縛の対象になるのでエラーにならない
def nonempty₂ : List AB → Bool
| [] => false
| _ :: _ => true
end
debug.skipKernelTC
debug.skipKernelTC を有効にすると、カーネルによる型検査が行われなくなります。結果として、不正な証明を Lean に受け入れさせることができてしまいます。
import Lean
section
open Lean Elab Tactic
set_option debug.skipKernelTC true
elab "so_sorry" : tactic => do
closeMainGoal `so_sorry (Lean.mkConst ``trivial)
def bad_proof : False := by so_sorry
end
-- Fermat の最終定理が証明できてしまう
theorem easy_proof (x y z n : Nat) : n > 2 → x ^ n + y ^ n = z ^ n → x * y * z = 0 := by
exact bad_proof.elim
debug.skipKernelTC を使った証明は、#print axioms コマンドを使用しても正当な証明と見分けがつかないことに注意が必要です。
/- info: 'easy_proof' does not depend on any axioms -/
#print axioms easy_proof
補足: skipKernelTC を禁止すれば不正な証明を防げるか？
debug.skipKernelTC オプションを禁止しても、以下のように、代わりに addDeclCore 関数を使うなどして同様のことが実現できてしまいます。
section
open Lean
def myBadTheorem : TheoremVal where
name := `bad_proof₂
levelParams := []
type := Lean.mkConst ``False
value := Lean.mkConst ``trivial
all := []
#eval show CoreM Unit from do
let currentEnv ← getEnv
match currentEnv.addDeclCore (doCheck := false) 0 0 (.thmDecl myBadTheorem) none with
| .ok env => setEnv env
| .error _ => throwError "didn't work"
end
-- Fermat の最終定理が証明できてしまう
theorem easy_proof₂ (x y z n : Nat) : n > 2 → x ^ n + y ^ n = z ^ n → x * y * z = 0 := by
exact bad_proof₂.elim
/- info: 'easy_proof₂' does not depend on any axioms -/
#print axioms easy_proof₂
型クラス
型クラス(type class) とは、和や積、逆数を取る演算など、複数の型に対してそれぞれのやり方で実装されるような演算を定義するものです。
型クラスは主に class コマンドで定義され、インスタンスを宣言するには instance コマンドを使用します。
Add
Add は + という二項演算子のための型クラスです。ここまで HAdd と同じですが、HAdd は異なるかもしれない型 α, β, γ に対して足し算 (· + ·) : α → β → γ を定義することができる一方で、Add は同じ型 α に対して足し算 (· + ·) : α → α → α を定義することしかできません。
+ 記法が何を意味するかについては制約はありませんが、足し算で表される演算は可換であることが期待されるので、例外はあるものの a + b = b + a が成り立つような実装をすることが推奨されます。
/-- 自前で定義した自然数 -/
inductive MyNat where
| zero
| succ (n : MyNat)
namespace MyNat
/- ## MyNat の足し算を定義する -/
def add (m n : MyNat) : MyNat :=
match n with
| zero => m
| succ n => succ (add m n)
-- 記法が定義されていないので使えない
#check_failure MyNat.zero + MyNat.zero
-- `add` 関数を `+` の実装とする
instance : Add MyNat where
add := add
-- 足し算記号が使えるようになった
#check MyNat.zero + MyNat.zero
end MyNat
舞台裏
Add 型クラスは、内部的には HAdd に展開されています。
-- #check コマンドの出力で記法を使わないようにする
set_option pp.notation false in
/- info: HAdd.hAdd MyNat.zero MyNat.zero : MyNat -/
#check MyNat.zero + MyNat.zero
Alternative
Alternative 関手は、回復可能な失敗を表現します。あるいは、選択的な計算を表すと表現することもできます。
定義
Alternative クラスは、Applicative 型クラスを継承して概ね次のように定義されています。
class Alternative (f : Type u → Type v) extends Applicative f where
/--
空のコレクションまたは回復可能な失敗を生成する。
-/
failure : {α : Type u} → f α
/--
`Alternative`インスタンスに応じて、値を拾ったり最初に成功した結果を返すことで
`failure`から回復したりする。
-/
orElse : {α : Type u} → f α → (Unit → f α) → f α
構文
Alternative のインスタンスにすると、<|> という二項演算子が使えるようになります。<|> は orElse とほぼ対応していますが、少し型が異なります。
section
variable {α : Type}
-- `F` は `Alternative` 関手
variable {F : Type → Type} [Alternative F]
-- `orElse` と `<|>` は基本的には同じもの
example (a : F α) (b : Unit → F α) : Alternative.orElse a b = (a <|> b ()) := rfl
-- 型が少し `orElse` と異なる
example : F α → F α → F α := fun x y => (x <|> y)
end
インスタンス
Option
重要なインスタンスとして、Option は Alternative のインスタンスです。failure は none として実装されていて、(· <|> ·) は最初の none でない値を選択するような処理として実装されています。
#guard (failure : Option Nat) = none
#guard (some 2 <|> none <|> some 5) = some 2
#guard (none <|> none <|> some 5 <|> some 4) = some 5
Option の (· <|> ·) は評価を順に行っていって、失敗したら単に次に進むということを繰り返しながら、成功するまで評価を続けます。早期に成功した場合、後続の項は評価されません。
/- info: some "hello" -/
#eval some "hello" <|> (dbg_trace "foo!"; some "world")
List
List も Alternative のインスタンスにすることができます。
-- モナドのインスタンスにする
instance : Monad List where
pure x := [x]
bind l f := l.flatMap f
map f l := l.map f
-- Alternative のインスタンスにする
instance : Alternative List where
failure := @List.nil
orElse l l' := List.append l (l' ())
#guard ([] <|> [1, 2, 3]) = [1, 2, 3]
#guard ([1, 2, 3] <|> [4, 5, 6]) = [1, 2, 3, 4, 5, 6]
guard 関数
「条件 p が真ならば何もしない。そうでなければ失敗とする」という処理のために guard 関数が用意されています。
section
/- ## filter の再帰を使う定義と、使わない定義を比較する -/
variable {α : Type}
/-- do 構文による filter の実装 -/
def List.doFilter (p : α → Bool) (xs : List α) : List α := do
-- リスト `xs` から要素 `x` を取り出す
let x ← xs
-- `p x` が真なら残す
guard <| p x
return x
-- 再帰を使う標準の定義と一致する
#test
∀ {α : Type} (p : α → Bool) (xs : List α),
List.doFilter p xs = List.filter p xs
end
Append
Append は ++ という二項演算子のための型クラスです。“append” という名前の通り、リストや文字列などを「連結させる」操作を表すのに使われます。
#guard "hello" ++ " world!" = "hello world!"
#guard [1, 2] ++ [3, 4] = [1, 2, 3, 4]
#guard #[1, 2] ++ #[3, 4] = #[1, 2, 3, 4]
ここまで HAppend と同じですが、HAppend は異なるかもしれない型 α, β, γ に対して連結 (· ++ ·) : α → β → γ を定義することができる一方で、Append は同じ型 α に対して連結 (· ++ ·) : α → α → α を定義することしかできません。
Append インスタンスを実装する
以下は、自前で定義した型 MyList に対して Append インスタンスを実装する例です。
/-- 自前で定義したリスト -/
inductive MyList where
| nil
| cons (head : Nat) (tail : MyList)
namespace MyList
def append (xs ys : MyList) : MyList :=
match xs with
| nil => ys
| cons x xs => cons x (append xs ys)
-- 記法が定義されていないので使えない
#check_failure MyList.nil ++ MyList.nil
-- `append` 関数を `++` の実装とする
instance : Append MyList where
append := append
-- 連結記号が使えるようになった
#check MyList.nil ++ MyList.nil
end MyList
舞台裏
Append 型クラスは、内部的には HAppend に展開されています。
-- #check コマンドの出力で記法を使わないようにする
set_option pp.notation false in
/- info: HAppend.hAppend MyList.nil MyList.nil : MyList -/
#check MyList.nil ++ MyList.nil
Add との使い分け
+ で表される演算は可換（a + b = b + a）であることが期待されます。しかしたとえば、文字列やリストの連結は順序に依存するため非可換です。このような非可換な連結に + を使うと混乱を招くため、Lean では ++ という別の記法を用意しています。
-- 文字列の連結は非可換: 順序が違うと結果が異なる
#guard ("Hello, " ++ "world!" ≠ "world!" ++ "Hello, ")
-- リストの連結も非可換
#guard ([1, 2] ++ [3, 4] ≠ [3, 4] ++ [1, 2])
-- 一方、自然数の足し算は可換
#guard 2 + 3 = 3 + 2
Applicative
Applicative 型クラスは、Functor 型クラスの拡張であり、Monad 型クラスよりは制限された中間的な構造です。関数適用を一般化であり、計算効果をエンコードするものと見なすことができます。
定義
Applicative 型クラスは、大雑把に書けば次のように定義されています。(実際の定義はもっと複雑です)
class Applicative.{u, v} (f : Type u → Type v) where
/-- `a : α` が与えられたとき、`pure a : f α` は「何もせずに `a` を返すアクション」を表す。 -/
pure {α : Type u} : α → f α
/--
`<*>` 演算子の実装。
モナドにおいては、`mf <*> mx` は `do let f ← mf; x ← mx; pure (f x)` と同じになる。
つまり、まず関数を評価し、次に引数を評価して適用する。
予期しない順序で評価されることを避けるために、`mx` は `Unit → f α` という関数を使って遅延的に取得される。
-/
seq : {α β : Type u} → f (α → β) → (Unit → f α) → f β
すなわち、関数 F : Type → Type を Applicative 型クラスのインスタンスにするということは、pure : α → F α と (· <*> ·) : F (α → β) → F α → F β を定義するということです。
/-- 標準にある`Option`を真似て構成した関手 -/
inductive MyOption (α : Type) where
| none
| some (a : α)
/-- `MyOption`を`Applicative`のインスタンスにする -/
instance : Applicative MyOption where
pure a := MyOption.some a
seq f a :=
match f, a () with
| .some f, .some a => .some (f a)
| _, _ => .none
Functor との関係
Applicative のインスタンスであるならば、自動的に Functor のインスタンスにもなります。これは、Functor.map を次のように実装することができるからです。
instance {F : Type → Type} [Applicative F]: Functor F where
map f x := pure f <*> x
なぜ「関数適用の一般化」なのか
Functor.map メソッドは (α → β) → F α → F β という型を持ちます。これは、F = Id の場合を考えてみると分かるように、１引数の関数適用を一般化したものだと考えることができます。では２引数、３引数の時はどうなるでしょうか？
単純に拡張すると、２引数の時は (α → β → γ) → F α → F β → F γ という型になり、３引数の時は (α → β → γ → δ) → F α → F β → F γ → F δ という型になります。これらを Functor.map を使って表現するのは困難です。
しかし、F が Applicative 型クラスのインスタンスになっていれば、n 引数の場合でも表現することができます。1
variable {α β γ δ : Type}
variable {F : Type → Type} [Applicative F]
/-- 1引数の場合 -/
example : (α → β) → F α → F β := fun f x =>
pure f <*> x
/-- 2引数の場合 -/
example : (α → β → γ) → F α → F β → F γ := fun f x y =>
pure f <*> x <*> y
/-- 3引数の場合 -/
example : (α → β → γ → δ) → F α → F β → F γ → F δ := fun f x y z =>
pure f <*> x <*> y <*> z
-
ここでの説明は 「プログラミングHaskell 第2版」(Graham Hutton 著、山本和彦訳)を参考にしました。 ↩
BEq
BEq は、== と != による Bool 値の比較を提供する型クラスです。
たとえば Nat には BEq のインスタンスがあるので、2つの自然数を == で比較することができます。
#guard 2 == 2
#guard !(2 == 3)
#guard (2 != 42)
DecidableEq との使い分け
単に Bool 値の比較をしたいだけであれば、DecidableEq のインスタンスでも可能です。しかも DecidableEq なら単に Bool 値の比較ができるだけでなく、∀ x : α, x = x といった「等号が満たすべきルール」もついてくるので、証明に使いたくてかつ DecidableEq が使える場合はそちらを使うべきでしょう。
-- BEq は単なる関数なのでルールは付属しておらず、
-- x == x などを証明するには LawfulBEq が必要
example {α : Type} [BEq α] [LawfulBEq α] (x : α) : x == x := by
simp
-- DecidableEq を仮定すると自動的に BEq と LawfulBEq のインスタンスが生成される
example {α : Type} [DecidableEq α] (x : α) : x == x := by
let _ : LawfulBEq α := by infer_instance
simp
敢えて BEq を使うべきケースもあります。典型的なのは Float です。
Float には NaN という値があります。これは「数値ではない」ことを表す特別な値で、isNaN という関数で判定できます。
-- 0.0 / 0.0 は NaN
#guard (0.0 / 0.0).isNaN
NaN は「自分自身と比較しても等しくない」という特殊な仕様があります。
-- 自分自身と比較しても false になる
#guard !((0.0 / 0.0) == (0.0 / 0.0))
-- 通常の数値の比較は true になる
#guard 3.2 == 3.2
#guard 1.45 == 1.45
一方で命題としては Float に対しても ∀ x, x = x が成り立っています。
example (x : Float) : x = x := by rfl
Coe
Coe は、型強制(coercion) と呼ばれる仕組みをユーザが定義するための型クラスです。
ある型 T が期待される場所に別の型の項 s : S を見つけると、Lean は型エラーにする前に自動的に型変換を行うことができないか試します。ここで行われる「自動的な型変換」が型強制です。型強制を明示的に指定するには、↑ 記号をつけて ↑x などのようにします。なおどの関数を ↑ 記号で表示させるかは [coe] 属性で制御することができます。
具体的には Coe S T という型クラスのインスタンスが定義されているとき、型 S の項が型 T に変換されます。
例えば、正の自然数からなる型 Pos を定義したとします。包含関係から Pos → Nat という変換ができるはずです。この変換を関数として定義するだけでは、必要になるごとに毎回書かなければなりませんが、型強制を使うと自動化することができます。
/-- 正の自然数 -/
inductive Pos where
| one
| succ (n : Pos)
def one : Pos := Pos.one
/-- 階乗関数 -/
def factorial (n : Nat) : Nat :=
match n with
| 0 => 1
| n + 1 => (n + 1) * factorial n
-- `factorial` の引数は `Nat` なのに、`Pos` を渡したのでエラーになる
/-
error: Application type mismatch: The argument
one
has type
Pos
but is expected to have type
Nat
in the application
factorial one
-/
#check factorial one
/-- `Pos` から `Nat` への変換 -/
def Pos.toNat : Pos → Nat
| one => 1
| succ n => n.toNat + 1
-- 明示的に変換すればエラーにならないが、
-- `Pos ⊆ Nat` と見なして自動で変換してほしくなる
#eval factorial <| one.toNat
/-- `Pos` から `Nat` への型強制 -/
instance : Coe Pos Nat where
coe n := n.toNat
-- 自動的に `Pos` から `Nat` への変換が行われるようになった！
#guard factorial one = 1
CoeDep
CoeDep は型強制を行うための型クラスですが、Coe と異なり「項に依存する型強制」(dependent coercion)を行うことができます。
たとえば空でないリストからなる型 NonEmptyList を定義したとします。空リストを変換する方法がないため、List α → NonEmptyList α という変換を定義する自然な方法はありません。しかし CoeDep を使えば空でないリストに限って NonEmptyList に変換するという型強制を定義することができます。
/-- 空でないリスト -/
structure NonEmptyList (α : Type) : Type where
head : α
tail : List α
-- 型強制がないのでエラー
#check_failure ([1, 2] : NonEmptyList Nat)
variable {α : Type}
/-- 型強制。`x :: xs` という形をしている `List` の要素だけを `NonEmptyList` の項に変換する -/
instance {x : α} {xs : List α} : CoeDep (List α) (x :: xs) (NonEmptyList α) where
coe := {head := x, tail := xs}
-- 型強制が定義された
#check ([1, 2] : NonEmptyList Nat)
CoeFun
CoeFun クラスのインスタンスを与えると、関数ではない項を関数型に強制することができます。
/-- 加法的な関数の全体 -/
structure AdditiveFunction : Type where
/-- 関数部分 -/
toFun : Nat → Nat
/-- 加法を保つ -/
additive : ∀ x y, toFun (x + y) = toFun x + toFun y
/-- 恒等写像 -/
def identity : AdditiveFunction := ⟨id, by intro _ _; rfl⟩
-- `identity` の型は `AdditiveFunction` であって、関数ではないのでこれはエラーになる
#check_failure (identity 1)
-- 関数に変換してからならOK
#check (identity.toFun 1)
-- `CoeFun` を使って関数への変換を自動化する
local instance : CoeFun AdditiveFunction (fun _ => Nat → Nat) where
coe f := f.toFun
-- まるで関数のように使えるようになる
#check (identity 1)
上記の例ではどんな t : AdditiveFunction も同じ型 Nat → Nat に強制していますが、実際には依存関数型に強制することができます。
Coe との違い
上記の例を、Coe を使って再現しようとして下記のようにしても上手くいかないことに注意して下さい。
-- `Coe` で `Nat → Nat` への変換を自動化しようとしている例
local instance : Coe AdditiveFunction (Nat → Nat) where
coe f := f.toFun
-- `Nat → Nat` への型強制が呼び出されず、エラーになってしまう
-- これは、期待されている型が `Nat → Nat` ではなく、単に `Nat → ?_` であるため。
#check_failure (identity 1)
-- 期待される型を明記すればエラーにならない
#check ((identity : Nat → Nat) 1)
CoeSort
CorSort は Coe と同じく型強制を定義するための型クラスですが、違いとして型宇宙(Type や Prop など、項が再び型であるような型)への変換を専門に行う点が挙げられます。
import Mathlib.Data.Fintype.Basic -- `Fintype` を使うため
/-- 有限集合の圏 -/
structure FinCat where
/-- 台集合 -/
base : Type
/-- 台集合が有限集合であるという性質 -/
fin : Fintype base
/-- 要素が2つの集合。有限集合なので `FinCat` のオブジェクト。-/
def Two : FinCat := { base := Fin 2, fin := inferInstance }
-- `Two` は有限集合の圏のオブジェクトなので集合っぽいものであってほしいが、
-- `Two` の型は `FinCat` であって `Type` などの型宇宙ではないので、
-- `a : Two` という書き方ができない。
/-
info: type expected, got
(Two : FinCat)
-/
#check_failure ((1 : Fin 2) : Two)
-- `Two → Two` という書き方もできない。
-- `A → A` も `A` の型が `Type` などの型宇宙であることを要求する。
/-
info: type expected, got
(Two : FinCat)
-/
#check_failure (Two → Two)
-- 台集合はあくまで `Two.base` なので、
-- `.base` をつける必要がある。
#check ((1 : Fin 2) : Two.base)
#check (Two.base → Two.base)
section
/-- `FinCat` から `Type` への型強制。
`S : FinCat` を、`S.base : Type` に変換する。-/
local instance : CoeSort FinCat Type := ⟨fun S ↦ S.base⟩
-- 型強制があるのでこういう書き方ができる
#check ((1 : Fin 2) : Two)
#check Two → Two
end
Coe との違い
Coe で同様のコードを書いても、上記の FinCat の例はうまくいきません。
section
local instance : Coe FinCat Type := ⟨fun S ↦ S.base⟩
#check_failure ((1 : Fin 2) : Two)
#check_failure (Two → Two)
end
しかし、これは「Coe では型宇宙への変換は扱えないから」ではありません。Coe と CoeSort では型強制が呼ばれるタイミングが異なるからです。Coe は「ある型の項が期待される場所に、異なる型の項が来た時」にトリガーされますが、CoeSort は「型が期待される場所に型が来ていないとき」にトリガーされます。
実際、Coe を使っても Type への型強制は定義することができます。
/-- 型を受け取ってゼロを返す関数 -/
def zero (_ : Type) : Nat := 0
/-- `Type` のラッパー -/
structure AltType where
base : Type
def A : AltType := ⟨Nat⟩
-- `zero` は `Type` を期待しているのでエラーになる
#check_failure zero A
section
/-- `AltType` を `Type` に型強制する -/
local instance : Coe AltType Type := ⟨fun S ↦ S.base⟩
-- 成功するようになった！
#check zero A
end
Decidable
Decidable は、命題が決定可能であることを示す型クラスです。
ここで命題 P : Prop が決定可能であるとは、（後述する例外を除き）その真偽を決定するアルゴリズムが存在することを意味します。具体的には P : Prop が Decidable のインスタンスであるとき、decide 関数を適用することにより decide P : Bool が得られます。
-- 決定可能な命題を決定する関数 decide が存在する
#check (decide : (P : Prop) → [Decidable P] → Bool)
/- info: true -/
#eval decide (2 + 2 = 4)
/- info: false -/
#eval decide (2 + 2 = 5)
Decidable 型クラスのインスタンスに対しては、decide タクティクにより証明が可能です。
/-- 自前で定義した偶数を表す述語 -/
def Even (n : Nat) : Prop := ∃ m : Nat, n = 2 * m
example : Even 4 := by
-- 最初は decide で示すことができない
fail_if_success decide
exists 2
theorem even_impl (n : Nat) : n % 2 = 0 ↔ Even n := by
constructor <;> intro h
case mp =>
exists (n / 2)
omega
case mpr =>
obtain ⟨m, rfl⟩ := h
omega
/-- Even が決定可能であることを示す -/
instance (n : Nat) : Decidable (Even n) :=
decidable_of_iff (n % 2 = 0) (even_impl n)
-- decide で証明ができるようになった！
example : Even 4 := by decide
class inductive
Decidable 型クラスの定義は少し特殊です。コンストラクタが複数あり、構造体ではなく帰納型の構造をしています。これは Decidable が class inductive というコマンドで定義されているためです。
class inductive Decidable (p : Prop) where
/-- `¬ p` であることが分かっているなら、`p` は決定可能 -/
| isFalse (h : Not p) : Decidable p
/-- `p` であることが分かっているなら、`p` は決定可能 -/
| isTrue (h : p) : Decidable p
排中律と決定可能性
命題 P : Prop が決定可能というのは、実際のところ「P の証明または ¬ P の証明を持っている」ということを意味します。したがって、P の証明または ¬ P の証明のいずれかが手に入っているのであれば、そこから Decidable P のインスタンスを構築することができ、P は決定可能であるといえます。
def inst_decidable_lem {P : Prop} (h : P ⊕' (¬ P)) : Decidable P := by
cases h with
| inl h =>
apply Decidable.isTrue
exact h
| inr h =>
apply Decidable.isFalse
exact h
もっと言えば、排中律を利用してよければ任意の命題 P : Prop に対して P の証明または ¬ P の証明を得ることができるので、すべての命題は決定可能になります。
これはもちろん、「どんな命題に対しても、それを決定できるアルゴリズムが作れる」という意味ではありません。逆です。Decidable 型クラスが意味を失ってしまうということです。
/-- 排中律を利用すれば任意の命題について、肯定または否定の証明が手に入る -/
noncomputable example (P : Prop) : P ⊕' (¬ P) := by
by_cases h : P
case pos => exact PSum.inl h
case neg => exact PSum.inr h
/-- 排中律を仮定すれば、任意の命題は決定可能 -/
noncomputable instance (P : Prop) : Decidable P := by
exact Classical.propDecidable P
実際、排中律を使って得られた Decidable インスタンスは計算的な解釈を持たないため、そうやって Decidable インスタンスを得ても decide タクティクで証明をすることはできません。
/-- 奇数を表す述語 -/
def Odd (n : Nat) : Prop := ∃ m : Nat, n = 2 * m + 1
-- 排中律を利用して決定可能にしている
noncomputable instance (n : Nat) : Decidable (Odd n) := by
classical
infer_instance
example : Odd 3 := by
-- decide で証明ができない
fail_if_success decide
exists 1
Functor
Functor は圏論における 関手(functor) という概念からその名がある型クラスです。
型を受け取って型を返す関数 F : Type u → Type v が関手であるとは、型 α : Type u を写すことができるだけでなく、関数 f : α → β を F α → F β 型の関数に写す方法があることを意味します。つまり、関手とは「型を写す」だけでなく同時に「関数も写す」ことができるようなものです。
シンプルにするために宇宙レベルを無視し、デフォルト値が持たされたフィールドも無視すると、Functor 型クラスは次のように定義されています。
/-- 関手。標準ライブラリにある `Functor` を真似て定義した型 -/
class Functor (F : Type → Type) where
/-- 関数 `f : α → β` を関数 `F α → F β` に変換する -/
map : (α → β) → F α → F β
つまり、関手は Functor.map という高階関数を持っており、f : α → β という関数を Functor.map f : F α → F β という関数に移すことができます。この関数は「普通の関数 f : α → β」を「F に包まれた Type 間の関数 F α → F β」に写していることから、持ち上げ(lift) であると呼ばれることがあります。
Functor.map はよく使われる操作であるため、<$> という専用の記法が用意されています。
-- `F` は Functor であると仮定
variable (F : Type → Type) [Functor F]
-- `<$>` は `map` と同じ
example (x : F α) (g : α → β) : g <$> x = Functor.map g x :=
rfl
型が合っているだけでは予想外の挙動をすることがあるので、関手が満たすべきルールが存在し、それは LawfulFunctor というクラスにまとめられています。
典型的なインスタンス
Id
Id : Type u → Type u は「何もしない」関手です。
/-- `Id` の `Functor.map` の実装を真似て作った関数 -/
def Id.myMap {α β : Type} (f : α → β) (x : Id α) : Id β := f x
/-- `Id` の `Functor.map` は `Id.myMap` のように定義されている -/
example {α β : Type} (f : α → β) (x : Id α) : Id.myMap f x = f <$> x := rfl
List
Functor 型クラスの典型的なインスタンスのひとつが List です。これにより「リストの各要素に関数を適用する」ための簡単な方法が提供されます。
/-- 標準にある `List.map` の実装を真似て実装した `map` 処理 -/
def List.myMap {α β : Type} (f : α → β) : List α → List β
| [] => []
| x :: xs => f x :: List.myMap f xs
/-- `List` の `Functor.map` は `List.myMap` のように定義されている -/
example {α β : Type} (f : α → β) (xs : List α) : List.myMap f xs = f <$> xs := by
induction xs with
| nil => rfl
| cons x xs ih =>
simp_all [List.myMap, Functor.map]
-- リストの各要素を２倍する例
#guard (· * 2) <$> [1, 2, 3, 4, 5] = [2, 4, 6, 8, 10]
Option
Option も Functor 型クラスのインスタンスになっています。これにより「x? : Option が some x の場合にだけ関数を適用し、none なら none を返す」という操作のための簡単な方法が提供されます。
/-- 標準にある `Option.map` の実装を真似て実装した `map` 処理 -/
def Option.myMap {α β : Type} (f : α → β) : Option α → Option β
| some x => some (f x)
| none => none
/-- `Option` の `Functor.map` は `Option.myMap` のように定義されている -/
example {α β : Type} (f : α → β) (x : Option α) : Option.myMap f x = f <$> x := by
cases x <;> rfl
#guard (· * 2) <$> some 2 = some 4
#guard (· * 2) <$> [1, 2, 3][4]? = none
/- info: 20 -/
#eval (· * 2) <$> (10 : Id Nat)
(A → ·)
任意の型 A : Type u に対して、fun X => (A → X) という対応は関手になります。
/-- 型から、その型への関数型を返す -/
abbrev Hom (A : Type) (X : Type) := A → X
/-- 関数合成を map として `Hom A` は関手になる -/
instance {A : Type} : Functor (Hom A) where
map f g := f ∘ g
#guard
let doubleLength : Hom String Nat := (· * 2) <$> String.length
doubleLength "hello" = 10 && doubleLength "world!" = 12
上記で定義した Hom は Lean の標準ライブラリでは ReaderM と呼ばれます。
/-- 上で定義した Hom は ReaderM に等しい -/
example (A : Type) : ReaderM A = Hom A := rfl
((· → A) → A)
任意の型 A : Type u に対して、fun X => (X → A) → A という対応は関手になります。1
abbrev Cont (A : Type) (X : Type) := (X → A) → A
instance {A : Type} : Functor (Cont A) where
map f g := fun h => g (h ∘ f)
(A × ·)
任意の型 A : Type に対して、A との直積を取る対応 fun X => A × X は関手になります。
section
-- 最初 Functor インスタンスは用意されていない
#check_failure (· * 2) <$> ("hello", 20)
abbrev prodWith (A : Type) (X : Type) := A × X
local instance {A : Type} : Functor (prodWith A) where
map f := fun (a, x) => (a, f x)
#guard (· * 2) <$> ("hello", 20) = ("hello", 40)
end
(A ⊕ ·)
任意の型 A : Type に対して、A との直和を取る対応 fun X => A ⊕ X は関手になります。
section
-- 最初 Functor インスタンスは用意されていない
#check_failure (· * 2) <$> (Sum.inr 20 : String ⊕ Nat)
abbrev sumWith (A : Type) (X : Type) := Sum A X
local instance {A : Type} : Functor (sumWith A) where
map f := fun z =>
match z with
| .inl a => Sum.inl a
| .inr x => Sum.inr (f x)
#eval (· * 2) <$> (Sum.inr 20 : String ⊕ Nat)
end
Functor 則
Functor 型クラスのインスタンスには満たすべきルールがあります。このルールを破っていても Functor 型クラスのインスタンスにすることは可能ですが、避けるべきです。Functor 型クラスがルールを満たしていることを証明するためには、LawfulFunctor 型クラスを使います。
-
この関手は、 継続モナド(continuation monad) として知られているものです。詳細は、たとえば Andrzej Filinski 「Representing monads」(1994) などを参照のこと。 ↩
GetElem
GetElem 型クラスは、リストや配列などの「データの直線的な集まり」を表す型 Col の項 as : Col に対して、その i 番目の要素を取得する方法を提供します。GetElem 型クラスを実装すると、as[i] というインデックスアクセスの構文が使用できるようになります。
/-- 標準にある List を真似て作ったデータ構造 -/
inductive MyList (α : Type) where
| nil
| cons (head : α) (tail : MyList α)
namespace MyList
/- ## MyList のための外延記法 -/
/-- MyList のための外延記法 -/
syntax "my[" term,* "]" : term
macro_rules
| `(my[]) => `(MyList.nil)
| `(my[$e]) => `(MyList.cons $e MyList.nil)
| `(my[$e, $elems,* ]) => `(MyList.cons $e (my[$elems,*]))
#check my[1, 2, 3]
end MyList
namespace MyList
/- ## GetElem 型クラスのインスタンスを定義 -/
-- 作ったばかりで実装していないため、
-- インデックスアクセスの構文 `as[i]` が使えない
#check_failure my[1, 2, 3][2]
variable {α : Type}
/-- リストの長さを返す関数 -/
def length (l : MyList α) : Nat :=
match l with
| nil => 0
| cons _ t => 1 + length t
/-- `as : MyList` の `idx` 番目の要素を取得する。
`idx` の型は `Fin` としてある。 -/
def get (as : MyList α) (idx : Fin as.length) : α :=
match as, idx with
| .cons head _, ⟨0, _⟩ => head
| .cons _ as, ⟨i + 1, h⟩ =>
-- インデックスアクセスが妥当であることを証明する
have bound : i < as.length := by
simp [MyList.length] at h
omega
MyList.get as ⟨i, bound⟩
/-- MyList を GetElem のインスタンスにする -/
instance : GetElem (MyList α) Nat α (fun as i => i < as.length) where
getElem as i h := as.get ⟨i, h⟩
-- インデックスアクセスの構文が使えるようになった
#guard my[1, 2, 3][2] = 3
end MyList
インデックスアクセスの種類
コレクション as に対して、i 番目の要素を取得すると書きましたが、i 番目の要素があるとは限らないという問題があります。これに対処するには様々な方法がありえますが、中でも以下のものは専用の構文が用意されています。
as[i]
as[i] という構文では、インデックス i が範囲内であることの証明を自動で構成します。i が変数になっていて具体的に計算できないときでも、ローカルコンテキスト内に i が範囲内であることの証明があれば動作します。
-- 具体的な数値を渡せば、それが範囲内であることを自動的に証明してくれる
#guard my[1, 2, 3][2] = 3
#eval show IO Unit from do
let l := my[1, 2, 3]
-- for 文を回すときに `h : i` とすると
-- `i` についての情報を取得できる
for h : i in [0:3] do
-- インデックスが範囲内であることを証明する
have : i < l.length := Membership.get_elem_helper h rfl
IO.println l[i]
as[i]?
as[i]? という構文では、返り値を Option に包みます。範囲外の場合は none を返します。
-- 返り値を Option に包む場合
#guard my[1, 2, 3][2]? = some 3
#guard my[1, 2, 3][3]? = none
as[i]!
as[i]! という構文では、i が範囲外だった時には panic! することにして Option で包まずに直接値を取り出します。
-- 範囲外ならエラーで落とすことにして強引に値を取り出す
#guard my[1, 2, 3][2]! = 3
インデックスアクセスの妥当性を証明する必要がないためユーザは楽ですが、実行時に境界チェックを行うのでその分速度が遅くなります。
as[i]’h
xs[i]'h という構文では、i が範囲内であることの証明 h を明示的に渡して値を取り出します。
-- インデックスが範囲内であることの証明を明示的に渡す
#guard
let xs := my[1, 2, 3]
let h := show 2 < xs.length from by decide
xs[2]'h = 3
HAdd
HAdd (heterogeneous addition)は、+ という二項演算子のための型クラスです。
+ 記法が何を意味するかについては制約はありません。
任意の型 α, β, γ : Type に対して足し算 (· + ·) : α → β → γ を定義することができます。
-- 最初は `+` 記号が定義されていないのでエラーになる
#check_failure 1 + (· + 2)
/-- HAdd 型クラスのインスタンスを実装する -/
instance : HAdd Nat (Nat → Nat) (Nat → Nat) where
hAdd n f := fun m => n + f m
-- 足し算記号が使えるようになった
#check 1 + (· + 2)
足し算 (· + ·) : α → β → γ が一つの型の中で閉じているとき、つまり α = β = γ のときは Add が使用できます。
HAppend
HAppend (heterogeneous append) は、++ という二項演算子のための型クラスです。
任意の型 α, β, γ : Type に対して連結 (· ++ ·) : α → β → γ を定義することができます。
-- 最初は `++` 記号が定義されていないのでエラーになる
#check_failure ([1, 2] ++ (3 : Nat))
/-- HAppend 型クラスのインスタンスを実装する
注意: これは例示のためのインスタンスで、あまり良いインスタンスではない。 -/
instance : HAppend (List Nat) Nat (List Nat) where
hAppend xs n := xs.map (· + n)
-- 連結記号が使えるようになった
#guard [1, 2] ++ (3 : Nat) = [4, 5]
連結 (· ++ ·) : α → β → γ が一つの型の中で閉じているとき、つまり α = β = γ のときは Append が使用できます。
HMul
HMul (heterogeneous multiplication)は * という二項演算子のための型クラスです。* 記号が何を意味するかについての制約はありません。任意の型 α, β, γ : Type に対して掛け算 (· * ·) : α → β → γ を定義することができます。
-- 最初は `*` 記号が定義されていないのでエラーになる
#check_failure 2 * (· + 1)
/-- `HMul` のインスタンスを定義する -/
instance : HMul Nat (Nat → Nat) (Nat → Nat) where
hMul xs ys := fun m => xs * ys m
-- 乗算記号が使えるようになった
#check 2 * (· + 1)
掛け算 (· * ·) : α → β → γ が一つの型の中で閉じているとき、つまり α = β = γ のときは Mul が使用できます。
Inhabited
Inhabited は、ある型にデフォルトの項があることを示す型クラスです。
Inhabited のインスタンスである型は、default という項を持ちます。
variable {α : Type} [Inhabited α]
#check (default : α)
Inhabited の注意すべき使われ方として、panic! する関数の返り値として呼ばれるというものがあります。
たとえば a : Array に対して i 番目の要素を取り出す処理を考えます。i 番目の要素が存在するとは限らないので、例外の処理が必要です。一つの方法は、「i 番目の要素がなければエラーにする」というものです。
def get {α : Type} [Inhabited α] (a : Array α) (i : Nat) : α :=
if h : i < a.size then
a[i]'h
else
panic! "index out of bounds"
何気ない定義のように見えますが、この定義には Inhabited α が必要です。panic! でプログラムを終了させているのですが、このときに α が空でないことが要求されています。
/-
error: failed to synthesize instance of type class
Inhabited α
Hint: Type class instance resolution failures can be inspected with the `set_option trace.Meta.synthInstance true` command.
-/
def get' {α : Type} (a : Array α) (i : Nat) : α :=
if h : i < a.size then
a[i]'h
else
panic! "index out of bounds"
これは Lean が定理証明支援系としてもプログラミング言語としても使えるようにするための技術的な制約からくる仕様です。もし値を返さずにプログラムがクラッシュすることが許されたとすると、「空の型は False に等しい」ので、クラッシュするプログラムを False の証明として扱える可能性が生じてしまいます。
LawfulApplicative
LawfulApplicative 型クラスは、Applicative 型クラスのインスタンスが満たすべき法則を明文化したものです。LawfulApplicative クラスのインスタンスになっていることで、「Applicative 型クラスのインスタンスは関数適用と整合性があり、計算の文脈を表している」という意味論が適切であることが保証されます。
定義
LawfulApplicative は、おおむね次のように定義されています。
variable {α β γ : Type}
/-- アプリカティブ則 -/
class LawfulApplicative (f : Type → Type) [Applicative f] : Prop extends LawfulFunctor f where
/-- `pure` が `seq` の直前にくる場合、その部分はただの `Functor.map` と同じになる。
つまり、`Applicative` のインスタンスから誘導される `Functor.map` の実装と、
もともとの `Functor.map` の実装は一致する。-/
pure_seq (g : α → β) (x : f α) : pure g <*> x = g <$> x
/-- `pure` の結果に関数を `map` することは、その関数を `pure` の内部で適用することと同じ。 -/
map_pure (g : α → β) (x : α) : g <$> (pure x : f α) = pure (g x)
/-- `seq` の後に `pure` を使うことは、`Functor.map` と同じになる。 -/
seq_pure (g : f (α → β)) (x : α) : g <*> pure x = (fun h => h x) <$> g
/--
`seq` は結合的である。
計算の順序を保ったまま `seq` 呼び出しの入れ子構造を変えても、同値な計算になる。
これは、`seq` が単に順序付け以上のことはしていないことを意味する。
-/
seq_assoc (x : f α) (g : f (α → β)) (h : f (β → γ)) : h <*> (g <*> x) = ((@Function.comp α β γ) <$> h) <*> g <*> x
Applicative 則の帰結
Applicative のインスタンス F は関数適用と整合するという意味論がありますが、LawfulApplicative のインスタンスになっているとそれが正しいことが保証されます。
variable {F : Type → Type} [Applicative F] [LawfulApplicative F]
variable {A B C D : Type}
/-- `pure`を介して関数適用と`<*>`が整合している -/
example {x : A} {f : A → B} : pure f <*> (pure x : F A) = pure (f x) := calc
_ = f <$> pure x := by rw [pure_seq]
_ = pure (f x) := by rw [map_pure]
example {x : A} {y : B} {f : A → B → C}
: pure f <*> (pure x : F A) <*> (pure y : F B) = pure (f x y) := by
simp only [seq_pure, map_pure]
LawfulFunctor
LawfulFunctor は、Functor 型クラスに関手則を満たすという条件を加えたものです。
関手則とは、関手 F : Type u → Type u が満たしているべきルールで、以下のようなものです。
Functor.mapは恒等関数を保存する。つまりid <$> x = xが成り立つ。Functor.mapは関数合成を保存する。つまり(f ∘ g) <$> x = f <$> (g <$> x)が成り立つ。
型が合っているだけでは「Functor.map とは、関手というコンテナに包まれた内部の値に関数を適用するもの」という意味論が成り立たないことがあります。関手則は、この意味論が正当になるための条件を与えます。
LawfulFunctor クラスは、関手則をほぼそのままコードに落とし込んだものとして、おおむね次のように定義されています。
open Function
universe u v
variable {α β γ : Type u}
class LawfulFunctor (f : Type u → Type v) [Functor f] : Prop where
/-- `Functor.mapConst` が仕様を満たす -/
map_const : (Functor.mapConst : α → f β → f α) = Functor.map ∘ const β
/-- 恒等関数を保つ -/
id_map (x : f α) : id <$> x = x
/-- 合成を保つ -/
comp_map (g : α → β) (h : β → γ) (x : f α) : (h ∘ g) <$> x = h <$> g <$> x
関手則の帰結
関手則の帰結を紹介しましょう。
関手は型の同値性を保つ
まず、型 A, B は全単射 f : A → B とその逆射 g : B → A が存在するとき 同値(equivalent) であるといい、これを (· ≃ ·) で表します。つまり A ≃ B であるとは、f : A → B と g : B → A が存在して f ∘ g = id かつ g ∘ f = id が成り立つことを意味します。
関手則が守られているとき、関手 F は合成を保ち、かつ id を id に写すので、関手は同値性を保つことになります。
import Mathlib.Logic.Equiv.Defs
variable {A B : Type} {F : Type → Type}
example [Functor F] [LawfulFunctor F] (h : A ≃ B) : F A ≃ F B := by
obtain ⟨f, g, hf, hg⟩ := h
-- 関手 `F` による像で同値になる
refine ⟨Functor.map f, Functor.map g, ?hFf, ?hFg⟩
-- infoviewを見やすくする
all_goals
dsimp [Function.RightInverse] at *
dsimp [Function.LeftInverse] at *
case hFf =>
have gfid : g ∘ f = id := by
ext x
simp_all
intro x
have : g <$> f <$> x = x := calc
_ = (g ∘ f) <$> x := by rw [LawfulFunctor.comp_map]
_ = id <$> x := by rw [gfid]
_ = x := by rw [LawfulFunctor.id_map]
assumption
case hFg =>
have fgid : f ∘ g = id := by
ext x
simp_all
intro x
have : f <$> g <$> x = x := calc
_ = (f ∘ g) <$> x := by rw [LawfulFunctor.comp_map]
_ = id <$> x := by rw [fgid]
_ = x := by rw [LawfulFunctor.id_map]
assumption
関手は Unit との図式を保つ
型と関数がなす圏 Type を考えると、ここでは Unit が終対象になっています。つまり、任意の型 A : Type に対して、A → Unit という関数が一意的に存在します。（関数外延性は仮定します）この多相的な関数を仮に unit : (A : Type) → A → Unit と書くことにします。
ここで、任意の関数 f : A → B に対して、A と B のそれぞれから Unit への関数が一意的に存在するので、(unit B) ∘ f = unit A が成り立ちます。
関手則を満たしている関手 F : Type → Type があったとしましょう。このとき F は関数合成を保つので、F によって誘導される関数も同じ等式を満たします。表記を簡単にするために (f <$> ⬝) のことを f* と書くことにすると、(unit B)* ∘ f* = (unit A)* が成り立ちます。
(だから何だという感じがするかもしれませんが、(unit ·)* という多相的な関数によって map の実装が非常に限定されているということです。)
関手の例
いくつか LawfulFunctor クラスのインスタンスを作ってみます。
Id
Id は関手則を満たします。
def MyId (α : Type) := α
def MyId.map {α β : Type} (f : α → β) (x : MyId α) : MyId β := f x
instance : Functor MyId where
map := MyId.map
instance : LawfulFunctor MyId where
map_const := by intros; rfl
id_map := by intros; rfl
comp_map := by intros; rfl
List
List は関手則を満たします。
/-- 自前で定義したリスト -/
inductive MyList (α : Type) where
| nil
| cons (head : α) (tail : MyList α)
notation:80 "[]" => MyList.nil
infixr:80 "::" => MyList.cons
/-- リストの中身に関数をそれぞれ適用する -/
def MyList.map {α β : Type} (f : α → β) (xs : MyList α) : MyList β :=
match xs with
| [] => []
| x :: xs => f x :: MyList.map f xs
instance : Functor MyList where
map := MyList.map
instance : LawfulFunctor MyList where
map_const := by intros; rfl
id_map := by
intro α xs
dsimp [(· <$> ·)]
induction xs with grind [MyList.map]
comp_map := by
intro α β γ g h xs
induction xs with
| nil => rfl
| cons x xs ih =>
dsimp [(· <$> ·), MyList.map] at ih ⊢
rw [ih]
Option
Option は関手則を満たします。
@[aesop unsafe 70% cases]
inductive MyOption (α : Type) where
| none
| some (x : α)
def MyOption.map {α β : Type} (f : α → β) (x : MyOption α) : MyOption β :=
match x with
| none => none
| some x => some (f x)
instance : Functor MyOption where
map := MyOption.map
instance : LawfulFunctor MyOption where
map_const := by intros; rfl
id_map := by aesop
comp_map := by aesop
(A → ·)
fun X => (A → X) という対応 Type → Type は関手則を満たします。
/-- 型から、その型への関数型を返す -/
abbrev Hom (A : Type) (X : Type) := A → X
instance {A : Type} : Functor (Hom A) where
map f g := f ∘ g
instance {A : Type} : LawfulFunctor (Hom A) where
map_const := by aesop
id_map := by aesop
comp_map := by aesop
Monad
Monad は、圏論におけるモナドという概念からその名がある型クラスで、大雑把に言えば逐次的な計算を表します。この型クラスを実装した型に対しては、do 構文と呼ばれる手続き型プログラミングを一般化したような構文が使用できるようになります。
典型的なインスタンス
Id
Id 関手はモナドです。Id の場合、do 構文は単に手続き型プログラミングを模したものになります。
/-- `n`以下の素数のリストを `Array Bool` の形で返す。
`i` 番目が `true` ならば `i` は素数で、`false` ならば合成数。 -/
def eratosthenesAux (n : Nat) : Array Bool := Id.run do
let mut isPrime := Array.replicate (n + 1) true
isPrime := isPrime.set! 0 false
isPrime := isPrime.set! 1 false
for p in [2 : n + 1] do
if not isPrime[p]! then
continue
if p ^ 2 > n then
break
-- `p` の倍数を消していく
let mut q := p * p
while q ≤ n do
isPrime := isPrime.set! q false
q := q + p
return isPrime
/-- エラトステネスの篩 -/
def eratosthenes (n : Nat) : Array Nat :=
eratosthenesAux n
|>.zipIdx
|>.filterMap fun ⟨isPrime, i⟩ =>
if isPrime then some i else none
#guard eratosthenes 10 = #[2, 3, 5, 7]
#guard
let actual := eratosthenes 100
let expected := #[
2, 3, 5, 7, 11,
13, 17, 19, 23, 29,
31, 37, 41, 43, 47,
53, 59, 61, 67, 71,
73, 79, 83, 89, 97
]
expected == actual
Option
Option 関手はモナドです。Option の場合、do 構文によって「先行する計算のどれか一つでも none だったら none を返す。全部が some だったときだけ先へ進む」という処理を簡単に書けるようになります。
たとえば、配列の１つめの２つめと３つめの要素をまとめて取り出す関数を do 構文なしで書こうとすると次のようになり、インデックスアクセスがネストしてややこしくなります。
def fstSndThird? (a : Array Nat) : Option (Nat × Nat × Nat) :=
match a[0]? with
| none => none
| some x =>
match a[1]? with
| none => none
| some y =>
match a[2]? with
| none => none
| some z => some (x, y, z)
#guard fstSndThird? #[1] = none
#guard fstSndThird? #[1, 2] = none
#guard fstSndThird? #[1, 2, 3] = some (1, 2, 3)
しかし do 構文を使用すると、ネストを消し去ることができます。
def fstSndThird? (a : Array Nat) : Option (Nat × Nat × Nat) := do
let x ← a[0]?
let y ← a[1]?
let z ← a[2]?
return (x, y, z)
#guard fstSndThird? #[1] = none
#guard fstSndThird? #[1, 2] = none
#guard fstSndThird? #[1, 2, 3] = some (1, 2, 3)
List
List 関手もモナドにすることができます。List の場合、do 構文を使用することで、リスト内包表記のような操作を簡潔に記述できます。
たとえば、2つのリストの直積を計算する関数は次のように書けます。
/-- `List` をモナドインスタンスにする -/
instance : Monad List where
pure x := [x]
bind l f := l.flatMap f
map f l := l.map f
def cartesianProduct (xs : List Nat) (ys : List Nat) : List (Nat × Nat) := do
let x ← xs
let y ← ys
return (x, y)
#guard cartesianProduct [1, 2] [3, 4] = [(1, 3), (1, 4), (2, 3), (2, 4)]
ただし、この例は Applicative のインスタンスでも書けるのであまり良い例ではありません。後続の計算の中で前の選択に依存するような処理を使っていないためです。
-- `Applicative` のインスタンスを使って同じことが書ける
def cartesianProductAp (xs : List Nat) (ys : List Nat) : List (Nat × Nat) :=
(fun x y => (x, y)) <$> xs <*> ys
#guard cartesianProductAp [1, 2] [3, 4] = [(1, 3), (1, 4), (2, 3), (2, 4)]
インスタンス自作例
パーサーをモナドとして実装することができます。1
/-- パーサ
* 返り値が `Option` で包まれているのは、パースが成功するとは限らないため
* 返り値の `α × String` は、`α` がパース結果、`String` が残りの入力文字列を表す
-/
def Parser (α : Type) := String → Option (α × String)
/-- `Parser`の`Functor.map`メソッドの実装
* パーサが成功すれば結果に関数を適用する
* 失敗したら失敗を伝搬する
-/
protected def Parser.map {α β : Type} (f : α → β) (p : Parser α) : Parser β :=
fun input =>
match p input with
| none => none
| some (a, rest) => some (f a, rest)
instance : Functor Parser where
map := Parser.map
/-- `Parser`の`Applicative.pure`メソッドの実装 -/
protected def Parser.pure {α : Type} (x : α) : Parser α :=
fun input => some (x, input)
/-- `Parser`の`Applicative.seq`メソッドの実装
関数を返すパーサ`pg`を、引数を返すパーサ`px ()`に適用して、
「その関数を引数に適用した結果を返すパーサ」を返す
-/
protected def Parser.seq {α β : Type} (pg : Parser (α → β)) (px : Unit → Parser α) : Parser β :=
fun input =>
match pg input with
| none => none
| some (g, out) => (g <$> px ()) out
instance : Applicative Parser where
pure := Parser.pure
seq := Parser.seq
instance : Monad Parser where
bind := fun {_α _β} p f input =>
match p input with
| none => none
| some (v, out) => f v out
これでパーサを組み合わせるのに do 構文が利用できるようになります。
/-- 基礎的なパーサ
入力文字が空の時は失敗し、それ以外の時は最初の文字を消費して返す
-/
def Parser.item : Parser Char := fun input =>
let chars := input.toList
match chars with
| [] => none
| x :: xs => some (x, String.ofList xs)
/-- 3文字の文字列にマッチするパーサー -/
def Parser.three : Parser String := do
let x ← item
let y ← item
let z ← item
return String.ofList [x, y, z]
#guard Parser.three "abcdef" = some ("abc", "def")
なお、Lean の標準ライブラリに用意されているパーサもモナドになっています。
open Std Internal in
instance (ι : Type) : Monad (Parsec ι) := by infer_instance
-
モナドを利用するパーサの詳細については「Monadic Parser Combinators」と「Monadic parsing in Haskell」という論文を参照してください。 ↩
Mul
Mul は * という二項演算子のための型クラスです。* 記号が何を意味するかについての制約はありません。ここまで HMul と同じですが、HMul は異なるかもしれない型 α, β, γ に対して掛け算 (· * ·) : α → β → γ を定義することができる一方で、Mul は同じ型 α に対して掛け算 (· * ·) : α → α → α を定義することしかできません。
/-- 自前で定義した自然数 -/
inductive MyNat where
| zero
| succ (n : MyNat)
namespace MyNat
/- ## MyNat の足し算を定義する -/
def add (m n : MyNat) : MyNat :=
match n with
| zero => m
| succ n => succ (add m n)
-- `add` 関数を `+` の実装とする
instance : Add MyNat where
add := add
end MyNat
namespace MyNat
/- ## MyNat の掛け算を定義する -/
def mul (m n : MyNat) : MyNat :=
match n with
| zero => zero
| succ n => (mul m n) + n
-- 記法が定義されていないので使えない
#check_failure MyNat.zero * MyNat.zero
-- `mul` 関数を `*` の実装とする
instance : Mul MyNat where
mul := mul
-- 掛け算記号が使えるようになった
#check MyNat.zero * MyNat.zero
end MyNat
舞台裏
Mul 型クラスは、内部的には HMul に展開されています。
-- #check コマンドの出力で記法を使わないようにする
set_option pp.notation false in
/- info: HMul.hMul MyNat.zero MyNat.zero : MyNat -/
#check MyNat.zero * MyNat.zero
Neg
Neg は - という前置記法の単項演算子のための型クラスです。- 記法が何を意味するかについては制約はありません。
/-- 自前で定義した自然数型 -/
inductive MyNat where
| zero
| succ (n : MyNat)
/-- 自前で定義した整数型 -/
inductive MyInt where
| ofNat (n : MyNat)
| negSucc (n : MyNat)
namespace MyInt
/- ## MyInt のマイナス演算を定義する -/
/-- 自然数に対するマイナス演算 -/
def negOfNat : MyNat → MyInt
| .zero => ofNat .zero
| .succ m => negSucc m
/-- 整数に対するマイナス演算 -/
def neg (n : MyInt) : MyInt :=
match n with
| ofNat n => negOfNat n
| negSucc n => ofNat n
-- 記法が定義されていないので使えない
#check_failure - MyInt.ofNat MyNat.zero
-- `neg` 関数を `-` の実装とする
instance : Neg MyInt where
neg := neg
-- マイナス演算記号が使えるようになった
#check - MyInt.ofNat MyNat.zero
end MyInt
OfNat
OfNat 型クラスは、0 や1 などの数値リテラルを特定の型の値として解釈する方法を指定します。
/-- 偶数全体 -/
inductive Even where
| zero
| addTwo (n : Even)
-- まだ `OfNat` のインスタンスがないので、
-- `0` という数値リテラルを `Even` 型の値として解釈することはできない
#check_failure (0 : Even)
/-- `0` という数値リテラルを `Even` の項として解釈する方法を指定 -/
instance : OfNat Even 0 where
ofNat := Even.zero
-- エラーがなくなった
#check (0 : Even)
0 や 1 などの特定の数値リテラルに対して個別に宣言するだけでなく、変数を使って一斉に OfNat のインスタンスを宣言することもできます。
/-- 有理数もどき。
約分したら等しいものは等しいというルールがないので有理数ではない -/
structure Rational where
num : Int
den : Nat
inv : den ≠ 0
/-- 数値リテラル `n` を有理数として解釈する方法を指定 -/
instance (n : Nat) : OfNat Rational n where
ofNat := { num := n, den := 1, inv := by decide }
-- 数値リテラルを `Rational` の意味で使用できる！
#check (2 : Rational)
#check (42 : Rational)
特定の数値リテラルに対してだけ OfNat を実装しないということもできます。
/-- 正の自然数 -/
inductive Pos where
| one
| succ (n : Pos)
/-- 自然数 `n` を `n + 1` に相当する `Pos` の項に写す -/
def Pos.ofNatPlus (n : Nat) : Pos :=
match n with
| 0 => Pos.one
| n + 1 => Pos.succ (Pos.ofNatPlus n)
/-- 数値リテラル `1, 2, 3, ...` に対して `Pos` の項と解釈する方法を指定 -/
instance (n : Nat) : OfNat Pos (n + 1) where
ofNat := Pos.ofNatPlus n
-- エラーにならない
#check (1 : Pos)
#check (8 : Pos)
#check (42 : Pos)
-- `0` は除外したのでエラーになる
#check_failure (0 : Pos)
応用例
OfNat の応用として、macro コマンドと組み合わせることで数値リテラル n を 1 + 1 + ⋯ + 1 (n 個の 1 の和) に分解するタクティクを自作することができます。1
theorem unfoldNat (x : Nat) : OfNat.ofNat (x + 2) = OfNat.ofNat (x + 1) + 1 :=
rfl
theorem unfoldNatZero (x : Nat) : OfNat.ofNat (0 + x) = x :=
Nat.zero_add x
/-- 自然数を `1 + 1 + ⋯ + 1` に分解する -/
macro "expand_num" : tactic => `(tactic| simp only [unfoldNat, unfoldNatZero])
example (n : Nat) : 3 * n = 2 * n + 1 * n := by
expand_num
-- 数値が `1 + 1 + ⋯ + 1` に分解された
guard_target =ₛ (1 + 1 + 1) * n = (1 + 1) * n + 1 * n
simp only [Nat.add_mul]
-
このコード例は、Lean 公式 Zulip の expand_nums tactic トピックにおける Robin Arnez 氏の投稿を参考にしています。 ↩
Quote
Lean.Quote は、構文の クォート(quote) を行います。つまり、データ x : α を対応する 構文木 に変換します。構文木への変換という点ではパースに似ていますが、パースはいろんな型からの変換ではなく、コードの文字列からの変換です。
open Lean
/- info: (num "1") -/
#eval
let x : TSyntax `term := Quote.quote 1
IO.println x
/- info: `Bool.true._@._internal._hyg.0 -/
#eval
let x : TSyntax `term := Quote.quote true
IO.println x
なお export されているので、Lean.Quote.quote の代わりに単に Lean.quote と書くことができます。
section
variable {α : Type} [Lean.Quote α `term]
example (x : α) : (Lean.Quote.quote x : Lean.TSyntax `term) = Lean.quote x := by
rfl
end
使用例
候補を順に試すタクティク
Quote と elab コマンドを組み合わせると、たとえば「存在命題を、候補を順に試すことで示すタクティク」を自作することができます。
open Lean Elab.Tactic Elab.Term in
elab "try_for" n:num : tactic => do
-- 範囲として与えられた自然数を取得
let n := n.getNat
-- `n` までの数を順に試す
for i in [0 : n+1] do
let istx := quote i
-- `evalTactic` を使ってタクティクを呼び出して実行する
evalTactic <| ← `(tactic| try { exists $istx })
example : ∃ n : Nat, n * 24 = 48 := by
-- 具体的な数を指定しなくても探す範囲を指定するだけで示すことができる
try_for 10
example : ∃ n : Nat, (n + 2) / 3 = 5 := by
-- 12 まで試しても見つからない
fail_if_success solve
| try_for 12
-- 13 まで試すと見つかる
try_for 13
論理式のための構文を用意する
次のように、Lean のデータとして論理式の AST を定義したとします。
/-- 論理式 -/
inductive PropForm where
/-- 真 `⊤` -/
| tr : PropForm
/-- 偽 `⊥` -/
| fls : PropForm
/-- 命題変数 -/
| var : String → PropForm
/-- 論理積 `∧` -/
| conj : PropForm → PropForm → PropForm
/-- 論理和 `∨` -/
| disj : PropForm → PropForm → PropForm
/-- 含意 `→` -/
| impl : PropForm → PropForm → PropForm
/-- 否定 `¬` -/
| neg : PropForm → PropForm
/-- 同値 `↔` -/
| biImpl : PropForm → PropForm → PropForm
deriving Repr, DecidableEq, Inhabited
このとき、macro_rules コマンドと Quote を組み合わせることで、論理式のための構文を定義することができます。1
declare_syntax_cat propform
/-- `PropForm` を見やすく定義するための構文 -/
syntax "prop!{" propform "}" : term
syntax:max ident : propform
syntax "⊤" : propform
syntax "⊥" : propform
syntax:35 propform:36 " ∧ " propform:35 : propform
syntax:30 propform:31 " ∨ " propform:30 : propform
syntax:20 propform:21 " → " propform:20 : propform
syntax:20 propform:21 " ↔ " propform:20 : propform
syntax:max "¬ " propform:40 : propform
syntax:max "(" propform ")" : propform
macro_rules
| `(prop!{$p:ident}) => `(PropForm.var $(Lean.quote p.getId.toString))
| `(prop!{⊤}) => `(ProfForm.tr)
| `(prop!{⊥}) => `(ProfForm.fls)
| `(prop!{¬ $p}) => `(PropForm.neg prop!{$p})
| `(prop!{$p ∧ $q}) => `(PropForm.conj prop!{$p} prop!{$q})
| `(prop!{$p ∨ $q}) => `(PropForm.disj prop!{$p} prop!{$q})
| `(prop!{$p → $q}) => `(PropForm.impl prop!{$p} prop!{$q})
| `(prop!{$p ↔ $q}) => `(PropForm.biImpl prop!{$p} prop!{$q})
| `(prop!{($p:propform)}) => `(prop!{$p})
-- 構文が使用できるようになった
#check prop!{p ∧ q → (r ∨ ¬ p) → q}
#check prop!{p ∧ q ∧ r → p}
-- 構文のテスト
#guard
let actual := prop!{p ∧ q}
let expected := PropForm.conj (PropForm.var "p") (PropForm.var "q")
expected == actual
-
この例は Logic and Mechanized Reasoning を参考にしました。 ↩
Repr
Repr は、その型の項をどのように表示するかを指示する型クラスです。
たとえば、以下のように新しく構造体 Point を定義したとき、何も指定しなくても Point の項を #eval で表示することはできますが、実は裏で Repr インスタンスを利用しています。
-- 平面上の点を表す構造体
structure Point (α : Type) : Type where
x : α
y : α
-- 原点
def origin : Point Nat := ⟨0, 0⟩
-- `origin` の中身を表示することができる
/- info: { x := 0, y := 0 } -/
#eval origin
-- Repr インスタンスを暗黙的に生成しないように設定
set_option eval.derive.repr false
-- 表示できずにエラーになった！
/-
error: Could not synthesize a `ToExpr`, `Repr`, or `ToString` instance for type
Point Nat
-/
#eval origin
Repr が満たすべきルール
Repr の出力は Lean のコードとしてパース可能なものに可能な限り近くなければならない、つまり Lean のコードとして実行可能であることが期待されます。このルールは 次のように Repr のドキュメントコメントに書かれています。
The standard way of turning values of some type into
Format.When rendered this
Formatshould be as close as possible to something that can be parsed as the input value.
Repr インスタンスの実装方法
Repr 型クラスの定義は次のようになっています。
class Repr.{u} (α : Type u) where
/--
`α` 型の項を、与えられた優先度で `Format` に変換する。
優先度は、括弧を付けるかどうかの判断に使用される。
-/
reprPrec : α → Nat → Std.Format
したがって Repr のインスタンスを実装するには Std.Format の項を構成する必要がありそうですが、実は必ずしもこれを明示的に構成する必要はありません。
deriving を使う
deriving コマンドで Lean に Repr インスタンスを自動生成させることができます。
deriving instance Repr for Point
/- info: { x := 0, y := 0 } -/
#eval origin
あるいは、そもそも型を定義する際に deriving 句を用いて生成しても良いでしょう。
structure Point' (α : Type) : Type where
x : α
y : α
deriving Repr
def origin' : Point' Nat := ⟨0, 0⟩
-- 評価できる
#eval origin'
なお Repr の実装が満たすべきルールとして「出力は実行可能な Lean のコードでなければならない」というものがあるので、自分で構文を用意しない限り deriving を使わずに Repr インスタンスを実装する機会はないはずです。
ToString インスタンスから作る
ToString クラスのインスタンスから、Repr のインスタンスを得ることができます。
instance {α : Type} [ToString α] : Repr α where
reprPrec x _ := toString x
実装すべきメソッド Repr.reprPrec の型は α → Nat → Std.Format なので型が合わないようですが、上記のコードが通るのは String から Format への型強制が存在するためです。
-- `String → Format` という型強制が存在する
#synth Coe String Std.Format
これを利用すると Repr の実装が手軽に得られます。
以下に紹介する例は少し長くて複雑ですが、macro_rules コマンドを使用して見やすい構文を用意した後、Repr の出力がその構文になるように Repr インスタンスを定義する例です。
/-- 2項演算の集合 -/
inductive Op where
/-- 加法 -/
| add
/-- 乗法 -/
| mul
deriving BEq
namespace Op
-- ## ToString インスタンスの定義
protected def toString : Op → String
| add => "+"
| mul => "*"
instance : ToString Op := ⟨Op.toString⟩
end Op
/-- 数式 -/
inductive Expr where
/-- 数値リテラル -/
| val (n : Nat)
/-- 演算子の適用 -/
| app (op : Op) (left right : Expr)
deriving BEq
namespace Expr
/- ## Expr の項を定義するための見やすい構文を用意する -/
/-- `Expr` のための構文カテゴリ -/
declare_syntax_cat expr
/-- `Expr` を見やすく定義するための構文 -/
syntax "expr!{" expr "}" : term
syntax:max num : expr
syntax:30 expr:30 " + " expr:31 : expr
syntax:35 expr:35 " * " expr:36 : expr
syntax:max "(" expr ")" : expr
macro_rules
| `(expr!{$n:num}) => `(Expr.val $n)
| `(expr!{$l:expr + $r:expr}) => `(Expr.app Op.add expr!{$l} expr!{$r})
| `(expr!{$l:expr * $r:expr}) => `(Expr.app Op.mul expr!{$l} expr!{$r})
| `(expr!{($e:expr)}) => `(expr!{$e})
-- 構文が正しく動作しているかテスト
#guard
let expected := Expr.app Op.add (app Op.mul (val 1) (val 2)) (val 3)
let actual := expr!{1 * 2 + 3}
expected == actual
end Expr
namespace Expr
/- ## ToString インスタンスを定義する -/
protected def toString : Expr → String
| .val x => toString x
| .app op l r =>
brak l ++ " " ++ toString op ++ " " ++ brak r
where
/-- 式全体を括弧で囲うことを回避するための補助関数 -/
brak : Expr → String
| .val n => toString n
| e => "(" ++ Expr.toString e ++ ")"
instance : ToString Expr := ⟨Expr.toString⟩
-- toString インスタンスのテスト
#guard toString expr!{1 + 2 * 3} = "1 + (2 * 3)"
#guard toString expr!{1 + (2 + 3 * 4)} = "1 + (2 + (3 * 4))"
end Expr
namespace Expr
/- ## Repr インスタンスを定義する -/
-- `ToString` インスタンスを利用して `Repr` インスタンスを実装する
instance : Repr Expr where
reprPrec e _ := "expr!{" ++ toString e ++ "}"
-- Repr インスタンスのテスト
/- info: expr!{1 + (2 * 3)} -/
#eval expr!{1 + (2 * 3)}
end Expr
Setoid
Setoid は、与えられた型の上の同値関係を表します。具体的には、α : Type に対してインスタンス sa : Setoid α は、α 上の二項関係 r : α → α → Prop と r が同値関係であることの証明の組です。主として Quotient の引数として使用されます。
Setoid は、次のように定義されています。
/--
Setoidは、特定の同値関係（`≈`で表される）を持つ。
これは主に`Quotient`型への入力として使用される。
-/
class Setoid.{u} (α : Sort u) where
/-- `α` 上の二項関係 -/
r : α → α → Prop
/-- `r` は同値関係 -/
iseqv : Equivalence r
使用例
たとえば、ある型 α 上の関数 f : α → β が与えられていて β 上に同値関係 (· ≈ ·) が定義されているとします。このとき α 上の二項関係 r を r a b := f a ≈ f b と定義すると、r は同値関係になります。
証明してみましょう。
section
variable {α : Type} {β : Type}
/-- `β` 上の二項関係から誘導される `α` 上の二項関係 -/
def Rel.contra_map (f : α → β) (r : β → β → Prop) : α → α → Prop :=
fun a₁ a₂ => r (f a₁) (f a₂)
/-- `β` 上の同値関係から誘導される `α` 上の同値関係 -/
def Setoid.contra_map (f : α → β) (sb : Setoid β) : Setoid α where
r := Rel.contra_map f (· ≈ ·)
iseqv := by
constructor <;> dsimp [Rel.contra_map]
-- 反射律
case refl =>
intro x
apply Setoid.iseqv.refl
-- 対称律
case symm =>
intro x y
apply Setoid.iseqv.symm
-- 推移律
case trans =>
intro x y z
apply Setoid.iseqv.trans
end
ToString
ToString は、文字列 String への変換方法を提供する型クラスです。ToString のインスタンスになっている型の項は、ToString.toString 関数で文字列に変換することができます。また、export されているので、単に toString と書いても使えます。
example {α : Type} [ToString α] : ToString.toString (α := α) = toString := by rfl
使用例
/-- 標準ライブラリの `List` を真似て作った自前のリスト -/
inductive MyList (α : Type) where
| nil : MyList α
| cons (hd : α) (tl : MyList α) : MyList α
namespace MyList
variable {α : Type}
/-- リストをリストらしく `"[a₁, a₂, ..., aₙ]"` という文字列に変換する
注意: `ToString.toString` と紛らわしいことがあるので `protected` で修飾している
-/
protected def toString [ToString α] : MyList α → String
| nil => "[]"
| ls@(cons _hd _tail) =>
"[" ++ helper ls ++ "]"
where
/-- 外側の括弧抜きでリストの中身を `,` でつないで表示する -/
helper : MyList α → String
| nil => ""
| cons hd .nil => toString hd
| cons hd tail => toString hd ++ ", " ++ helper tail
instance [ToString α] : ToString (MyList α) where
toString := MyList.toString
-- `toString` が正しく動作しているかテスト
#guard (toString <| MyList.cons 1 (MyList.nil)) = "[1]"
#guard (toString <| MyList.cons 1 (MyList.cons 2 (MyList.nil))) = "[1, 2]"
end MyList
データ型
型(type)は、直観的にはデータを分類するものです。集合が要素を持つように、型は項を持つことができます。
Lean では命題 P : Prop も型ですが、それらを除いた型は Type u の項になります。本書では Type u の項をデータ型と呼んでいます。
Array
Array α は配列を表す型です。特定の型 α : Type u の要素を一直線に並べたものです。
#[a₁, ..., aₖ] という記法で Array α の項を作ることができます。
#check (#[1, 2, 3] : Array Nat)
#check (#["hello", "world"] : Array String)
定義と実行時の性質
Array α は次のように連結リスト List α のラッパーとして定義されているように見えます。
structure Array.{u} (α : Type u) : Type u where
toList : List α
しかしドキュメントコメントに以下のように書かれている通り、実行時には List とは大きく異なる動的配列(dynamic array)としての振る舞いを見せます。
Array αis the type of dynamic arrays with elements fromα. This type has special support in the runtime.Arrays perform best when unshared. As long as there is never more than one reference to an array, all updates will be performed destructively. This results in performance comparable to mutable arrays in imperative programming languages.
An array has a size and a capacity. The size is the number of elements present in the array, while the capacity is the amount of memory currently allocated for elements. The size is accessible via
Array.size, but the capacity is not observable from Lean code.Array.emptyWithCapacity ncreates an array which is equal to#[], but internally allocates an array of capacityn. When the size exceeds the capacity, allocation is required to grow the array.From the point of view of proofs,
Array αis just a wrapper aroundList α.
List のラッパーとしての定義は、証明を行おうとしたときに参照されます。
基本的な操作
インデックスアクセス
配列は GetElem のインスタンスであり、i 番目の要素を取得するために a[i] という記法が使用できます。Array α は実行時には動的配列として振る舞うので、インデックスアクセスは高速に行うことができます。
#guard #[1, 2, 3][0] = 1
#guard #[1, 2, 3][3]? = none
要素の追加
xs : Array α に対して Array.push 関数で末尾に要素を追加できます。
ドキュメントコメントに次のように書かれている通り、この操作は高速に行うことができます。
Adds an element to the end of an array. The resulting array’s size is one greater than the input array. If there are no other references to the array, then it is modified in-place.
This takes amortized
O(1)time becauseArray αis represented by a dynamic array.
#guard #[1, 2, 3].push 4 = #[1, 2, 3, 4]
List と比較した特長
List も同様にインデックスアクセスをサポートしていますが、Array の方がより高速にアクセスすることができます。
なぜかというと、List は連結リストとして実装されており、i : Nat 番目にアクセスしようとすると最初の要素から順に辿っていく必要があるからです。一方で Array は動的配列として実装されているので、i 番目の要素に直接アクセスできます。
open IO
variable {α : Type} {valid : α → Nat → Prop}
variable [GetElem α Nat Nat valid] [GetElem? α Nat Nat valid]
/--
コレクション型に対して、そのインデックスアクセスの実行時間を計測する関数
* `col`: 対象となるコレクション
* `accessPoint`: 計算の中では、同じインデックスに対して何度もアクセスして平均時間を計測する。
そこでアクセスするインデックス。
-/
@[noinline]
def evalIdxAccess (col : α) (accessPoint : Nat) : IO Nat := do
-- アクセスを試みる回数
let access_times := 1000
-- コンパイラに最適化されて結果が変わることを防ぐために
-- どうでもいい計算をする
let mut sum := 0
let mut sum_time := 0
for _ in [0:access_times] do
-- インデックスアクセスにかかる時間を測定する
let start_time <- monoNanosNow
let x := col[accessPoint]!
let end_time <- monoNanosNow
let time := end_time - start_time
-- アクセス時間を合計する
sum := (sum + x) % 2
sum_time := sum_time + time
IO.println s!"{sum} is computed..."
return sum_time / access_times
def main : IO Unit := do
let size := 10_000_000
let accessPoint := size / 10
let listTime ← evalIdxAccess (List.range size) accessPoint
println s!"List access time: {listTime}ns"
let arrayTime ← evalIdxAccess (Array.range size) accessPoint
println s!"Array access time: {arrayTime}ns"
if listTime < arrayTime then
throw <| userError "List is faster than Array"
#eval main
使用例
配列の特徴を生かしてプログラムを組んでいる例をいくつか紹介します。
特定の要素だけ末尾に移動させる
arr : Array α に対しては、インデックスアクセスと「指定されたインデックスにある要素の更新」が高速に行えるので、それを生かして「特定の要素だけ末尾に移動させる」操作を効率的に実装することができます。
variable {α : Type} [BEq α]
/-- 配列`arr`の要素`a`が与えられたときに、
他の要素の位置関係を維持したまま、すべての`a`を配列の末尾に移動させる
-/
def Array.move (arr : Array α) (a : α) : Array α := Id.run do
let mut arr := arr
let mut write := 0
-- まず `a` 以外の要素を前詰めで配置
for x in arr do
if x != a then
arr := arr.set! write x
write := write + 1
-- 残りの部分を `a` で埋める
for i in [write:arr.size] do
arr := arr.set! i a
return arr
#guard Array.move #[1, 0, 2, 0, 3] 0 == #[1, 2, 3, 0, 0] -- `0` を末尾に移動
#guard Array.move #[1, 2, 3] 0 == #[1, 2, 3] -- `0` がないので変化なし
#guard Array.move #[] 0 == #[] -- 空配列はそのまま
#guard Array.move #[0, 0, 0] 0 == #[0, 0, 0] -- `0` しかないので変化なし
スタックの実装
arr : Array α に対しては「末尾に要素を追加する操作」と「末尾から要素を取り出す操作」が高速に行えるので、スタックの実装に利用することができます。
/-- 括弧が対応しているか判定する -/
def matchParen (c1 c2 : Char) : Bool :=
match c1, c2 with
| '(', ')' => true
| '{', '}' => true
| '[', ']' => true
| _, _ => false
/--
文字列 `s` に含まれる括弧が正しく対応しているかどうかを判定する関数。
開き括弧と閉じ括弧が対応しており、正しい順序で閉じられている場合に `true` を返す。
-/
def validParen (s : String) : Bool := Id.run do
-- 括弧のスタックを空で初期化
let mut stack : Array Char := #[]
-- 文字列の各文字に対してループ
for c in s.toList do
-- スタックの末尾の要素（最後に追加された開き括弧）を取得
let last := stack.back?
match last with
| none =>
-- スタックが空なら、文字をスタックに追加（開き括弧のはず）
stack := stack.push c
| some last =>
-- スタックの末尾と現在の文字が対応する括弧なら、スタックから取り除く（ペアが閉じられた）
if matchParen last c then
stack := stack.pop
else
-- 対応していない場合は、新たにスタックに追加（新しい開き括弧）
stack := stack.push c
-- すべての括弧が正しく閉じられていればスタックは空になっている
return stack.isEmpty
-- テストケース
#guard validParen "()"
#guard validParen "()[]{}"
#guard !validParen "(]"
#guard !validParen "([)]"
#guard validParen "{[]}"
#guard !validParen "{"
#guard !validParen "}"
#guard validParen "([{}])({}){}"
Async
Std.Async.Async は、非同期計算をサポートします。ここで非同期計算とは、複数の計算を「他の計算の結果を待たずに」実行するようなものを指します。
import Std.Async
open Std.Async Async
/-- 疑似的に重い処理を非同期で行う関数 -/
def expensiveOperationAsync (n : Nat) : Async Nat := do
IO.sleep 100 -- 100 ミリ秒スリープ
return n
/-- 疑似的に重い処理を同期で行う関数 -/
def expensiveOperationSync (n : Nat) : IO Nat := do
IO.sleep 100 -- 100 ミリ秒スリープ
return n
/-- `n` 回、非同期に重い処理を並列実行し、その結果の合計を返す -/
def manyInParallel (n : Nat) : Async Nat := do
-- `expensiveOperationAsync` を n 個生成
let tasks := (Array.range n).map expensiveOperationAsync
-- すべての非同期タスクを並列に実行し、結果を集める
let results ← concurrentlyAll tasks
return results.sum
/-- `n` 回、同期に重い処理を順次実行し、その結果の合計を返す -/
def manyInSync (n : Nat) : IO Nat := do
-- `expensiveOperationSync` を n 個生成
let tasks := (Array.range n).map expensiveOperationSync
-- 順次に全て実行して結果を集める
let results ← tasks.mapM id
return results.sum
-- 非同期版の方が速い
#eval (manyInParallel 3).block
#eval manyInSync 3
Bool
Bool は真偽値を表す型です。true と false の２つの値を持ちます。
#check (true : Bool)
#check (false : Bool)
Bool の値を得るためには、たとえば BEq のインスタンスがある型の値を == で比較します。
inductive Foo where
| bar
| baz
deriving BEq
example : Bool := Foo.bar == Foo.bar
example : Bool := Foo.bar != Foo.baz
真偽を表すという点で Prop と似ていますが、Bool の項は簡約すれば必ず true か false になるため計算可能であるという含みがあります。
Char
Char 型は、Unicode 文字を表します。二重引用符 " ではなくてシングルクォート ' で囲んで表されます。
-- Char はシングルクォートで囲む
#check ('a' : Char)
#check ("a" : String)
-- Unicode 文字を含む
#check ('あ' : Char)
#check ('∀' : Char)
#check ('∅' : Char)
符号位置
Char は、以下のように structure として定義されています。
structure Char where
/-- Unicode スカラー値 -/
val : UInt32
/-- `val` が正しく Unicode の code point であること -/
valid : val.isValidChar
したがって Char.val 関数により 符号位置(code point) を取得することができます。
#guard 'a'.val = 97
#guard '⨅'.val = 10757
これを利用すると、たとえば「アルファベットを与えられた整数 n だけずらして暗号化する関数」を以下のように実装することができます。1
/-- アルファベットのインデックス -/
structure Index where
/-- 番号。`0`から`25`の数字 -/
index : Nat
/-- 小文字かどうか -/
isLower : Bool
deriving Inhabited, DecidableEq
/-- アルファベットを`Index`に変換する -/
def Char.toIndex (c : Char) : Index :=
if c.isLower then
⟨c.val - 'a'.val |>.toNat, true⟩
else if c.isUpper then
⟨c.val - 'A'.val |>.toNat, false⟩
else
panic! s!"toIndex: input is {c}, which is not an alphabet"
#guard 'a'.toIndex = ⟨0, true⟩
#guard 'B'.toIndex = ⟨1, false⟩
/-- インデックスをアルファベットに変換する -/
def Char.ofIndex (i : Index) : Char := Id.run do
if i.index > 25 then
panic! s!"ofIndex: index is out of range: {i.index} > 25."
if i.isLower then
Char.ofNat ('a'.val.toNat + i.index)
else
Char.ofNat ('A'.val.toNat + i.index)
#guard Char.ofIndex ⟨0, true⟩ = 'a'
#guard Char.ofIndex ⟨1, false⟩ = 'B'
/-- アルファベットを`n`だけシフトする -/
def Char.shift (c : Char) (n : Int) : Char :=
if c.isAlpha then
let code := (c.toIndex.index + n) % 26 |>.toNat
let index : Index := ⟨code, c.isLower⟩
Char.ofIndex index
else
c
#guard Char.shift 'a' 3 = 'd'
#guard Char.shift 'z' 3 = 'c'
#guard Char.shift 'B' (-3) = 'Y'
/-- シーザー暗号の実装。文字列に登場する文字をシフトする。 -/
def String.encode (s : String) (n : Int) : String :=
s.map (Char.shift · n)
#guard "I am a magician.".encode 3 = "L dp d pdjlfldq."
#guard "L dp d pdjlfldq.".encode (-3) = "I am a magician."
-
この例は、Graham Hutton「プログラミングHaskell第２版」（ラムダノート）第５章を参考にしています。 ↩
CommandElab
Lean.Elab.Command.CommandElab は、コマンドの内部実装を表現しています。
CommandElab 型の項は、Syntax → CommandElabM Unit 型の関数です。
import Lean
open Lean Elab Command in
example : CommandElab = (Syntax → CommandElabM Unit) := rfl
[command_elab] 属性を利用することで、CommandElab 型の関数からコマンドを作ることができます。
/-- 挨拶をするコマンド -/
syntax (name := helloCommand) "#hello" : command
open Lean Elab Command in
@[command_elab helloCommand]
def evalHello : CommandElab := fun _stx => do
let msg := s!"Hello, Lean!"
logInfo msg
/- info: Hello, Lean! -/
#hello
コマンド作例
以下に、CommandElab 型の関数からコマンドを作る例を示します。
型を確かめるコマンド
以下は、与えられた項と型が一致するかどうかを確かめるコマンドの例です。1
import Lean
open Lean Elab Command Term
-- メタ変数を表示しない
set_option pp.mvars false
/-- 与えられた項の型をチェックするコマンド -/
syntax (name := assertType) "#assert_type " term " : " term : command
@[command_elab assertType]
def evalAssertType : CommandElab := fun stx => do
match stx with
| `(command| #assert_type $termStx : $typeStx) =>
liftTermElabM
try
let type ← elabType typeStx
let _ ← elabTermEnsuringType termStx type
logInfo "success"
catch | _ => throwError "failure"
| _ => throwUnsupportedSyntax
/- info: success -/
#assert_type 5 : Nat
/- info: success -/
#assert_type 42 : ?_
/-
error: Type mismatch
[1, 2, 3]
has type
List ?_
but is expected to have type
Nat
-/
#assert_type [1, 2, 3] : Nat
-
このコード例は、Metaprogramming in Lean 4 を参考にしました。 ↩
DerivingHandler
Lean.Elab.DerivingHandler は、型クラスのインスタンスの自動生成を行うための関数の型で、Array Name → CommandElabM Bool という型と等しいものです。
import Lean
open Lean Elab Command
example : DerivingHandler = (Array Name → CommandElabM Bool) := by
rfl
deriving ハンドラの登録
deriving コマンドを使用したときに、対応する DerivingHandler 型の関数が呼び出されます。
簡単な例として、任意の型から Unit への自明な関数を提供する ToUnit という型クラスを考えてみましょう。この型クラスが与える変換は自明なので、どんな型に対しても実装方法は「わかりきって」おり自動生成できそうです。
/-- `Unit`への変換方法を与える自明な型クラス -/
class ToUnit (α : Type) where
toUnit : α → Unit
/-- `Nat`における `ToUnit` のインスタンス -/
instance : ToUnit Nat where
toUnit _ := ()
/-- `String`における `ToUnit` のインスタンス -/
instance : ToUnit String where
toUnit _ := ()
#guard ToUnit.toUnit 42 = ()
#guard ToUnit.toUnit "hello" = ()
この型クラスに対して deriving コマンドが使えるようにするには、まず以下のように記述したファイルを作成し、deriving ハンドラを登録します。
import Lean
open Lean Elab Command
/-- `ToUnit` のためのインスタンス自動導出関数 -/
def deriveToUnitInstance (declNames : Array Name) : CommandElabM Bool := do
for declName in declNames do
let term := mkCIdent declName
let cmd ← `(command| instance : ToUnit $term := ⟨fun _ => ()⟩)
elabCommand cmd
return true
initialize
registerDerivingHandler ``ToUnit deriveToUnitInstance
そうすると、このファイルを import することで以下のように使用できるようになります。
-- 最初はインスタンスがない
#check_failure ToUnit.toUnit true
-- `deriving` コマンドを使用
deriving instance ToUnit for Bool, Int, Char
-- インスタンスが生成された！
#guard ToUnit.toUnit true = ()
#guard ToUnit.toUnit (42 : Int) = ()
#guard ToUnit.toUnit 'a' = ()
他の実装例
より実践的な例をご覧になりたい方は、以下の記事を参照してください。
Expr
Lean.Expr は Lean の 抽象構文木(abstract syntax tree) を表すデータ型です。
具象構文木である Syntax から Expr を得る操作のことを エラボレート(elaborate) と呼び、それを行う関数のことを エラボレータ(elaborator) と呼びます。
Syntax と Expr の違い
具象構文木である Syntax との違いを理解するために、具体的な例で比較してみましょう。
import Lean
import Qq
open Qq Lean Parser
/-- コンストラクタを使って定義した `[1]` というリスト -/
def listByCtorExpr : Q(List Nat) := q(List.cons 1 List.nil)
/- info: "List.cons.{0} Nat (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)) (List.nil.{0} Nat)" -/
#eval toString listByCtorExpr
/-- リストリテラルから定義した `[1]` というリスト -/
def listByListLitExpr : Q(List Nat) := q([1])
/- info: "List.cons.{0} Nat (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)) (List.nil.{0} Nat)" -/
#eval toString listByListLitExpr
set_option hygiene false in
/- info: "(Term.app `List.cons [(num \"1\") `List.nil])" -/
#eval show MetaM String from do
-- コンストラクタを使って定義した `[1]` というリストの Syntax
let stx ← `(term| List.cons 1 List.nil)
return toString stx
/- info: "(«term[_]» \"[\" [(num \"1\")] \"]\")" -/
#eval show MetaM String from do
-- リストリテラルから定義した `[1]` というリストの Syntax
let stx ← `(term| [1])
return toString stx
Repr の出力を比較すると極めて長くなるので ToString の出力を比較しましたが、このように Syntax は「同じものを意味するが構文が異なるもの」を区別する一方で、Expr は区別しません。
定義
Expr は Lean のソースコードの中で次のように定義されています。
open Lean
inductive Expr where
/-- 束縛変数 -/
| bvar (deBruijnIndex : Nat)
/-- 自由変数 -/
| fvar (fvarId : FVarId)
/-- メタ変数 -/
| mvar (mvarId : MVarId)
/-- 型の宇宙レベルを表す。 -/
| sort (u : Level)
/--
（宇宙多相的な）定数であり、モジュール内で以前に定義されたか、
import されたモジュールによって定義されたもの。
-/
| const (declName : Name) (us : List Level)
/-- 関数適用 -/
| app (fn : Expr) (arg : Expr)
/-- ラムダ抽象(無名関数) -/
| lam (binderName : Name) (binderType : Expr) (body : Expr) (binderInfo : BinderInfo)
/-- 依存関数型 `(a : α) → β` -/
| forallE (binderName : Name) (binderType : Expr) (body : Expr) (binderInfo : BinderInfo)
/-- let 式 -/
| letE (declName : Name) (type : Expr) (value : Expr) (body : Expr) (nonDep : Bool)
/-- 自然数リテラルと文字列リテラル。 -/
| lit : Literal → Expr
/-- メタデータ（注釈） -/
| mdata (data : MData) (expr : Expr)
/-- 射影式(projection expression) -/
| proj (typeName : Name) (idx : Nat) (struct : Expr)
bvar: 束縛変数
Expr.bvar は 束縛変数(bound variable) を表します。つまり、式の中で let や fun や ∀ などで束縛された変数のことです。deBrujinIndex パラメータは ド・ブラウンインデックス を表します。
たとえば、具体的な式では次のようになります。
open Qq in
/-
info: Lean.Expr.forallE `x (Lean.Expr.const `Nat [])
((((Lean.Expr.const `Eq [Lean.Level.zero.succ]).app (Lean.Expr.const `Nat [])).app (Lean.Expr.bvar 0)).app
(Lean.Expr.bvar 0))
Lean.BinderInfo.default
-/
#eval q(∀ x : Nat, x = x)
fvar: 自由変数
Expr.fvar は 自由変数(free variable) を表します。つまり、式の中で束縛されていない変数のことです。fvarId パラメータは自由変数の識別子です。
たとえば、証明において各時点で得られている仮定は自由変数であり Expr.fvar で表されます。
open Lean Elab Tactic in
/-- 現在の証明の状態を表示するタクティク -/
elab "my_trace_state" : tactic => do
-- 現在のローカルコンテキストを取得する
let ctx ← getLCtx
for (decl : LocalDecl) in ctx do
let fvar := Expr.fvar decl.fvarId
let type := decl.type
logInfo m!"{fvar} : {type}"
/-
info: _example : ∀ (n : Nat), n > 5 → ∃ n, n > 5
---
info: n : Nat
---
info: hn : n > 5
-/
example (n : Nat) (hn : n > 5) : ∃ n, n > 5 := by
my_trace_state
exists n
mvar: メタ変数
Expr.mvar はメタ変数を表します。メタ変数は、式におけるプレースホルダや穴だと考えることができます。つまり、後で具体的な値で埋めることが期待される変数です。
メタ変数の典型的な例は、証明における「現時点で示すべきゴール」です。
open Lean Elab Tactic in
elab "show_goal" : tactic => do
-- 現在のゴールを取得する
let goal ← getMainGoal
let goalExpr := Expr.mvar goal
-- ゴールの式を表示する
logInfo m!"{goalExpr}: {goal}"
set_option pp.mvars false in
/- info: ?_: ⊢ True -/
example : True := by
show_goal
trivial
sort: 宇宙レベル
Expr.sort は型の宇宙レベルを表します。
universe u
open Lean Expr Qq
/- info: sort Level.zero -/
#eval q(Prop)
/- info: sort Level.zero -/
#eval q(Sort 0)
/- info: sort Level.zero.succ -/
#eval q(Type 0)
const: 定数
Expr.const は定数や関数を表します。
open Lean Qq Expr
/- info: const `Nat [] -/
#eval q(Nat)
/- info: const `Nat.zero [] -/
#eval q(Nat.zero)
/- info: const `Nat.succ [] -/
#eval q(Nat.succ)
/- info: const `List.map [Level.zero, Level.zero] -/
#eval q(@List.map.{0, 0})
app: 関数適用
Expr.app は関数適用を表します。たとえば f と e に対応する Expr がそれぞれ ⟦f⟧ と ⟦e⟧ であるとき、f e に対応する Expr の項は Expr.app ⟦f⟧ ⟦e⟧ です。
open Lean Expr Qq
/- info: (const `Nat.succ []).app (const `Nat.zero []) -/
#eval q(Nat.succ Nat.zero)
lam: ラムダ抽象
Expr.lam はラムダ抽象を表します。つまり、無名関数を表します。
open Lean Expr Qq
/- info: lam `x (const `Nat []) (bvar 0) BinderInfo.default -/
#eval q(fun (x : Nat) => x)
引数について説明しておきます。
binderNameは束縛変数の名前を表します。下の例ではxです。binderTypeは束縛変数の型を表します。下の例ではNatです。bodyは関数の返り値を表します。下の例ではExpr.bvar 0で、これは束縛変数xを参照しています。binderInfoは束縛変数の情報を表します。明示的な引数なのか、暗黙の引数なのかといった情報を持ちます。
open Lean Expr Qq Level
/- info: "fun (x : Nat) => x" -/
#eval show String from
let expr := Expr.lam
(binderName := `x)
(binderType := q(Nat))
(body := Expr.bvar 0)
(binderInfo := .default)
toString expr
/-
info: lam `α (sort zero.succ)
(lam `x (bvar 0) ((((const `Eq [zero.succ]).app (bvar 1)).app (bvar 0)).app (bvar 0)) BinderInfo.default)
BinderInfo.implicit
-/
#eval q(fun {α : Type} (x : α) => x = x)
forallE: 依存関数型
Expr.forallE は依存関数型または全称量化を表現します。
open Lean Expr Qq Level
/-
info: forallE `P (sort zero) (forallE Name.anonymous (bvar 0) (bvar 1) BinderInfo.default) BinderInfo.default
-/
#eval q(∀ (P : Prop), P → P)
/-
info: forallE `n (const `Nat []) (((const `Vector [zero]).app (const `Nat [])).app (bvar 0)) BinderInfo.default
-/
#eval q((n : Nat) → Vector Nat n)
letE: let 式
Expr.letE は let 式を表します。let 式は、変数を束縛してその値を後続の式で使用するために使われます。
open Lean Expr Qq
/-
info: letE `x (const `Nat [])
((((const `OfNat.ofNat [Level.zero]).app (const `Nat [])).app (lit (Literal.natVal 0))).app
((const `instOfNatNat []).app (lit (Literal.natVal 0))))
(bvar 0) false
-/
#eval q(let x : Nat := 0; x)
lit: 自然数リテラルと文字列リテラル
Expr.lit は自然数リテラルや文字列リテラルを表します。
open Lean Expr Qq
/- info: lit (Literal.strVal "Lean is nice!") -/
#eval q("Lean is nice!")
Fin
Fin n は、「0 以上 n 未満」の自然数全体を表す型です。Fin n にはちょうど n 個の項があります。各項 z : Fin n は
- 値
z.val : Natと、 z.valがn未満であることの証明z.isLt
の組です。
/-- `isLt` で `z.val` の値が `n` 未満であることの証明を取り出せる -/
example (z : Fin 5) : z.val < 5 := by
exact z.isLt
/-- `Fin 3` には `0, 1, 2` に対応する３つの項がある -/
example (z : Fin 3) : z.val = 0 ∨ z.val = 1 ∨ z.val = 2 := by
grind
用途
Lean に有限個しかないことを伝える
Fin 型は、例えば Lean に何かが「有限個しかない」ことを伝えたいときに役に立ちます。
例えば、「自明でない約数を持つ」という述語を考えてみます。 約数を探索すべき範囲が有限であるためこの述語は決定可能ですが、Lean はそれを自動的には認識しません。
/-- 自然数 n は自明でない約数を持つ -/
def Nat.HasProperDivisor (n : Nat) : Prop :=
∃ m : Nat, m ∣ n ∧ 1 < m ∧ m < n
-- Decidable インスタンスの導出に失敗する
def instDecidableFail {n : Nat} : Decidable (Nat.HasProperDivisor n) := by
unfold Nat.HasProperDivisor
fail_if_success infer_instance
sorry
∃ m : Nat の部分を Fin で書き換えてやると、探索すべき範囲が有限であることが Lean に伝わるため、決定可能であることが自動的に導出できるようになります。
/-- 自然数 n は自明でない約数を持つ(`Fin`で書き換えたバージョン) -/
def Nat.HasProperDivisorFin (n : Nat) : Prop :=
∃ m : Fin n, m.val ∣ n ∧ 1 < m.val
-- 決定可能性を自動的に導出できる
instance (n : Nat) : Decidable (Nat.HasProperDivisorFin n) := by
unfold Nat.HasProperDivisorFin
infer_instance
ちょうど n 個の要素を持つ型を作る
Fin n は「ちょうど n 個の要素を持つ型」として標準的なものなので、特定の個数の要素を持つ型を定義したいとき、Fin を使うと便利なことがあります。具体例としては 付録: 嫉妬深い夫たちの川渡りパズル を参照してください。
Float
Float は浮動小数点数を表す型です。
浮動小数点数は、おおざっぱには有限桁の小数のようなものであるといえます。
#eval (0.01 : Float)
#eval (-2.34 : Float)
#eval (-42.0 : Float)
内部実装
浮動小数点数は、IEEE 754 に従い内部的には符号 s ∈ {0, 1} と仮数(significand) c : ℕ と指数 q : ℤ の三つ組で表されています。これは (-1)ˢ × c × 2 ^ q として解釈されます。
-- `64 = 1 * 2⁶` なので、仮数部は 1 で指数は 6 になる
#guard Float.toRatParts' 64.0 = some (1, 6)
-- `6 = 3 * 2¹` なので、仮数部は 3 で指数は 1 になる
#guard Float.toRatParts' 6.0 = some (3, 1)
-- `0.5 = 1 * 2⁻¹` なので、仮数部は 1 で指数は -1 になる
#guard Float.toRatParts' 0.5 = some (1, -1)
誤差
特に、浮動小数点数は2進数として表現されているので、一般に Float で10進数を正確に計算することはできません。
次のように 0.1 : Float を表示させると気が付きませんが、これは表示の際に数値が丸められているためです。
/- info: 0.100000 -/
#eval 0.1
Float を関数 Float.toRat0 で有理数に変換してみると、誤差の存在が明るみになります。
-- `1/10` にはならない！
/- info: 3602879701896397 / 36028797018963968 -/
#eval (0.1 : Float).toRat0
-- 分母の数は2の冪乗になっている
-- これは浮動小数点数が内部で2進数で表現されていることを裏付ける
#guard
let x := (0.1 : Float).toRat0.den
2 ^ Nat.log2 x = x
これでは誤差の存在はわかってもその大きさが分かりづらいので、10進数として正確な表現を出力してみましょう。1
/-- 分母が2のベキであるような正の有理数を10進小数として表示する -/
def Rat.pow2ToBase10Pos (x : Rat) : String :=
-- 整数部分
let integerPart := toString x.floor
-- `x` の分母は `2ⁱ` という形をしていると仮定したので、その指数 `i` を求めておく
let i := Nat.log2 x.den
-- 小数部分を`x` の分母が `2ⁱ` であることを利用して計算する
let decimalPart := (x.num % x.den) * 5 ^ i
|> toString
|>.leftpad i '0'
integerPart ++ "." ++ decimalPart
/-- 分母が2のベキであるような有理数を10進小数として表示する -/
def Rat.pow2ToBase10 (x : Rat) : String :=
if 0 ≤ x then x.pow2ToBase10Pos else "-" ++ (-x).pow2ToBase10Pos
/-- `Float` を丸めを行わずに正確に表示する -/
def Float.toExactDecimal (x : Float) : String := x.toRat0.pow2ToBase10
/- info: "0.1000000000000000055511151231257827021181583404541015625" -/
#eval Float.toExactDecimal 0.1
-- ２進数で表現されているので、0.5 は正確に表現できる
/- info: "0.5" -/
#eval Float.toExactDecimal 0.5
Float では明らかに正しそうに見える等式がしばしば誤差のために偽になるということに注意してください。
-- 等しそうに見えるが、等しくない
#guard 0.1 + 0.2 != 0.3
-- 両辺を `#eval` で評価してみても理由はわからない…
/- info: 0.300000 -/
#eval 0.1 + 0.2
/- info: 0.300000 -/
#eval 0.3
-- 両辺の正確な値を表示させてみると理由がわかる
-- `0.1 + 0.2 : Float` は `0.3 : Rat` より大きい
/- info: "0.3000000000000000444089209850062616169452667236328125" -/
#eval Float.toExactDecimal (0.1 + 0.2)
-- `0.3 : Float` は `0.3 : Rat` より小さい
/- info: "0.299999999999999988897769753748434595763683319091796875" -/
#eval Float.toExactDecimal 0.3
-
この浮動小数点数を正確に表示させる関数の実装例は、Zulip のトピック “display all of a Float object” における Daniel Weber 氏の投稿を参考にしています。 ↩
HashMap
Std.HashMap は、キー（鍵）と値のペアを格納するデータ構造です。
import Lean
open Std in
/- info: Std.HashMap.ofList [(1, "hello"), (2, "world")] -/
#eval ({(1, "hello"), (2, "world")} : HashMap Nat String)
Note
HashMapは{ (key, value), ... }という構文で定義することができるのですが、この記法はHashMap専用のものではなくて型クラスで定義されているものなので、期待されている型がHashMapだとわかっていなければ人間にとっても Lean にとっても解釈に紛れが発生します。そのため、HashMapを#evalしたときはHashMap.ofListを使った表記が選ばれます。
HashMap 同士の比較
2 つの s t : HashMap があるとき、「s と t のすべての構成要素が等しい」というのは、s = t ではなくて s ~m t または HashMap.Equiv s t で表現されます。
s = t は「内部実装まで含めて完全に等しい」という意味になってしまうことに注意してください。
open Std HashMap
example : (HashMap.ofList [(1, "a"), (2, "b")]) ~m (HashMap.ofList [(2, "b"), (1, "a")]) := by
refine Equiv.of_forall_getElem?_eq ?_
grind
使用例
頻度のカウント
HashMap を使うと、たとえば「文字列中に登場する文字の出現回数を数える」といった処理が効率的にできます。
open Std in
/--
文字列中の各文字の出現回数を数えて `HashMap` にまとめる関数。
-/
def countingChars (s : String) : HashMap Char Nat := Id.run do
-- 空のハッシュマップを作成（キー：文字、値：出現回数）
let mut counts : HashMap Char Nat := {}
-- 文字列をリストに変換して1文字ずつ処理
for c in s.toList do
-- 既存のカウント値を取得し（なければ 0）、1 を加算して更新
counts := counts.insert c (counts.getD c 0 + 1)
-- 完成したハッシュマップを返す
return counts
#guard (countingChars "").toList == [] -- 空文字列のカウントは空のハッシュマップ
#guard (countingChars "hello")['h']! == 1
#guard (countingChars "hello")['l']! == 2
ペアの検索
以下は、HashMap を使って「足してゼロになるペア」を配列から効率的に探す例です。
open Std in
/--
`nums` は整数の配列、`target` は目標の和。
`nums` の中から、2つの異なるインデックス `i`, `j` を見つけて、
`nums[i] + nums[j] = target` を満たすものを返す。
見つかった場合は `(i, j)` を `some` で返し、なければ `none` を返す。
-/
def twoSum (nums : Array Int) (target : Int) : Option (Nat × Nat) := Id.run do
-- すでに見た数とそのインデックスを記録するためのハッシュマップ
let mut seen : HashMap Int Nat := {}
-- 配列の要素とそのインデックスを1つずつ取り出して処理する
for (n, idx) in nums.zipIdx do
-- 現在の数値に対して、必要な差分（ペアとなるべき数）を計算
let diff := target - n
-- 差分がすでに見た値に含まれていれば、それが解の一部
match seen[diff]? with
| some seenIdx =>
-- 差分が見つかったので、そのインデックスと現在のインデックスを返す
return (seenIdx, idx)
| none =>
-- 見つからなければ、現在の値とそのインデックスを記録して次へ
seen := seen.insert n idx
continue
-- 最後まで見つからなければ `none` を返す
return none
-- 動作確認用のテスト
#guard twoSum #[2, 7, 11, 15] 9 = some (0, 1)
#guard twoSum #[3, 2, 4] 6 = some (1, 2)
#guard twoSum #[3, 3] 6 = some (0, 1)
HashSet
Std.HashSet は、「重複のない集まり」を表すデータ構造です。
{ .. } という記法で具体的に HashSet の項を定義することができます。
import Lean
open Std
/- info: Std.HashSet.ofList [1, 2, 3] -/
#eval ({1, 2, 3, 1, 1} : HashSet Nat)
Note
HashSetは{ a₁, a₂, ... }という構文で定義することができるのですが、この記法はHashSet専用のものではなくて型クラスで定義されているものなので、期待されている型がHashSetだとわかっていなければ人間にとっても Lean にとっても解釈に紛れが発生します。そのため、HashSetを#evalしたときはHashSet.ofListを使った表記が選ばれます。
insert 関数で要素を挿入することができますが、同じ要素を複数回挿入しても１つしか保持されません。
/- info: Std.HashSet.ofList [1] -/
#eval show (HashSet Nat) from Id.run do
-- 空の `HashSet` を作成
let mut s : HashSet Nat := {}
-- `1` を２回挿入
s := s.insert 1
s := s.insert 1
s
HashSet 同士の比較
2 つの s t : HashSet があるとき、「s と t のすべての構成要素が等しい」というのは、s = t ではなくて s ~m t または HashSet.Equiv s t で表現されます。
s = t は「内部実装まで含めて完全に等しい」という意味になってしまうことに注意してください。
open HashSet
example : (HashSet.ofList [1, 2]) ~m (HashSet.ofList [2, 1]) := by
refine Equiv.of_forall_mem_iff ?_
grind
特長
基本的なコレクション型である List と比較すると、HashSet には「要素が存在するか判定するのが高速」という特徴があります。
(要素の挿入や削除も高速ですが、ここでは存在判定に着目します。)
List では要素を順にたどって調べる必要があるのでサイズに対して線形時間かかってしまう一方で、HashSet は（良いハッシュ関数が与えられているという条件下で、平均的に）定数時間で判定することができます。実際に実験して List より高速であることを確かめたのが次のコードです。
import Lean
open Std
/-- HashSetとListで処理を共通化するための型クラス -/
class DS (col : Type) (α : Type) where
/-- 要素があるか判定する -/
contains : col → α → Bool
/-- ランダムな要素を生成する -/
gen : IO col
/-- 長さ `n` で、中身の値が 0 以上 `bound` 以下であるようなリストをランダム生成する -/
def randList (n : Nat) (bound : Nat) : IO (List Nat) := do
let mut out := []
for _ in [0 : n] do
let x ← IO.rand 0 bound
out := x :: out
return out
/-- 実験に使用するリスト・HashSet のサイズ -/
private def sampleSize := 1000_000
/-- 実験に使用するための巨大なリストをランダム生成する -/
private def genSampleList : IO (List Nat) := do
let size := sampleSize
let lst ← randList size (size * 1000)
return lst
/-- 実験に使用するための巨大な HashSet をランダム生成する -/
private def genSampleHashSet : IO (HashSet Nat) := do
let lst ← genSampleList
return HashSet.ofList lst
instance : DS (List Nat) Nat where
contains := fun lst => lst.contains
gen := genSampleList
instance : DS (HashSet Nat) Nat where
contains := fun s x => s.contains x
gen := genSampleHashSet
/-- 試す回数 -/
private def trial_time := 100
/-- `contain`を実行するのにかかる平均時間 -/
@[noinline]
def containAvgTime (type : Type) [inst : DS type Nat] : IO Nat := do
let col ← inst.gen
let mut total_time := 0
let mut useless := false -- 実行時に最適化されないように、無駄な計算をする
for i in [sampleSize : sampleSize + trial_time] do
let start_time ← IO.monoNanosNow
let b := inst.contains col i
let end_time ← IO.monoNanosNow
useless := !useless && b -- 無駄な計算をする
let elapsed := end_time - start_time
total_time := total_time + elapsed
return total_time / trial_time
def main : IO Unit := do
let list_avg_time ← containAvgTime (type := List Nat)
IO.println s!"Average time for list.contains: {list_avg_time} ns"
let hash_avg_time ← containAvgTime (type := HashSet Nat)
IO.println s!"Average time for hashSet.contains: {hash_avg_time} ns"
if list_avg_time < hash_avg_time then
throw <| .userError s!"List is faster: {list_avg_time} ns < {hash_avg_time} ns"
#eval main
舞台裏
なぜ HashSet では要素が存在するかの判定が高速なのでしょうか？また HashSet α を構築するには Hashable α のインスタンス（つまり α 上のハッシュ関数）が必要ですが、なぜ必要なのでしょうか？こういった疑問に答えるには、HashSet の内部実装を知る必要があります。
実際の Lean 標準ライブラリにおける実装を紹介することはかないませんが、ここでは Array を使った チェイン法(chaining) と呼ばれる方法による実装コードを紹介します。1（これは例示のためのトイ実装ですが、それほど本質は損なわれていません）
import Lean
open Std
namespace Playground
variable {α : Type} [Hashable α] [BEq α]
/-- チェイン法（chaining）による HashSet の実装 -/
structure HashSet (α : Type) where
/-- 内部データとしての配列 -/
data : Array (List α)
/-- data のサイズ -/
size : Nat
/-- 空の HashSet。空リストばかり格納されている。 -/
def HashSet.empty (size := 10000) : HashSet α :=
{ size := size, data := Array.replicate size [] }
/-- UInt64 を Nat に自動で変換する -/
instance : Coe UInt64 Nat where
coe n := n.toNat
/-- HashSet に新しい要素を挿入する -/
def HashSet.insert (s : HashSet α) (x : α) : HashSet α :=
-- 内部にある配列を取得する
let data := s.data
-- 加えようとしている要素のハッシュ値を計算して、
-- それをインデックスとして内部の配列にアクセスする
let idx := hash x
let list : List α := data[(idx : Nat) % data.size]!
-- 既に x が存在する場合とそうでない場合で場合分けをする
if list.contains x then
-- 既に存在する場合はそのままの HashSet を返す
s
else
-- 存在しない場合
-- そのインデックスにあるリストに要素を追加する
let newData := data.set! idx (x :: list)
-- 新しいデータを持つ HashSet を返す
{ size := data.size, data := newData }
/-- HashSet に要素があるか判定する。
ハッシュ関数でインデックスを計算するので高速に判定できる。-/
def HashSet.contains (s : HashSet α) (x : α) : Bool :=
-- 内部にある配列を取得する
let data := s.data
-- 加えようとしている要素のハッシュ値を計算して、
-- それをインデックスとして内部の配列にアクセスする
let idx := hash x
let list : List α := data[(idx : Nat) % data.size]!
-- そのリストに x が含まれているかどうかを返す
list.contains x
/-- HashSet から要素を削除する。
ハッシュ関数の値でインデックスがわかるので高速に削除できる。-/
def HashSet.erase (s : HashSet α) (x : α) : HashSet α :=
-- 内部にある配列を取得する
let data := s.data
-- 加えようとしている要素のハッシュ値を計算して、
-- それをインデックスとして内部の配列にアクセスする
let idx := hash x
let list : List α := data[(idx : Nat) % data.size]!
-- x が存在しない場合はそのままの HashSet を返す
if !list.contains x then
s
else
-- 存在する場合は、x を除いたリストを作成して新しい HashSet を返す
let newData := data.set! idx (list.erase x)
{ size := data.size, data := newData }
/-- HashSet をリストに変換する。この操作には、`Ω(|s.size|)` の時間がかかる。 -/
def HashSet.toList (s : HashSet α) : List α := Id.run do
let mut result : List α := []
-- 内部の配列をすべて結合してリストにする
for x in s.data do
result := x ++ result
return result
-- contains 関数のテスト
#guard show Bool from Id.run do
let mut set : HashSet Nat := HashSet.empty
set := set.insert 1
set := set.insert 2
set.contains 1
-- 削除のテスト
#guard show Bool from Id.run do
let mut set : HashSet Nat := HashSet.empty
-- 1 を２回挿入
set := set.insert 1
set := set.insert 1
-- 1 を削除する
set := set.erase 1
! set.contains 1
/- info: [2, 1] -/
#eval show (List Nat) from Id.run do
let mut set : HashSet Nat := HashSet.empty
-- 1 を２回挿入
set := set.insert 1
set := set.insert 1
set := set.insert 2
-- HashSet をリストに変換して返す
set.toList
end Playground
使用例
足して 0 になるペアがあるか判定する
整数からなるリスト l : List Int が与えられたとします。このとき、l の中に足して 0 になるペアが存在するかどうかを判定する問題を考えます。
この問題は HashSet を使うと次のように O(|l|) 時間で解くことができます。要素が存在するかどうかを判定するのが高速という特徴が生かされていることに注目してください。もし List を使っていたら、要素が存在するかどうかの判定に Ω(|l|) 時間かかってしまうので、全体で Ω(|l|²) 時間かかってしまいます。
def findSumZeroPair (l : List Int) : Bool := Id.run do
-- 今までに見た要素を保持するための HashSet
let mut seen : HashSet Int := {}
for x in l do
-- x の補数を既に見つけていたら true を返す
if seen.contains (-x) then
return true
-- そうでなければ、単に x を HashSet に追加して次へ
seen := seen.insert x
return false
文字列の部分文字列を重複を除いて全列挙する
文字列 s := c₀c₁..cₙ に対して、s に含まれる連続する文字列 cₖcₖ₊₁..cₗ を「s の部分文字列」といいます。
与えられた s : String に対して、s のすべての部分文字列を求める関数を考えます。このとき、部分文字列をどう数えるかの流儀が少なくとも２通り考えられます。
sから切り出す位置が異なっていても、文字列として同じならば部分文字列としても同じsから切り出す位置が異なっていれば、部分文字列として異なる
前者の解釈を採用したとするなら、その関数の型は String → HashSet String であるべきです。そうすれば型からより多くの情報が得られるほか、重複を除くための処理が簡潔になるからです。
open String Pos in
/-- ある文字列の部分文字列を重複を除いて全列挙する -/
def allSubstrings (s : String) : HashSet String := Id.run do
let mut result : HashSet String := {}
for j in [1 : s.length + 1] do
for i in [0 : j] do
let sub := Raw.extract s ⟨i⟩ ⟨j⟩
result := result.insert sub
return result.insert ""
#guard (allSubstrings "aaa").toList = ["", "aaa", "a", "aa"]
#guard (allSubstrings "abc").toList = ["", "abc", "bc", "c", "a", "ab", "b"]
-
チェイン法によるハッシュテーブルの実装については、詳しくは Pat Morin著・堀江、陣内、田中訳「みんなのデータ構造」（ラムダノート）を参考にしてください。 ↩
IO
IO は、入出力(input / output)などの外界とのやり取りを含む計算を表すモナドです。ファイル操作・入出力・乱数・時刻の取得などの副作用のある処理を包んで、副作用のない処理と区別します。
IO α の項は、「実行すると α の値を得られるかもしれない計算」を表します。特に、IO α の項は計算によって得られる値そのものではありません。このニュアンスを強調するために、IO α の項のことを IO アクション と呼ぶことがあります。
IO アクションの例
標準入出力
標準出力ストリームに何かを書き込んだり、標準入力ストリームから何かを受け取ったりする処理は IO アクションです。以下は、ユーザによりキーボードから入力された文字を受け取って、挨拶を返す単純なプログラムの例です。
/-- キーボードからユーザの入力を取得する -/
def getUserInput : IO String := do
-- 入力待ちであることをアピールする
IO.print "> "
let stdin ← IO.getStdin
let input ← stdin.getLine
-- trim をしないと余計な改行が入る
return input.trimAscii.copy
/-- 標準入力から入力された名前に対して挨拶をする -/
def main : IO Unit := do
IO.println "誰に挨拶しますか？"
let name ← getUserInput
IO.println s!"Hello, {name}!"
標準出力に書き込んだ後、同じ行を上書きすることによって、ターミナル上でアニメーションを表示することができます。以下は、処理の進捗を表すスピナーを表示する例です。
def spinnerFrames : Array String :=
#["⠋", "⠙", "⠹", "⠸", "⠼", "⠴", "⠦", "⠧", "⠇", "⠏"]
/-- ターミナルに対して、現在のカーソルがある行全体を消せと指示する -/
def IO.clearLine : IO Unit := do
IO.print "\r\x1b[2K"
def main : IO Unit := do
-- 標準出力ストリームを取得する
let stdout ← IO.getStdout
for i in List.range 80 do
let frame := spinnerFrames[i % spinnerFrames.size]!
IO.print s!"\r{frame} 処理中..."
-- 標準出力への変更をすぐに反映させる
stdout.flush
-- ここに「少しずつ進む重い処理」を書く
IO.sleep 20
-- 行を消して完了表示
IO.clearLine
IO.println "完了"
また、ユーザの入力を扱うことができるということは、対話的(interactive)なプログラムを書くことができるということです。たとえば、以下のようなプログラムを書くことができます。
余談ですが、Lean 4 でもクワイン(quine)を書くことができます。
ファイル操作
以下は、ファイルを読んでその内容を表示するような簡単なコマンドラインツールを実装する例です。
open IO FS System
/-- シンプルな `cat` コマンドの実装。
コマンドライン引数からファイル名を受け取り、そのファイルの内容を表示する。
ファイル名が指定されていない場合や、複数指定された場合にはエラーメッセージを表示する。
-/
def main (args : List String) : IO Unit := do
match args with
| [] => println "ファイル名を指定してください。"
| [fileName] =>
let filePath : FilePath := fileName
let fileExists ← filePath.pathExists
if fileExists then
let contents ← readFile filePath
println contents
else
println s!"ファイルは存在しません: {fileName}"
| _ => println "複数のファイル名は指定できません。1つだけ指定してください。"
ランダム性
乱数を扱うような操作は IO アクションです。
/-- 長さ `n` で、中身の値が 0 以上 `bound` 以下であるようなリストをランダム生成する -/
def randList (n : Nat) (bound : Nat) : IO (List Nat) := do
let mut out := []
for _ in [0 : n] do
-- ランダムに 0 以上 bound 以下の自然数を生成する
let x ← IO.rand 0 bound
-- 生成した自然数をリストに追加する
out := x :: out
return out
#eval randList 5 10
時刻
時刻を扱うような操作も IO アクションです。
/-- フィボナッチ数列 -/
def fibonacci (n : Nat) : Nat :=
match n with
| 0 => 0
| 1 => 1
| n + 2 => fibonacci n + fibonacci (n + 1)
/-- `fibonacci` の計算にかかった時間を計測する -/
def computeTime : IO Unit := do
let start_time ← IO.monoMsNow
-- コンパイラに最適化されて実行順序が変わらないように、`IO.lazyPure` で包む
let result ← IO.lazyPure <| fun _ => fibonacci 30
let end_time ← IO.monoMsNow
IO.println s!"Result: {result}, Time taken: {end_time - start_time} ms"
#eval computeTime
IO からの脱出
IO アクションは基本的に「副作用のある計算」であり、IO から脱出する安全かつ汎用的な関数はありません。言い換えれば、runIO : IO α → α というような参照透過な関数はありません。
しかし Lean は自由度が高い言語でありまして、この制約も破ることができます。unsafe な機能を使ってよければ、IO から脱出することができます。1
import Lean
open Lean Meta Elab Term
def toExprIO {α : Type} [ToExpr α] (x : IO α) : IO Expr :=
toExpr <$> x
elab tk:"run_io " t:doSeq : term <= expectedType => withRef t do
let expectedType := mkApp (mkConst ``IO) expectedType
let v ← elabTermEnsuringType (← `(do $t)) expectedType
synthesizeSyntheticMVarsNoPostponing
let v ← instantiateMVars v
if (← logUnassignedUsingErrorInfos (← getMVars v)) then
throwAbortTerm
let v ← mkAppM ``toExprIO #[v]
let io ← unsafe evalExpr (IO Expr) (mkApp (mkConst ``IO) (mkConst ``Expr)) v
let (out, x) ← IO.FS.withIsolatedStreams io.toBaseIO
unless out.isEmpty do
logInfoAt tk out
match x with
| .ok x => return x
| .error e => throwErrorAt tk e.toString
-- 使用例。ランダムな数を選んでいるのに、型を `Nat` にすることができる
def number : Nat := run_io IO.rand 0 1000
-- 実行前に既に値が決定されているため、
-- 平気で証明ができる
example : 0 ≤ number ∧ number < 1001 := by
simp [number.eq_def]
-
このコードは Lake.DSL.Meta のコードをほぼそのまま引用したものです。 ↩
Linter
Lean.Elab.Command.Linter は構文リンター(syntax linter)の本体です。
構文リンターとは何かというと、Lean のリンター（よくない書き方のコードを検出するツール）の分類名です。
構文リンターは基本的には各コマンドのエラボレーション時に自動で実行されます。
構文リンターの種類によっては、set_option コマンドなどで有効化する必要があります。
Lean のリンターには他に、環境リンター(environment linter)があります。
使用例
選択原理を証明の中で使用すると警告してくれるリンターを自作する例を紹介します。1 まず以下のように記述したファイルを作成します。
-- Linter/DetectClassical.lean の内容
import Lean
/--
`detectClassical` リンターは、`Classical.choice` 公理に依存する宣言に対して警告を発する。
デフォルト値は `true`
-/
register_option linter.detectClassical : Bool := {
defValue := true
descr := "detectClassicalリンターを有効にする"
}
open Lean Elab Command
/--
ある位置 `pos` 以降にソースコード内で登場するすべての宣言名を収集する
-/
private def getNamesFrom (pos : String.Pos.Raw) : CommandElabM (Array Syntax) := do
let drs := declRangeExt.toPersistentEnvExtension.getState (asyncMode := .local) (← getEnv)
let fm ← getFileMap
let mut nms := #[]
for (nm, rgs) in drs do
if pos ≤ fm.ofPosition rgs.range.pos then
let ofPos1 := fm.ofPosition rgs.selectionRange.pos
let ofPos2 := fm.ofPosition rgs.selectionRange.endPos
nms := nms.push (mkIdentFrom (.ofRange ⟨ofPos1, ofPos2⟩) nm)
return nms
@[inherit_doc linter.detectClassical]
def detectClassicalLinter : Linter where
run := withSetOptionIn fun stx ↦ do
-- リンターが有効になっていなければ何もしない
unless Linter.getLinterValue linter.detectClassical (← Linter.getLinterOptions) do
return
-- どこかにエラーがあれば何もしない
if (← get).messages.hasErrors then
return
-- ユーザが定義した名前を取得する
let names := (← getNamesFrom (stx.getPos?.getD default))
|>.filter (! ·.getId.isInternal)
for constStx in names do
let constName := constStx.getId
let axioms ← collectAxioms constName
-- 公理に依存していなければスルーする
if axioms.isEmpty then
return
-- 選択原理に依存していれば警告を出す
if axioms.contains `Classical.choice then
Linter.logLint linter.detectClassical constStx
m!"`{constName}` depends on `Classical.choice`.\nAll axioms: {axioms.toList}"
initialize addLinter detectClassicalLinter
このファイルを読み込むと、次のように使用できます。
import LeanByExample.Type.Linter.DetectClassical
-- 選択原理を使用しているため警告が出る
/-
warning: `prop_iff_neg_self₀` depends on `Classical.choice`.
All axioms: [propext, Classical.choice, Quot.sound]
Note: This linter can be disabled with `set_option linter.detectClassical false`
-/
theorem prop_iff_neg_self₀ (P : Prop) : ¬ (P ↔ ¬ P) := by
intro h
by_cases hp : P
· have : ¬ P := by
rwa [h] at hp
contradiction
· have : ¬ ¬ P := by
rwa [h] at hp
contradiction
-- 選択原理に依存しない証明には警告が出ない
theorem prop_iff_neg_self₁ (P : Prop) : ¬ (P ↔ ¬ P) := by
intro h
have hnp : ¬ P := by
intro hp
have hnp : ¬ P := by
rwa [h] at hp
contradiction
have hp : P := by
have : ¬ ¬ P := by
rwa [h] at hnp
contradiction
contradiction
-
この例は Lean 公式の Zulip の restricting axioms というトピックにおける、Damiano Testa さんの投稿を参考にしています。 ↩
List
List は 連結リスト(linked list) を表す型です。
Lean では次のように再帰的に定義されています。
/-- `α` 型の項を集めたリスト -/
inductive List.{u} (α : Type u) where
/-- 空リスト `[]` はリスト -/
| nil : List α
/-- `a : α` と `l : List α` があるとき、`a` を先頭に追加したリストが作れる -/
| cons (head : α) (tail : List α) : List α
構文と記法
List α の項はカンマ区切りの値を [] で囲むことによって作ることができます。これはリストリテラルと呼ばれる構文です。
#check ([1, 2, 3] : List Nat)
また、List のコンストラクタ List.nil は [] で、List.cons は :: で表すことができます。
example : [] = @List.nil (α := Unit) := by rfl
-- List.cons x xs は x :: xs と書ける
example {α : Type} (x : α) (xs : List α) : List.cons x xs = x :: xs := by
rfl
(· :: ·) は「リストの先頭に要素を追加して新しいリストを作る操作」を表していると考えることができます。
-- `::` で先頭に要素を追加する
#guard "hello" :: ["world"] = ["hello", "world"]
連結
リスト同士を順序を保ちながら連結するには、List.append 関数を使います。これは Append 型クラスのインスタンスになっているので、++ という演算子で利用できます。
-- `++` 演算子が利用できる
example {α : Type} (xs ys : List α) : xs ++ ys = List.append xs ys := by
rfl
-- リストの連結
#guard [1.0, 2.0] ++ [3.0] == [1.0, 2.0, 3.0]
高階関数
「関数を引数に取る関数」や「関数を返す関数」のことを、高階関数(higher-order function) と呼ぶことがあります。List 名前空間には様々な高階関数が定義されています。
map
List は Functor 型クラスのインスタンスになっているため <$> 演算子が利用できます。<$> は List.map で実装されています。
-- `<$>` 演算子が利用できる
#guard (fun x => x * 2) <$> [1, 2, 3] = [2, 4, 6]
example {α β : Type} (f : α → β) (xs : List α) : f <$> xs = List.map f xs := by
rfl
List.map f は「リストの中身のそれぞれに独立に関数を適用する」操作を表します。具体的には関数 f : α → β があるとき、List.map f は関数 List α → List β であって、リスト xs : List α の各要素に f を適用するようなものです。
section
variable {α β : Type} {a₁ a₂ a₃ : α}
example (f : α → β) : [a₁, a₂, a₃].map f = [f a₁, f a₂, f a₃] := by
rfl
-- リストの各要素を 2 倍する
#guard List.map (fun x => x * 2) [1, 2, 3] = [2, 4, 6]
end
filter
List の中の要素から、ある条件を満たすものだけを取り出すには List.filter を使います。
-- `l` 以外の文字を残す
#guard ["h", "e", "l", "l", "o"].filter (· ≠ "l") = ["h", "e", "o"]
-- 偶数を残す
#guard [1, 2, 3, 4, 5].filter (· % 2 = 0) = [2, 4]
foldr
List.foldr は、二項演算でリストの各要素を右結合的に繋げて畳み込む(fold)関数です。
/-- `List.foldr` の例示のための型クラス -/
class Foldr (α β : Type) where
/-- 右結合的な二項演算 -/
op : α → β → β
-- 右結合的な演算子として `⋄` を定義する
@[inherit_doc] infixr:70 "⋄" => Foldr.op
section
variable {α β : Type} [Foldr α β] {a₁ a₂ a₃ : α}
-- foldr を適用することは、リストの要素を二項演算で繋げることに等しい
example (init : β) : [a₁, a₂, a₃].foldr (· ⋄ ·) init = a₁ ⋄ a₂ ⋄ a₃ ⋄ init := by
rfl
end
List.foldr は、多くの再帰関数に共通に現れる再帰のパターンを抽象化したものになっています。たとえば、リストの長さを求める関数 List.length を次のように定義すると、これは List.foldr の具体例になっています。1
namespace Foldr
variable {α : Type}
/-- リストの長さを求める -/
def length (xs : List α) : Nat :=
match xs with
| [] => 0
| _ :: xs => 1 + length xs
#guard length [1, 2, 3, 4, 5] = 5
-- length は foldr で表すことができる！
example (xs : List α) : length xs = xs.foldr (fun _ n => 1 + n) 0 := by
delta length List.foldr
rfl
end Foldr
また、リストの順番を逆にする関数 List.reverse を次のように定義すると、これも List.foldr の具体例になっています。
namespace Foldr
variable {α : Type}
/-- リストの順番を逆にする関数 -/
def reverse : List α → List α
| [] => []
| x :: xs => reverse xs ++ [x]
#guard reverse [1, 2, 3, 4, 5] = [5, 4, 3, 2, 1]
-- reverse は foldr で表すことができる！
example (xs : List α) : reverse xs = xs.foldr (fun x xs => xs ++ [x]) [] := by
delta reverse List.foldr
rfl
end Foldr
foldl
List.foldl は、二項演算でリストの各要素を左結合的に繋げて畳み込む関数です。
/-- `List.foldl` の例示のための型クラス -/
class Foldl (α β : Type) where
/-- 左結合的な二項演算 -/
op : α → β → α
-- 左結合的な演算子として `⊗` を定義する
@[inherit_doc] infixl:70 "⊗" => Foldl.op
section
variable {α β : Type} [Foldl α β] {b₁ b₂ b₃ : β}
-- foldl を適用することは、リストの要素を二項演算で繋げることに等しい
example (init : α) : [b₁, b₂, b₃].foldl (· ⊗ ·) init = init ⊗ b₁ ⊗ b₂ ⊗ b₃ := by
rfl
end
List.foldl も List.foldr と同様、多くの再帰関数に共通に現れる再帰のパターンを抽象化したものになっていますが、List.foldr とは異なり末尾再帰関数になります。たとえば、リストの長さを求める関数 List.lengthTR を次のように定義すると、これは List.foldl の具体例になっています。
namespace Foldl
variable {α : Type}
/-- リストの長さを求める -/
def lengthTR (xs : List α) : Nat :=
aux xs 0
where
/-- リストの長さを求めるヘルパ関数 -/
aux : List α → Nat → Nat
| [], n => n
| _ :: xs, n => aux xs (1 + n)
#guard lengthTR [1, 2, 3, 4, 5] = 5
-- lengthTR は foldl で表すことができる！
example (xs : List α) : lengthTR xs = xs.foldl (fun n _ => 1 + n) 0 := by
delta lengthTR lengthTR.aux List.foldl
rfl
end Foldl
また、リストの順番を逆にする関数 List.reverseTR を次のように定義すると、これも List.foldl の具体例になっています。
namespace Foldl
variable {α : Type}
/-- リストの順番を逆にする関数 -/
def reverseTR (xs : List α) : List α :=
aux xs []
where
/-- リストの順番を逆にするヘルパ関数 -/
aux : List α → List α → List α
| [], acc => acc
| x :: xs, acc => aux xs (x :: acc)
#guard reverseTR [1, 2, 3, 4, 5] = [5, 4, 3, 2, 1]
-- reverseTR は foldl で表すことができる！
example (xs : List α) : reverseTR xs = xs.foldl (fun xs x => x :: xs) [] := by
delta reverseTR reverseTR.aux List.foldl
rfl
end Foldl
モナドインスタンス
Lean では、List は標準では Monad 型クラスのインスタンスになっていません。
#check_failure (inferInstance : Monad List)
しかし、Monad 型クラスのインスタンスにすることは可能です。
instance : Monad List where
pure x := [x]
bind l f := l.flatMap f
map f l := l.map f
List のモナドインスタンスを利用すると、「リスト xs : List α の中から要素 x : α を選んで y : β を構成することをすべての要素 x ∈ xs に対して繰り返し、結果の y を集めてリスト ys : List β を構成する」ということができます。
def List.map' {α β : Type} (xs : List α) (f : α → β) : List β := do
-- `x ∈ xs` を選ぶ
let x ← xs
-- `y := f x` を構成する
let y := f x
-- `y : β` を返す。関数全体の返り値は、返される `y` を集めたものになる。
return y
#guard [1, 2, 3].map' (· + 1) = [2, 3, 4]
#guard [1, 2, 3, 4].map' (· % 3 == 0) = [false, false, true, false]
List のモナドインスタンスを利用すると、リスト内包記法のような処理、つまり「選択肢を選ぶことに依存して得られうる結果を、一つのリストにすべてまとめて返す」系の関数を簡潔に実装できます。
/-- `α` 上の n 項演算全体の型 -/
def Arity (α : Type) : (n : Nat) → Type
| 0 => α
| n + 1 => α → Arity α n
/-- 2 項演算 `Bool → Bool → Bool` の例 -/
example : Arity Bool 2 := fun a b => a && b
/-- 真理関数 `p : Arity Bool n` に対して、その真理値表を作成する。-/
def tablen (n : Nat) (p : Arity Bool n) : List (List Bool) :=
match n with
| 0 => [[p]]
| n + 1 => do
let b ← [true, false]
let rest ← tablen n (p b)
return b :: rest
#guard
let expected := [
[true, true, true],
[true, false, false],
[false, true, false],
[false, false, false]
]
let actual := tablen 2 (fun a b => a && b)
expected = actual
#guard
let result := tablen 3 (fun a b c => a || b || c)
-- 結果が false になるものだけ集める
result.filter (fun xs => ! xs.getLast!) = [[false, false, false, false]]
使用例
l : List α に対しては「先頭への要素の追加」と「先頭からの要素の取り出し」が高速に行えるので、スタックの実装に利用することができます。
/-- 括弧が対応しているか判定する -/
def matchParen (c1 c2 : Char) : Bool :=
match c1, c2 with
| '(', ')' => true
| '{', '}' => true
| '[', ']' => true
| _, _ => false
/--
文字列 `s` に含まれる括弧が正しく対応しているかどうかを判定する関数。
開き括弧と閉じ括弧が対応しており、正しい順序で閉じられている場合に `true` を返す。
-/
def validParen (s : String) : Bool := Id.run do
-- 括弧のスタックを空で初期化
let mut stack : List Char := []
-- 文字列の各文字に対してループ
for c in s.toList do
-- スタックの先頭の要素（最後に追加された開き括弧）を取得
let last := stack.head?
match last with
| none =>
-- スタックが空なら、文字をスタックに追加（開き括弧のはず）
stack := c :: stack
| some last =>
-- スタックの先頭と現在の文字が対応する括弧なら、スタックから取り除く（ペアが閉じられた）
if matchParen last c then
stack := stack.tail
else
-- 対応していない場合は、新たにスタックに追加（新しい開き括弧）
stack := c :: stack
-- すべての括弧が正しく閉じられていればスタックは空になっている
return stack.isEmpty
#guard validParen "()"
#guard validParen "()[]{}"
#guard !validParen "(]"
#guard !validParen "([)]"
#guard validParen "{[]}"
#guard !validParen "{"
#guard !validParen "}"
#guard validParen "([{}])({}){}"
-
ここで使用した例は、Graham Hutton著, 山本和彦訳「Programming Haskell 第2版」（ラムダノート）の7.3章を参考にさせていただきました。 ↩
Macro
Lean.Macro 型の項は、マクロの内部実装を表現しています。一般のプログラミング言語においてマクロとは構文を構文に変換することを指す言葉で、必ずしも特定の型や項に対応する概念ではありませんが、Lean の m : Macro は、Syntax → MacroM Syntax という関数型そのものです。
open Lean in
example : Macro = (Syntax → MacroM Syntax) := by rfl
Syntax 型が Lean の構文木をダイレクトに表していたように、Macro 型は Lean のマクロをダイレクトに表しています。
Macro 型とマクロの関係
Macro 型からマクロ
項 m : Macro を使ってマクロを定義するには、以下のように [macro] 属性を付与します。
open Lean
/-- `zeroLit` という構文の定義 -/
syntax (name := zeroLitStx) "zeroLit" : term
/-- `zeroLit` という構文を展開するマクロ -/
@[macro zeroLitStx]
def expandZeroLit : Macro := fun stx =>
match stx with
| `(term| zeroLit) => `(term| 0)
| _ => Macro.throwUnsupported
-- マクロ展開されるので、0 に等しいという結果になる
#guard zeroLit = 0
マクロから Macro 型
実際にマクロを定義する際は、notation コマンドや macro コマンド、macro_rules コマンドなどを使用するでしょう。こういったコマンドでマクロを定義したとき、それが裏で Macro 型の項を生成していることを確かめることができます。特定のコマンドの実行後に新たに生成された識別子の名前をリストアップすることができる、#whats_new コマンドを使えば可能です。
import Mathlib.Util.WhatsNew
-- `macro_rules` コマンドの `#whats_new` コマンドによる出力の中に、`Macro` 型の項が含まれている
/-- Macro -/
#guard_msgs (substring := true) in
#whats_new in
macro_rules
| `(zeroLit) => `(1)
マクロ展開を確認する方法
マクロがどのように展開されているか確かめるには、次で示すように Macro.expandMacro? 関数が利用できます。また、pp.macroStack オプションを使うという方法もあります。
section
open Lean
/-- `#expand` の入力に渡すための構文カテゴリ -/
syntax macro_stx := command <|> tactic <|> term
/-- マクロを展開するコマンド -/
elab "#expand " "(" stx:macro_stx ")" : command => do
let t : Syntax :=
match stx.raw with
| .node _ _ #[t] => t
| _ => stx.raw
match ← Elab.liftMacroM <| Macro.expandMacro? t with
| none => logInfo m!"Not a macro"
| some t => logInfo m!"{t}"
end
/- info: notation:50 lhs✝:51 " LXOR " rhs✝:51 => lxor lhs✝ rhs✝ -/
#expand (infix:50 " LXOR " => lxor)
MacroM
MacroM は、マクロ展開のための主要なモナドです。マクロ衛生を実現するために必要な状態を保持しています。
使用例
オセロのゲーム盤
Macro 型の関数および MacroM モナドに包まれた関数を使用して、オセロのゲーム盤を表現する構文を定義することができます。
import Lean
/-- 盤面の１セルの状態 -/
inductive Cell where
/-- 空のセル -/
| empty
/-- 黒のセル -/
| black
/-- 白のセル -/
| white
deriving Inhabited, Repr, BEq
/-- 盤面の１セルを表す構文カテゴリ -/
declare_syntax_cat cell
/-- 盤面の何も置かれていない箇所 -/
syntax "-" : cell
/-- 盤面の黒のセル -/
syntax "●" : cell
/-- 盤面の白のセル -/
syntax "○" : cell
open Lean Macro
/-- cellの構文展開 -/
def expandCell (stx : TSyntax `cell) : MacroM (TSyntax `term) := do
match stx with
| `(cell| -) => `(Cell.empty)
| `(cell| ○) => `(Cell.white)
| `(cell| ●) => `(Cell.black)
| _ => throwUnsupported
open Parser TSyntax
syntax row := withPosition((lineEq cell)*)
syntax (name := boardStx) "board" withoutPosition(sepByIndentSemicolon(row)) : term
/-- rowの構文展開 -/
def expandRow (stx : TSyntax `row) : MacroM (TSyntax `term) := do
match stx with
| `(row| $cells:cell*) => do
let cells ← cells.mapM expandCell
`(term| #[ $[$cells],* ])
| _ => throwUnsupported
macro_rules
| `(term| board $rows:row*) => do
let rows ← (rows : TSyntaxArray `row).mapM expandRow
`(term| #[ $[$rows],* ])
#guard
let actual := board
- - - -
- ● ○ -
- ○ ● -
- - - -
let expected : Array (Array Cell) := #[
#[Cell.empty, Cell.empty, Cell.empty, Cell.empty],
#[Cell.empty, Cell.black, Cell.white, Cell.empty],
#[Cell.empty, Cell.white, Cell.black, Cell.empty],
#[Cell.empty, Cell.empty, Cell.empty, Cell.empty]
]
actual == expected
指数表記マクロ
a¹、a²、a³ のような指数表記をマクロで定義することもできます。以下の例では、aⁿ のような構文を定義しています。
open Lean Macro Parser
/-- 指数表記 -/
declare_syntax_cat exp
syntax "⁰" : exp
syntax "¹" : exp
syntax "²" : exp
syntax "³" : exp
syntax "⁴" : exp
syntax "⁵" : exp
syntax "⁶" : exp
syntax "⁷" : exp
syntax "⁸" : exp
syntax "⁹" : exp
-- ホワイトスペースなしで`exp`が１つ以上連続したときにマッチ
syntax term (noWs exp)+ : term
syntax term "⁻"(noWs exp)+ : term
-- `Inv`のために用意されている`⁻¹`という構文を上書きする
syntax term "⁻¹"(noWs exp)+ : term
def expToNat (stx : TSyntax `exp) : Nat :=
match stx with
| `(exp|⁰) => 0
| `(exp|¹) => 1
| `(exp|²) => 2
| `(exp|³) => 3
| `(exp|⁴) => 4
| `(exp|⁵) => 5
| `(exp|⁶) => 6
| `(exp|⁷) => 7
| `(exp|⁸) => 8
| `(exp|⁹) => 9
| _ => 0 -- 無効な構文の場合は0を返す
def expToSyntax (exp : Array (TSyntax `exp)) (litPrefix := 0) : MacroM (TSyntax `term) := do
let digits := exp.map expToNat
let exp := digits.foldl (fun acc x => 10 * acc + x) litPrefix
return quote exp
macro_rules
| `($lhs $[$exp]*) => do
let stx ← expToSyntax exp
`($lhs ^ $stx)
| `($lhs ⁻$[$exp]*) => do
let stx ← expToSyntax exp
`($lhs ^ (Int.neg $stx))
| `($lhs ⁻¹$[$exp]*) => do
let stx ← expToSyntax exp (litPrefix := 1)
`($lhs ^ (Int.neg $stx))
#guard (2 : Int)⁰ = 1
#guard 2³ = 8
#guard (2 : Rat)⁻¹⁰ = (1 : Rat) / 1024
ラベル付き木の項表示
ラベル付き木に対する項表示の構文をマクロで定義することができます。
variable {α : Type}
/-- ラベル付き木 -/
inductive Tree (α : Type) where
| empty
| node (v : α) (children : List (Tree α))
deriving BEq
/-- 葉(子を持たないノード) -/
def Tree.leaf (v : α) : Tree α := Tree.node v []
open Lean Macro
/-- ラベル付き木のための構文 -/
declare_syntax_cat tree
/-- `φ`が`tree`構文であるならば、`[tree| φ]`はラベル付き木を表す -/
syntax "[tree| " tree "]" : term
/-- 木のラベル。ラベルとしては、数値リテラル・文字列リテラル・文字リテラルを許可する -/
syntax tree_label := num <|> str <|> char
/-- 基底ケース: `[tree| 42]`などは正しい構文 -/
syntax tree_label : tree
/-- 再帰ステップ -/
syntax tree_label " * " "(" sepBy(tree, " + ") ")" : tree
-- 構文のテスト
#check_failure [tree| 42]
#check_failure [tree| 42 * (13 + 22 + 14)]
/-- `tree_label`に属する構文を`term`に変換する -/
def expandTreeLabel (stx : TSyntax `tree_label) : MacroM (TSyntax `term) :=
match stx with
| `(tree_label| $num:num) => `(term| $num)
| `(tree_label| $str:str) => `(term| $str)
| `(tree_label| $char:char) => `(term| $char)
| _ => throwUnsupported
/-- 再帰的に`tree`構文を`term`に変換する -/
partial def expandTree (stx : TSyntax `tree) : MacroM (TSyntax `term) := do
match stx with
| `(tree| $label:tree_label) =>
let v ← expandTreeLabel label
`(term| Tree.leaf $v)
| `(tree| $label:tree_label * ( $children+* )) =>
let v ← expandTreeLabel label
let children ← children.getElems.mapM expandTree
`(term| Tree.node $v [ $children,* ])
| _ => throwUnsupported
macro_rules
| `([tree| $tree_stx:tree]) => expandTree tree_stx
-- マクロ展開のテスト
#guard
let actual := [tree| 42]
let expected := Tree.leaf 42
actual == expected
#guard
let actual := [tree| "foo" * ("a" + "b" + "c")]
let expected := Tree.node "foo" [Tree.leaf "a", Tree.leaf "b", Tree.leaf "c"]
actual == expected
MLList
Warning
MLListは非推奨になりました。代わりにStd.Iterators.IterMまたはStd.Iterを使用してください。参考: MLList vs IterM
MLList は、遅延評価のリストです。遅延評価とは、大まかには「値が必要になるまで計算を遅らせること」を意味します。ここで、Lean は純粋関数型言語であり、すべての関数は純粋であるため、評価の順序によって式の値は変わらないことに注意してください。
遅延評価のリストは通常のリストと異なり値が必要になるまで評価されることがないので、「～を満たす値を一つ見つける」というタイプの問題を解くのに向いています。以下は、ゴールドバッハ予想（２より大きいすべての偶数は、２つの素数の和で表せる）を検証する関数を実装する例です。
import Batteries.Data.MLList
/-- 遅延評価のリスト -/
abbrev LazyList := MLList Id
/-- 与えられた自然数が素数かどうか判定する。
素朴なアルゴリズムであり、かなり遅い。 -/
def Nat.isPrime (n : Nat) : Bool := Id.run do
if n ≤ 1 then
return false
for d in [2:n] do
if n % d = 0 then
return false
if d ^ 2 > n then
break
return true
-- テスト
#guard
let actual := (List.range 100).filter Nat.isPrime
let expected := [
2, 3, 5, 7, 11,
13, 17, 19, 23, 29,
31, 37, 41, 43, 47,
53, 59, 61, 67, 71,
73, 79, 83, 89, 97
]
actual == expected
/-- ゴールドバッハ予想を検証する関数。
遅延評価ではないリストを使っているので、
`Nat.isPrime` をすべての`1 .. n`に対して計算するなどしており非効率。
-/
def goldbachEager (n : Nat) (_ : n % 2 = 0 := by decide) : Nat × Nat :=
let candidates : List (Nat × Nat) := List.range n
|>.filter Nat.isPrime
|>.filter (fun x => (n - x).isPrime)
|>.map (fun x => (x, n - x))
candidates.head!
/-- ゴールドバッハ予想を検証する関数。
遅延評価のリストを使用しているので、`Nat.isPrime` を必要なときにのみ計算しており高速。-/
def goldbachLazy (n : Nat) (_ : n % 2 = 0 := by decide) : Nat × Nat :=
let candidates : LazyList (Nat × Nat) := MLList.range -- 無限リスト
|>.filter (· < n)
|>.filter Nat.isPrime
|>.filter (fun x => (n - x).isPrime)
|>.map (fun x => (x, n - x))
candidates.head? |>.get!
Nat
Nat は自然数 0, 1, 2, 3, ... を表す型です。「自然数」といったときに 0 を除外する流派も存在しますが、Lean では自然数として 0 を含むことに注意してください。(自然数としてゼロを含まないとしたら、10や120のような数値はどうやって表現するのでしょうか？)
Nat の項は、数値リテラルとして表現することができます。
/- info: 42 : Nat -/
#check 42
Peano の公理
Lean の標準ライブラリにおいて、Nat は inductive コマンドを使って以下のように定義されています。
inductive Nat where
/-- ゼロ -/
| zero : Nat
/-- 後者関数 -/
| succ (n : Nat) : Nat
これは Peano の公理に則ったものです。思い出してみると Peano の公理とは、次のようなものでした:
0は自然数。- 後者関数と呼ばれる関数
succ : ℕ → ℕが存在する。 - 任意の自然数
nに対してsucc n ≠ 0が成り立つ。 succ関数は単射。つまり2つの異なる自然数nとmに対してsucc n ≠ succ mが成り立つ。- 帰納法の原理が成り立つ。つまり、任意の述語
P : ℕ → Propに対してP 0かつ∀ n : ℕ, P n → P (succ n)ならば∀ n : ℕ, P nが成り立つ。
一見すると、上記の Nat を定義するコードは不完全なように見えます。ゼロが自然数であること、後者関数が存在することは明示的に表現されているのでわかりますが、他の条件が表現されているかどうかは一見して明らかではありません。
しかし、実は他の条件も暗黙のうちに表現されています。コンストラクタの像が重ならないこと、コンストラクタが単射であること、帰納法の原理が成り立つことは inductive コマンドで定義した時点で暗黙のうちに保証されているからです。
帰納法の原理の帰結
ところで、Peano の公理の中でも帰納法の原理だけが述語に対する量化を含んでいて複雑ですね。複雑さのために何を意味しているのかわかりづらくなっているので、帰納法の原理から何が導かれるか考えてみます。
たとえば、帰納法の原理から「すべての n : MyNat は .zero か .succ m のどちらかの形である」ことが導かれます。以下の証明では axiom コマンドで MyNat を再構築することで証明しています。これは、inductive コマンドで定義された型に対しては、cases タクティクでコンストラクタに応じた場合分けが自動的にできてしまうからです。
opaque MyNat : Type
/-- ゼロ -/
axiom MyNat.zero : MyNat
/-- 後者関数 -/
axiom MyNat.succ : MyNat → MyNat
/-- 帰納法の原理 -/
axiom MyNat.induction {P : MyNat → Prop}
(h0 : P MyNat.zero) (hs : ∀ n, P n → P (MyNat.succ n)) : ∀ n, P n
example (n : MyNat) : n = MyNat.zero ∨ ∃ m, n = MyNat.succ m := by
-- 述語の定義
let P : MyNat → Prop := fun n => n = MyNat.zero ∨ ∃ m, n = MyNat.succ m
-- `∀ n, P n` を示せばよい。
suffices goal : ∀ n, P n from by
exact goal n
have h0 : P MyNat.zero := by
simp [P]
have hs : ∀ n, P n → P (MyNat.succ n) := by
intro n hn
dsimp [P]
right
exists n
-- 帰納法の原理から従う
intro n
exact MyNat.induction h0 hs n
また、「.succ n = n となる n : MyNat は存在しない」ということも帰納法の原理から導かれます。
inductive MyNat where
| zero : MyNat
| succ (n : MyNat) : MyNat
example (n : MyNat) : MyNat.succ n ≠ n := by
intro h
induction n with
| zero => injection h
| succ n ih =>
exact ih (show n.succ = n from by injection h)
Nat 上の演算
Nat にも四則演算が定義されていますが、少し特殊な定義になっています。
引き算
Nat 上の引き算 m - n は返り値も Nat にならなければならないので、n ≥ m のとき 0 を返すように定義されています。
-- ゼロを下回らないときは整数の引き算と一致する
#guard 32 - 4 = 28
-- ゼロを下回りそうなときはゼロになる
#guard 2 - 32 = 0
#guard 2 + (2 - 4) = 2
example (m n : Nat) (h : n ≥ m) : m - n = 0 := by omega
Nat における引き算は誤解を招きやすいので、注意深く避けた方が良いかもしれません。1
section
/- ## Nat における引き算が誤解を招くものであるという例 -/
variable (x y z n : Nat)
-- 一瞬、Fermat の最終定理が `omega` 一発で示せてしまったかのように見える。
-- しかし `2 - n < 0` となることはありえないので、この仮定は偽で、
-- 偽の仮定があるから証明が通っているだけ。
theorem Fermat (h1 : 2 - n < 0) : x ^ n + y ^ n = z ^ n → (x * y * z = 0) := by
omega
end
割り算
また Nat 上の割り算 m / n はゼロ除算を許すように定義されていて、m / 0 = 0 が成り立ちます。
-- 割り切れるときの商
#guard 32 / 4 = 8
-- 割り切れないときは余りは切り捨て
#guard 32 / 15 = 2
-- ゼロ除算はゼロとして定義されている
#guard 2 / 0 = 0
-- 任意の数について `n / 0 = 0` が成り立つ
example (n : Nat) : n / 0 = 0 := by simp
-
このコード例は Lean の公式 Zulip の Fermat Last theorem by omega というトピックで Anton Mellit さんが示したコード例を参考にしています。 ↩
Option
Option は、失敗するかもしれない計算を表す型です。
Option は帰納型として定義されています。α : Type u に対して、Option α は some a または none のいずれかの形をした項になっています。none は計算が失敗し、値を返せなかったことを表します。
inductive Option.{u} (α : Type u) where
/-- 値が返せないことを意味する。 -/
| none : Option α
/-- `α` 型の値を単に包んだもの。 -/
| some (val : α) : Option α
典型的な使用例
たとえば、配列 xs : Array α に対して、インデックス i の要素は存在するとは限りません。xs の長さよりも i が大きければ、返すべき値がないからです。このため、Lean の標準ライブラリには返り値を Option に包んだ関数が用意されています。
-- インデックス 0 の要素は存在するので取得できる
#guard #[1, 2, 3][0]? = some 1
-- インデックス 3 の要素は存在しないので取得できず、none が返ってくる
#guard #[1, 2, 3][3]? = none
配列やリストなどのコレクション型から要素を取り出す類の操作には、多くの場合返り値が Option に包まれた関数が用意されます。より詳しくは GetElem のページを参照してください。
Functor インスタンス
Option は Functor 型クラスのインスタンスであり、<$> が使用できます。実装上は Option.map が使用されます。
section
/- ## Functor インスタンスの実装を確かめる例 -/
variable {α β : Type}
-- `<$>` は `Option.map` で実装されている
example (x? : Option α) (f : α → β) : f <$> x? = Option.map f x? := by
rfl
end
Option.map は、計算が成功すれば関数を適用し、失敗したら失敗を伝搬します。つまり、Option.map f x? は、x? が some x ならば some (f x) を返し、x? が none ならば none を返します。
section
variable {α β : Type}
-- `Option.map f` は some x を some (f x) に写す
example (x : α) (f : α → β) : Option.map f (some x) = some (f x) := by
rfl
-- `Option.map f` は none を none に写す
example (f : α → β) : Option.map f none = none := by
rfl
end
Prod
Prod は、データを重ね合わせたものを表現しており、Prod A B は A のデータと B のデータの両方を持たされているようなデータの集まりです。A × B と表記されます。
example {A B : Type} : Prod A B = (A × B) := by rfl
#check (Prod.mk 3 "hello" : Nat × String)
(x₁, x₂, .., xₙ) という構文で項を表すことができます。
#guard (3, "hello") = Prod.mk 3 "hello"
カリー化
A × B → C と A → B → C の間に自然な全単射が存在し、同値になることが知られています。
example {A B C : Type} : (A × B → C) ≃ (A → B → C) where
toFun f a b := f (a, b)
invFun f p := f p.1 p.2
left_inv := by
intro f
funext p
cases p
rfl
right_inv := by
intro f
funext a b
rfl
この同値関係を使って A × B 上の関数をばらして定義域から積を消す操作を カリー化 と呼びます。カリー化を行うと部分適用を行いやすくなるので、Lean では関数は常にカリー化することが推奨されます。
Prop
Prop は、命題全体がなす型宇宙です。
命題とは、直観的には「曖昧さなしに真か偽かが定まっているような文章」のことです。たとえば 1 + 1 = 2 は命題です。1 + 1 = 3 も（偽ではありますが）命題です。
#check (1 + 1 = 2 : Prop)
#check (1 + 1 = 3 : Prop)
カリー・ハワード同型対応
Lean では、各命題 P : Prop は再び型になっています。これは通常の数学では考えないことなので慣れないとわかりにくいのですが、言い換えれば命題 P の項というものを考えることができます。
たとえば、1 + 1 = 2 という命題に対して、その項を構成することができます。
-- `1 + 1 = 2` という型を持つ項を、`rfl` で構成できる
#check (rfl : 1 + 1 = 2)
-- 項に名前を付けた
def one_and_one_eq_two : 1 + 1 = 2 := rfl
実は、いま構成した 1 + 1 = 2 という型の項は 1 + 1 = 2 の証明になっています。実際のところ、命題 P : Prop の証明とは、Lean においては項 h : P そのものです。このことを強調するために、 証明項(proof term) という呼び方をすることもあります。
-- さっき構成した証明項で証明ができる
example : 1 + 1 = 2 := one_and_one_eq_two
このように命題を型として、証明を項として実装できるのは、そもそも直観主義論理と型付きラムダ計算の間に カリー・ハワード同型対応(correspondence) が存在するからです。簡単に言えば、論理と計算（プログラム）は出自は全く異なるものの何故か同じ構造を持っており、同じものであると見なせるということです。
命題論理
Bool には真と偽に対応する true と false という項がありますが、Prop では真偽は True と False で表されます。
P Q : Prop があるとき、次のようにして新しい命題を得ることができます。
論理積 P ∧ Q
論理積 P ∧ Q は P と Q がともに成り立つと主張します。「P かつ Q」と読みます。P と Q がともに真であるときに限り真となり、それ以外のときは偽となります。
#guard True ∧ True
#guard (True ∧ False) = False
#guard (False ∧ True) = False
#guard (False ∧ False) = False
Lean では And という名前の構造体として表現されます。
example (P Q : Prop) (hP : P) (hQ : Q) : P ∧ Q := And.intro hP hQ
論理和 P ∨ Q
論理和 P ∨ Q は P または Q の少なくとも一つが成り立つという主張です。「P または Q」と読みます。P と Q がともに偽であるときに限って偽になり、それ以外のときは真となります。
#guard True ∨ True
#guard True ∨ False
#guard False ∨ True
#guard (False ∨ False) = False
Lean では Or という名前の帰納型として表現されます。
example (P Q : Prop) (hP : P) : P ∨ Q := Or.inl hP
含意 P → Q
含意 P → Q は P が成り立つならば Q が成り立つという主張です。「P ならば Q」と読みます。P が真であるのに Q が偽であるときだけ P → Q は偽となり、それ以外のときは P → Q は真となります。特に 前提 P が偽のときは P → Q は Q に関わらず真となります。P を仮定すれば Q が成り立つ、という意味であると解釈しても問題ありません。
#guard (True → True)
#guard (True → False) = False
#guard (False → True)
#guard (False → False)
Lean では含意は関数型 P → Q として表現されます。これは言い換えれば「P の証明項を受け取って Q の証明項を返す関数の型」です。含意専用の型を用意せず、関数型を流用することで含意を表現しているのは、Curry Howard 同型対応を利用しているためです。
example (P Q : Prop) (hP : P) : Q → P := fun _ => hP
否定 ¬ P
否定 ¬ P は、P が成り立たないという主張です。P が偽のとき真になり、P が真のとき偽になります。
#guard (¬ True) = False
#guard (¬ False) = True
Lean では ¬ P は P → False として定義されています。
example (P : Prop) : (¬ P) = (P → False) := rfl
同値 P ↔ Q
同値 P ↔ Q は、P → Q と Q → P がともに成り立つという主張です。読み方は定まっていませんが「P と Q は同値である」などと読みます。P と Q の真偽が一致するときに真となり、そうでないとき偽となります。
#guard True ↔ True
#guard (True ↔ False) = False
#guard (False ↔ True) = False
#guard False ↔ False
Lean での定義は P → Q ∧ Q → P ではありません。Iff という専用の構造体が用意されています。
example (P Q : Prop) (hP : P) (hQ : Q) : P ↔ Q :=
Iff.intro (fun _ => hQ) (fun _ => hP)
Bool と Prop の違い
どちらも言明に対応するため、Bool と似ているようですが以下のような目立つ相違点があります：
-
Propの項はそれ自身が型であるため、Propは型宇宙であると言われます。Boolの項は型ではありません。 -
Propの項はTrueかFalseのどちらであるかを判定するアルゴリズムがあるとは限りません。Boolの項は簡約すれば必ずtrueかfalseになります。
証明無関係
Prop と同様に Type も型宇宙ですが、Prop の宇宙としての振る舞いには Type との大きな差異が２点あります。それが今から説明する証明無関係と非可述性です。
証明にはデータがない
同じ命題 P : Prop の２つの証明項 h1 h2 : P は必ず等しくなります。直観的には、これは「命題の証明はその命題が真であるという以上の情報を持たない」ということです。これを 証明無関係(proof irrelevance) と呼びます。
-- 各命題の証明項はただ一つしかない
theorem my_proof_irrel (P : Prop) (h1 h2 : P) : h1 = h2 := rfl
証明無関係は axiom で導入された公理から従う定理ではなく、Lean の型システムに組み込まれたものであることに注意してください。
/- info: 'proof_irrel' does not depend on any axioms -/
#print axioms proof_irrel
No Large Elimination
証明無関係の重要な帰結のひとつに、「証明から値を取り出すことができるのは、証明の中だけ」というものがあります。この現象は、「Prop は large elimination を許可しない」という言葉で表現されます。1 誤解を恐れずに雑にかみ砕いて言えば、型 T : Sort u が命題宇宙 Prop よりも大きい宇宙に棲んでいる場合（つまり u > 0 の場合）、少数の例外を除き命題 P : Prop からT への関数 P → T を定義することはできないということです。
たとえば次のように、証明の中であれば証明項を cases や rcases で分解して値を取り出すことができます。
-- 同じ存在命題の２通りの証明
-- 2乗すると1になる整数を２通り与えた
theorem foo : ∃ x : Int, x ^ 2 = 1 := by exists 1
theorem bar : ∃ x : Int, x ^ 2 = 1 := by exists -1
def Ok.extract (h : ∃ x : Int, x ^ 2 = 1) : True := by
-- 仮定にある証明項 `h` を分解して
-- x を取り出すことができる
rcases h with ⟨_x, _hx⟩
trivial
しかし、命題の証明という文脈ではなく関数の定義という文脈（つまり返り値の型が命題ではない状況）にすると一転、分解することができなくなります。これは証明無関係の制約によるものです。直観的に言えば、証明には「その命題が成立する」という情報しかないので、そこからデータを生成することはできないということです。
/-
error: Tactic `cases` failed with a nested error:
Tactic `induction` failed: recursor `Exists.casesOn` can only eliminate into `Prop`
h : ∃ x, x ^ 2 = 1
⊢ Int
-/
def Bad.extract (h : ∃ x : Int, x ^ 2 = 1) : Int := by
-- 仮定で存在が主張されている `x` を取得して、
-- 返り値として返すために返り値の型を `Int` に変更するとエラーになる
obtain ⟨x, hx⟩ := h
exact x
仮に、上記の例がエラーにならなかったとすると、証明無関係を利用して矛盾を示すことができてしまいます。
-- 仮に `x` を何らかの方法で取り出せたとすると、次のような関数が得られるはず
opaque extract (h : ∃ x : Int, x ^ 2 = 1) : Int
-- そして、次のような条件を満たすはずである
axiom extract_foo : extract foo = 1
axiom extract_bar : extract bar = -1
-- このとき、以下のように矛盾が得られる
example : False := by
-- 証明無関係により `foo` と `bar` は等しい
have irr : foo = bar := by rfl
-- extract が満たすべき条件から、`1 = -1` が導けてしまう
have : 1 = -1 := calc
_ = extract foo := by rw [extract_foo]
_ = extract bar := by rw [irr]
_ = -1 := by rw [extract_bar]
-- これは矛盾
contradiction
Singleton Elimination
No Large Elimination のルールの例外として、P : Prop が以下の全ての条件を満たすとき、任意の型への関数を定義することができます。
Pの帰納型としてのコンストラクタは１つしかない。Pのコンストラクタの引数はすべてPropか添え字（インデックス）である。
たとえば以下のコードは singleton elimination の例になっています。
-- 証明項 `h : α = β` からデータ `p α → p β` を生成する関数
def castFunc {α β : Type} (p : Type → Type) (h : α = β) : p α → p β := fun x =>
match h with
| rfl => x
h : α = β は、α = β つまり Eq α β の項ですが、Eq は以下のように定義されている帰納型であり、コンストラクタの引数がインデックスです。したがって、まさに上記の条件を満たしていることになります。
universe u
inductive Eq {α : Sort u} : α → α → Prop where
| refl (a : α) : Eq a a
非可述性
もう一つの重要な Prop と Type の差異が 非可述性(impredicativity) です。非可述性について簡単に概略を述べるのは難しいので、まず例から入りましょう。
型 α : Type 上の述語 P : α → Prop があるとき、α で量化された ∀ x : α, P x は再び命題になります。
section
-- 何かの型
variable (α : Type)
-- α 上の述語
variable (P : α → Prop)
-- 量化しても再び命題になる
#check (∀ (x : α), P x : Prop)
end
更に一般的に、α 上の述語 α → Prop に対して量化しても、再び命題になります。
section
variable (α : Type) (x : α) (P : α → Prop)
-- 任意の命題 P に対して P x が成り立つ、という命題
#check (∀ P : α → Prop, P x)
end
上記の挙動は Prop が命題の型であるという直観的解釈と合致しており、自然な挙動だと感じられると思います。しかしながら、「任意の述語 P に対して」と量化して命題を定義することが許されるということは、自分自身に言及するような述語も作ることができるということになります。たとえば、以下の例を考えてみましょう。
-- α を型とする
opaque α : Type
/-- α 上の述語 P に対して、それが簡単なものかそうでないか判定する述語 -/
opaque simple (P : α → Prop) : Prop
/-- `x : α` は「簡単な述語を成り立たせることがない」という述語。
このとき項 `x : α` は「難解である」と呼ぶことにする。 -/
def anti_simple (x : α) : Prop :=
∀ P : α → Prop, simple P → ¬ P x
ここで定義した anti_simple という述語は、α 上の述語全体に対する量化を含んでいますが、自分自身が α 上の述語であるため、自分自身に言及していることになります。いわば定義が循環しています。一般に定義されているものそれ自身が含まれるような定義のことを、非可述的(impredicative) であると呼ぶのですが、これはまさに非可述的な定義になっています。
anti_simple について、まさに anti_simple が自分自身に言及しているということを用いた証明の例を以下に示しておきましょう。
-- 難解な項が存在するならば、`anti_simple` 自身は簡単ではない
example (ex : ∃ x, anti_simple x) : ¬ simple anti_simple := by
-- 難解な項 x を取り出す
obtain ⟨x, ex⟩ := ex
-- anti_simple が簡単だと仮定する
intro (h : simple anti_simple)
-- anti_simple 自身が α 上の述語であることから、
-- anti_simple 自身が簡単ではないことがわかる
have := ex anti_simple h
-- これは矛盾
contradiction
以上が非可述性についての直観的な説明です。より形式的には、型宇宙 U に対して、U が非可述的であるとは ∀ a : U, a の型が U 自身になることをいいます。
-- 命題の宇宙 Prop は非可述的
#check (∀ a : Prop, a : Prop)
-- 型宇宙 Type は非可述的ではなく、可述的
#check (∀ a : Type, a : Type 1)
-
“large elimination” という用語は、The Hitchhiker’s Guide to Logical Verification の 12.2.3 節より拝借しました。 ↩
Queue
Std.Queue は、FIFO キュー(先入れ先出しキュー) です。キューとは、「先に追加した要素が先に取り出される」データ構造のことで、たとえばレジ待ちの行列はキューの例になっています。
import Std
open Std
#check Queue
基本操作
Queue の基本操作を紹介します。
空のキュー
empty で空のキューを作成できるほか、isEmpty 関数で空かどうかを判定できます。empty のことを ∅ と書くこともできます。
#guard (Queue.empty : Queue Nat).isEmpty
#guard (∅ : Queue Nat).isEmpty
要素の追加
enqueue でキューの末尾に要素を追加できます。toArray で内容を配列として取り出せます。
/- info: #[10, 20] -/
#eval (∅ : Queue Nat)
|>.enqueue 10
|>.enqueue 20
|>.toArray
enqueueAll で、複数の要素をキューに追加できます。このとき順序が逆になることに注意してください。
#guard
let q := (∅ : Queue Nat).enqueueAll [10, 20]
q.toArray = #[20, 10]
要素の取り出し
Queue.dequeue? でキューの先頭から要素を取り出せます。キューが空の場合は none を、空でない場合は「取り出した値」と「残りのキュー」のペアを some で包んで返します。
/-- キューから2つの要素を順番に取り出す -/
def popTwo {α : Type} (q : Queue α) : Option (α × α) := do
let (x, q) ← q.dequeue?
let (y, _) ← q.dequeue?
return (x, y)
-- 10 を入れて 20 を入れると、
-- 取り出すときには 10 が出て次に 20 が出てくる
#guard
let q := ((∅ : Queue Nat).enqueue 10).enqueue 20
popTwo q = some (10, 20)
-- 空のキューからは取り出せない
#guard (∅ : Queue Nat).dequeue? = none
内部実装
内部的には Std.Queue は２本の List を持つ構造体として実装されています。
structure Queue.{u} (α : Type u) where
eList : List α := []
dList : List α := []
Std.Queue の２つのフィールドのそれぞれについて説明します。eList は追加された要素を貯めていくリストで、キューに追加された要素は eList の先頭に追加されます。
/- info: { eList := [6, 5, 4, 3], dList := [1, 2] } -/
#eval
let q : Queue Nat := { eList := [5, 4, 3], dList := [1, 2] }
q.enqueue 6
dList は次に取り出す側のリストです。キューから要素を取り出すとき、まず dList の先頭から要素が取り出されます。
/- info: { eList := [5, 4, 3], dList := [2] } -/
#eval
let q : Queue Nat := { eList := [5, 4, 3], dList := [1, 2] }
let (_, q') := q.dequeue?.get!
q'
キューの toArray による出力は (dList ++ eList.reverse).toArray と常に一致します。
example {α : Type} (q : Queue α)
: (q.dList ++ q.eList.reverse).toArray = q.toArray := by
simp [Queue.toArray, List.append_toArray, List.reverse_toArray]
使用例
キューというデータ構造の典型的な応用例として、幅優先探索 (BFS) が挙げられます。
以下は Queue を使って二分木のノード値を幅優先順で列挙する例です。
/-- 二分木 -/
inductive Tree (α : Type) where
| leaf : Tree α
| node (val : α) (left right : Tree α) : Tree α
/-- `Queue` を使って二分木のノード値を幅優先順 (BFS) で列挙する -/
def Tree.bfsValues {α : Type} (t : Tree α) : Array α := Id.run do
-- キューを空の状態で初期化
-- このキューは「これから訪問するべきノード」を管理する
let mut q : Queue (Tree α) := ∅
let mut result : Array α := #[]
-- ルートノードをキューに追加
q := q.enqueue t
-- キューが空になるまでループ
while !q.isEmpty do
let some (v, q') ← q.dequeue?
| unreachable!
match v with
| .leaf =>
-- 何も追加せずに次のループへ
q := q'
continue
| .node val left right =>
result := result.push val
-- 左の木、右の木の順にキューに追加
q := q'.enqueue left |>.enqueue right
return result
/-- テスト用の二分木
```
1
/ \
2 3
/ \
4 5
```
-/
def sampleTree : Tree Nat :=
.node 1 (.node 2 (.node 4 .leaf .leaf) (.node 5 .leaf .leaf)) (.node 3 .leaf .leaf)
-- 幅優先順で列挙すると [1, 2, 3, 4, 5] になる
#guard Tree.bfsValues sampleTree = #[1, 2, 3, 4, 5]
幅優先探索のより非自明な例として、状態遷移を辿って特定の条件を満たす経路が存在するか判定する問題があります。嫉妬深い夫たちの川渡りパズルなどを参照してください。
Quotient
Quotient は、型 α 上の同値関係 r : Setoid α による 商(quotient) を表します。Setoid を受け取って、商型を返します。
商とは
商とは、ある二項関係 r : α → α → Prop によって同じと見なされるものを同一視したものです。たとえば三角形という図形を考えるとき、回転や平行移動させたものを我々は「同じ形」と認識しますが、これは「回転と平行移動で重なり合う」という二項関係に関する商を取っていることになります。
そもそも「２つのリンゴ」や「２つの消しゴム」といった物の集まりに対して「２個の物の集まりである」という共通点を見出すこと自体、商を取る操作です。この場合は、集合に対して「１対１で漏れのない対応が存在する」という二項関係を考えて商を取ったことになります。したがって、自然数という概念を受け入れた時点で、私たちは商を取るというアイデアを受け入れたことになります。
商がいかに受け入れがたく感じられようと、商は基本的で直観に根ざした操作であると言えます。
Quotient に関する基本的な操作
Quotient.mk: 同値類を取る操作
型 α 上の同値関係 r : α → α → Prop があるとき、r によって同じと見なされる項同士のグループのことをその項の 同値類(equivalence class) と呼びます。たとえば、整数全体 ℤ において r x y := 4 ∣ (x - y) と定義すると r は同値関係になりますが、これによる 0 の同値類は 4 で割った余りがゼロになる項の全体、つまり {0, ±4, ±8, ±12, ..} という集合になります。
Leanで項 x : α に対して、同値関係 sr : Setoid α による同値類を取る操作は Quotient.mk で表されます。
variable {α : Type} (sr : Setoid α)
#check (Quotient.mk sr : α → Quotient sr)
元の型 α は、すべての項がどれかの項の同値類に属していて、複数の同値類に属する項はないので、同値類たちの直和として表されます。そこで同値類の全体のことを α 上の同値関係 sr : Setoid α による 商(quotient) と呼びます。Quotient が表すのは、まさにこの商です。同値類を取る操作 Quotient.mk は、商への関数になります。これは恣意的なところがない、構造的に導かれる操作なので、よく 自然な(canonical) 関数であると形容されます。
商の例を挙げると、たとえば時刻がそうです。時刻は 12 で割った余りで同一視する同値関係が入っていて、13 時と 1 時は同じものだと認識されます。また日付は、時刻を時間・分・秒を無視する同値関係で割ることで得られる商です。
Quotient.lift: 関数を商へ持ち上げる操作
α : Type 上の同値関係 r : α → α → Prop と r による α の商 α/r について考えます。ある型 β から商 α/r への関数を得るには、たとえば自然な関数 α → α/r と関数 β → α を合成すれば良いですが、商からの関数を得るにはどうすればいいでしょうか？
α/r の各要素は同値類であるため、α の要素の集まりです。もしも関数 f : α → β が、同値類 as : α/r のどの要素 a ∈ as に対しても同じ値を返すならば、f の定義域を α/r に持ち上げて α/r → β という関数を得ることができます。
理解しにくいと思うのでもう一度別な表現をすると、たとえば２人の人物に対して、そのひとたちの「年齢の和」を考えることはナンセンスです。これは、年齢の和が生まれた年だけによっては決まらず、「今が何年であるか」という情報にも依存してしまうからです。これが、上記で述べた「同値類のどの要素を選ぶかに依存せず同じ値を返す」という前提が成立しない状況の例になっています。逆に、「年齢の差」を考えることはできて、年齢の差を与える関数が作れます。これは、年齢の差がまさに「生年にしか依存しない」からで、生年が同じという同値類で割った商からの関数に持ち上げることができます。
この操作は Lean では Quotient.lift で実現できます。もし α : Type 上の同値関係 sr : Setoid α と関数 f : α → β が与えられていて h : ∀ x, x ≈ y → f x = f y が成り立つならば、商への持ち上げ Quotient.lift f h : Quotient sr → β が得られます。
variable {α β : Type} (sr : Setoid α)
variable (f : α → β) (h : ∀ x y, x ≈ y → f x = f y)
#check (Quotient.lift f h : Quotient sr → β)
Quotient.lift が持ち上げであると言われるのは、元の f と値が同じになるからです。つまり、f' := Quotient.lift f h としたとき f' (Quotient.mk x) = f x が成り立ちます。
variable {α β : Type} (sr : Setoid α)
variable (f : α → β) (h : ∀ x y, x ≈ y → f x = f y)
example : ∀ x, (Quotient.lift f h) (Quotient.mk sr x) = f x := by
intro x
rfl
Quotient.inductionOn: 同値類の代表元を取る
同値類 a : α/r は、r に関して同値な要素の集まりでした。同値類 a に対して、その中から一つ要素を選び出すことを 代表元 を取ると言います。「どれを選んでも r の意味で同じなので、どれかを取ってその同値類の代表とする」というニュアンスです。
これは Lean では Quotient.inductionOn で実現できます。これを使うと、証明の中で「同値類から代表元を取って～」というよくある議論ができます。
variable {α : Type} (sr : Setoid α)
example (a : Quotient sr) : True := by
induction a using Quotient.inductionOn with
| h x =>
-- `x : α` が得られる
guard_hyp x : α
trivial
Quotient.sound: 同値なら商へ送って等しい
型 α の同値関係 sr : Setoid α による商 α/r において、x y : α が同値つまり x ≈ y であるとき、これは商へ送った時には同一視されます。つまり、言い換えれば自然な関数 Quotient.mk sr : α → α/r による像が等しくなっているはずです。
この事実には、Lean では Quotient.sound という名前が付いています。
variable {α : Type} (sr : Setoid α)
variable (x y : α) (h : x ≈ y)
/-- 同値なら商へ送って等しい -/
example : Quotient.mk sr x = Quotient.mk sr y := by
apply Quotient.sound
exact h
Quotient.exact: 商に送って等しいなら同値
Quotient.sound とは逆に、商に送って等しいことから同値であることを導く定理には Quotient.exact という名前がついています。
variable {α : Type} (sr : Setoid α)
variable (x y : α)
/-- 商に送って等しいなら同値 -/
example (h : Quotient.mk sr x = Quotient.mk sr y) : x ≈ y := by
exact Quotient.exact h
使用例
順序なしペア
直積型 A × A 上の二項関係 r : A × A → A × A → Prop を、r (a₁, a₂) (b₁, b₂) := a₁ = b₁ ∧ a₂ = b₂ ∨ a₁ = b₂ ∧ a₂ = b₁ と定義します。これは、順序を無視してペアを同じと見なす同値関係です。
/-- 順序を無視してペアとして同じかどうか判定する同値関係 -/
instance pairRel (A : Type) : Setoid (A × A) where
r := fun p₁ p₂ => p₁.1 = p₂.1 ∧ p₁.2 = p₂.2 ∨ p₁.1 = p₂.2 ∧ p₁.2 = p₂.1
iseqv := by constructor <;> grind
この同値関係による商を考えることで、順序なしのペア型を得ることができます。
/-- 順序なしペア -/
def UnorderedPair (A : Type) := Quotient (pairRel A)
実際、(1, 2) と (2, 1) の UnorderedPair への像は同じペアとして扱われます。
def sample₁ : UnorderedPair Nat := Quotient.mk _ (1, 2)
def sample₂ : UnorderedPair Nat := Quotient.mk _ (2, 1)
example : sample₁ = sample₂ := by
apply Quotient.sound
dsimp [(· ≈ ·), pairRel, instHasEquivOfSetoid, Setoid.r]
grind
自然数の積の商として整数を得る
Lean の標準ライブラリの定義とは異なりますが、Int を自然数の積の商として構成することができます。
Nat × Nat を考えて、最初の要素を「正の部分」、２つめの要素を「負の部分」と考えるのです。つまり (a, b) ↦ a - b という対応を使って整数を構成します。
/-- 自然数を２つペアにしたもの。`(a, b) : PreInt` は `a - b` のつもり -/
abbrev PreInt := Nat × Nat
これは全ての整数を表すことができますが、重複があるので整数そのものになりません。この構成だとたとえば (0, 1) と (1, 2) は同じ整数に対応するので、適切に同一視を入れる必要があります。(x₁, y₁) : PreInt と (x₂, y₂) : PreInt が同じ整数に対応するのは x₁ - y₁ = x₂ - y₂ のときですが、これは x₁ + y₂ = x₂ + y₁ と書き直すことができます。したがって、PreInt 上の２項関係 r を x₁ + y₂ = x₂ + y₁ で定義して r に関する商を取れば、整数を構成できます。
namespace PreInt
/- ## MyIntのための同値関係の構成 -/
/-- PreInt 上の二項関係 -/
def rel (m n : PreInt) : Prop :=
match m, n with
| (m₁, m₂), (n₁, n₂) => m₁ + n₂ = m₂ + n₁
/-- 反射律 -/
theorem rel.refl : ∀ (m : PreInt), rel m m := by
intro (m₁, m₂)
dsimp [rel]
ac_rfl
/-- 対称律 -/
theorem rel.symm : ∀ {m n : PreInt}, rel m n → rel n m := by
intro (m₁, m₂) (n₁, n₂) h
dsimp [rel] at *
omega
/-- 推移律 -/
theorem rel.trans : ∀ {l m n : PreInt}, rel l m → rel m n → rel l n := by
intro (l₁, l₂) (m₁, m₂) (n₁, n₂) hlm hmn
dsimp [rel] at *
omega
/-- `PreInt.rel`は同値関係 -/
theorem rel.equiv : Equivalence rel :=
{ refl := rel.refl, symm := rel.symm, trans := rel.trans }
/-- `PreInt` 上の同値関係 -/
instance srel : Setoid PreInt := ⟨rel, rel.equiv⟩
end PreInt
/-- 整数の定義 -/
def MyInt := Quotient PreInt.srel
MyInt 上にマイナス演算 (- ·) : MyInt → MyInt を定義しましょう。商からの関数は lift で構成することができます。そこでまず PreInt 上で関数を実装し、それを持ち上げる方針を取ります。
def PreInt.neg (m : PreInt) : MyInt := match m with
| (m₁, m₂) => Quotient.mk _ (m₂, m₁)
/-- 整数上のマイナス演算 -/
def MyInt.neg : MyInt → MyInt := Quotient.lift PreInt.neg <| by
intro (m₁, m₂) (n₁, n₂) h
dsimp [PreInt.neg]; apply Quotient.sound
dsimp [(· ≈ ·), PreInt.srel, PreInt.rel, instHasEquivOfSetoid, Setoid.r] at *
omega
instance : Neg MyInt := ⟨MyInt.neg⟩
次に MyInt 上に足し算 (· + ·) : MyInt → MyInt → MyInt を定義しましょう。商からの関数なのでやはり Quotient.lift を使いたくなるのですが、引数が二つあるので Quotient.lift₂ を使う方が良いです。
def PreInt.add (m n : PreInt) : MyInt :=
match m, n with
| (m₁, m₂), (n₁, n₂) => Quotient.mk _ (m₁ + n₁, m₂ + n₂)
/-- 整数上の足し算 -/
def MyInt.add : MyInt → MyInt → MyInt := Quotient.lift₂ PreInt.add <| by
intro (m₁, m₂) (n₁, n₂) (m₁', m₂') (n₁', n₂') h₁ h₂
dsimp [PreInt.add]; apply Quotient.sound
dsimp [(· ≈ ·), PreInt.srel, PreInt.rel, instHasEquivOfSetoid, Setoid.r] at *
omega
instance : Add MyInt := ⟨MyInt.add⟩
StateM
StateM は、状態を変更するような計算を表現するモナドです。
StateM σ α で、「型 σ を持つ状態のデータを読み書きしながら α 型の項を返す計算」を表します。
たとえば、フィボナッチ数列の n 番目の値を計算しながら、計算過程で生成された中間結果を記録していくような関数は次のように書けます。
import Lean
open Std
/-- フィボナッチ数列の計算過程ログ -/
structure FibLog where
/-- `n`番目のフィボナッチ数列の値を記録する辞書。
デフォルト値として`0`番目と`1`番目の値を持たせてある。
-/
dict : HashMap Nat Nat := HashMap.ofList [(0, 0), (1, 1)]
deriving Repr
/-- 今までの計算結果を記録しながら、フィボナッチ数列の`n`番目の値を計算する -/
def StateM.fibonacci (n : Nat) : StateM FibLog Nat := do
match n with
| 0 => return 0
| 1 => return 1
| n + 2 => do
-- 今までの計算結果を取得しようと試みる
let dict := (← get).dict
match dict[n + 2]? with
| some y =>
-- すでに計算済みならばそれを返す
return y
| none =>
-- まだ計算していなければ再帰的に計算する
let x1 ← fibonacci (n + 1)
let x2 ← fibonacci n
let y := x1 + x2
-- 計算結果をログに記録する
modify fun log => { log with dict := log.dict.insert (n + 2) y }
return y
/-- `n`番目のフィボナッチ数列を計算する -/
def StateM.nthFib (n : Nat) : Nat :=
-- 空の状態（つまりデフォルト値で埋められた状態）から出発して、
-- 計算を実行して値を取り出す
(StateM.fibonacci n).run' {}
/-- `0`から`n`番目までのフィボナッチ数列を計算する -/
def StateM.seqFib (n : Nat) : List Nat :=
-- 空の状態から出発して、計算を実行した後、
-- その時点で状態として保持している値を取り出す
let (_val, log) := (StateM.fibonacci n).run {}
Prod.snd <$> log.dict.toList
#guard StateM.nthFib 22 = 17711
#guard StateM.seqFib 10 = [0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55]
String
String は文字列を表す型です。次のように、文字を表す型 Char のリストに変換したり、その逆を行ったりすることができます。
-- `Char` のリストから `String` を構築する
#guard String.ofList ['H', 'e', 'l', 'l', 'o'] = "Hello"
-- `String` を `Char` のリストに変換する
#guard "Hello".toList = ['H', 'e', 'l', 'l', 'o']
文字列結合
String.append を使って文字列を結合することができます。この関数は Append 型クラスのインスタンスになっているので、++ という記号で利用できます。
#guard String.append "Hello, " "world!" = "Hello, world!"
#guard "Hello, " ++ "world!" = "Hello, world!"
文字列の長さ
文字列の長さは String.length 関数で取得することができます。
#guard "Hello".length = 5
#check List.length
String.length を素朴に実装すると、
- 文字列を
List Charに変換する List.lengthを使って長さを求める
という手順になるかと思います。n 個の要素を持つ xs : List α に対して長さを求めようとすると、先頭から順に要素をたぐっていくので n に比例する時間がかかります。したがって String.length は長い文字列に対しては遅くなりそうなものですが、コンパイラによって実装がオーバーライドされているため、実際には n が大きくても高速に実行できます。
このあたりの背景は、次に示すようにドキュメントコメントに書かれています。
A string is a sequence of Unicode scalar values.
At runtime, strings are represented by dynamic arrays of bytes using the UTF-8 encoding. Both the size in bytes (
String.utf8ByteSize) and in characters (String.length) are cached and take constant time. Many operations on strings perform in-place modifications when the reference to the string is unique.
文字列補間
String 型の変数の「評価した後の値」を文字列に埋め込むことができます。これを 文字列補間(string interpolation) と呼びます。Lean では、これは s! という構文で行うことができます。
def greet := "Hello"
/- info: "Hello, world!" -/
#eval s!"{greet}, world!"
Subtype
Subtype は、大雑把に言えば型 A : Type の部分集合を表します。すなわちある述語 p : A → Prop があったとき、Subtype p は A の項であって p という性質を満たすようなものの全体を表します。
-- 正の数を表す subtype
#check Subtype (fun n => n > 0)
{x : T // p x} という専用の構文が用意されていて、これで Subtype を表すことができます。
-- 正の数を表す subtype
#check { n : Nat // n > 0 }
実行時の性質
型 A の Subtype は実行時には A の項であるかのように振る舞います。言い換えれば、{ x : A // p x} の項は計算の実行時には A の項と同一視されます。これは、Subtype でラップしてもメモリアドレスが変わらないことから確認できます。
unsafe def checkSubtype : IO Unit := do
let x : Nat := 42
let pos : { n : Nat // n > 0} := ⟨x, by omega⟩
if ptrAddrUnsafe x != ptrAddrUnsafe pos then
throw <| .userError "メモリアドレスが異なります。"
#eval checkSubtype
用途
Subtype を使うと、ある型 A が U という型の一部を切り取ったものだということをコードで表現することができます。たとえば、自然数の型 Nat に対して、正の数だけを抜き出して正の整数の型 Pos を定義することを考えてみます。
このとき、Subtype を使わずに Pos を帰納型として以下のように定義することもできるのですが、こうすると Pos と Nat は実装上まったく無関係ということになってしまいます。
inductive Pos where
| one
| succ (n : Pos)
その結果、Nat に対するコンパイラ上の演算の最適化の恩恵を受けることができなくなり、たとえば足し算が非常に遅くなります。
namespace Inductive
/- ## 別の帰納型として正の整数を定義する -/
inductive Pos where
| one
| succ (n : Pos)
def Pos.ofNat (n : Nat) : Pos :=
match n with
| 0 => Pos.one
| 1 => Pos.one
| n + 2 => Pos.succ (Pos.ofNat n)
instance (n : Nat) : OfNat Pos (n + 1) where
ofNat := Pos.ofNat n
def Pos.add (m n : Pos) : Pos :=
match n with
| Pos.one => Pos.succ m
| Pos.succ n' => Pos.succ (Pos.add m n')
instance : Add Pos where
add := Pos.add
end Inductive
namespace Subtype
/- ## Subtype として正の整数を定義する -/
def Pos := { n : Nat // n > 0 }
def Pos.ofNat (n : Nat) : Pos :=
⟨n + 1, Nat.succ_pos n⟩
instance (n : Nat) : OfNat Pos (n + 1) where
ofNat := Pos.ofNat n
def Pos.add (m n : Pos) : Pos :=
⟨m.val + n.val, by
have mp := m.property
have np := n.property
omega
⟩
instance : Add Pos where
add := Pos.add
end Subtype
-- 帰納型として定義すると5倍以上も遅くなってしまう
#reduce (500 : Subtype.Pos) + (500 : Subtype.Pos)
#reduce (500 : Inductive.Pos) + (500 : Inductive.Pos)
Sum
Sum は、データの選択肢を束ねたものを表現しており、Sum A B は A と B のどちらかの値を取るような型です。A ⊕ B と表記されます。
-- `A ⊕ B` と表記される
example {A B : Type} : Sum A B = (A ⊕ B) := by rfl
#check (Sum.inl 42 : Nat ⊕ String)
#check (Sum.inr "hello world" : Nat ⊕ String)
関数 f : A ⊕ B → C は、f₁ : A → C と f₂ : B → C の組に対応するという性質があります。
example {A B C : Type} : (A ⊕ B → C) ≃ (A → C) × (B → C) where
toFun f := (f ∘ Sum.inl, f ∘ Sum.inr)
invFun f p := Prod.casesOn f fun f₁ f₂ =>
match p with
| Sum.inl a => f₁ a
| Sum.inr b => f₂ b
left_inv := by grind
right_inv := by
dsimp [Function.RightInverse, Function.LeftInverse]
intros
rfl
Syntax
Lean.Syntax は、Lean の具象構文木(concrete syntax tree)を表すデータ型です。
具象構文木とは何かを理解するには、私たちがエディタに #eval "Hello" などと入力したとき、Lean がこれを実行する過程で何をしているかを考えるとわかりやすいでしょう。入力された #eval "Hello" は最初は単なる文字列ですが、Lean はまずこれを Lean の文法に照らして合法的なコードであるか解析します。合法ならば次のステップに進むことができますし、そうでなければ「こんなコマンドは知らない」というエラーを表示します。この解析結果を保存する中間的データが具象構文木(Syntax)として表現されます。
なお、ただの文字列を解析して構文木を得ることを構文解析または パース(parse) と呼びます。
定義
Syntax 型は以下のように帰納型として定義されています。
open Lean
/-- 構文木 -/
inductive Syntax where
/-- パース時のエラー。エラーが起こったときにそれ以降のパースが
すべて失敗するということを避けるために用意されている。-/
| missing : Syntax
/-- 構文木のノード -/
| node (info : SourceInfo) (kind : SyntaxNodeKind) (args : Array Syntax) : Syntax
/-- アトム(`atom`)は、構文木の葉の部分を構成する。
`⊕` や `+` などの演算子、`(` や `)` などの括弧がこれにあたる。-/
| atom (info : SourceInfo) (val : String) : Syntax
/-- 識別子(`ident`)は、構文木の葉の部分を構成する。たとえば以下は識別子である。
* `Nat.add` などの関数名
* 式 `1 + x` における変数名 `x`
-/
| ident (info : SourceInfo) (rawVal : Substring.Raw)
(val : Name) (preresolved : List Syntax.Preresolved) : Syntax
パースと構文木
実際に、s : String を解析して Syntax の項を得ることができます。
open Lean Parser
/-- `s : String` をパースして `Syntax` の項を得る。`cat` は構文カテゴリ。-/
def parse (cat : Name) (s : String) : MetaM Syntax := do
ofExcept <| runParserCategory (← getEnv) cat s
-- `true` は識別子としてパースされている。
/-
info: Lean.Syntax.ident
(Lean.SourceInfo.original "".toRawSubstring { byteIdx := 0 } "".toRawSubstring { byteIdx := 4 })
"true".toRawSubstring
`true
[]
-/
#eval parse `term "true"
-- `0` は構文木のノードになっていて、
-- 子としてアトムが一つある。
/-
info: Lean.Syntax.node
(Lean.SourceInfo.none)
`num
#[Lean.Syntax.atom
(Lean.SourceInfo.original "".toRawSubstring { byteIdx := 0 } "".toRawSubstring { byteIdx := 1 })
"0"]
-/
#eval parse `term "0"
見ての通りすぐに複雑怪奇になってしまうので、以降は表示を簡略化しましょう。Syntax は ToString のインスタンスを実装しており、これは SourceInfo などを含まないシンプルな表現をしてくれるので、それを利用します。
-- 文字列として表示するとかなり簡略化される
/- info: `true -/
run_meta IO.println (← parse `term "true")
/- info: (num "0") -/
run_meta IO.println (← parse `term "0")
/- info: (term!_ "!" `false) -/
run_meta IO.println (← parse `term "! false")
-- 識別子はアトムと違って `Name` を受け取るのでバッククォートがつく
/- info: `Nat.zero -/
run_meta IO.println (← parse `term "Nat.zero")
もちろん項(term)以外の構文カテゴリについてもパースを行うことができます。あと少しだけ例を見ましょう。
-- コマンドをパースする例
/- info: (Command.eval "#eval" (str "\"hello\"")) -/
run_meta IO.println (← parse `command "#eval \"hello\"")
-- タクティクをパースする例
-- 木構造が現れている
/-
info: (Tactic.«tactic_<;>_» (Tactic.constructor "constructor") "<;>" (Tactic.intro "intro" [`h]))
-/
run_meta IO.println (← parse `tactic "constructor <;> intro h")
Tactic
Lean.Elab.Tactic.Tactic 型の項は、タクティクの内部実装を表現しています。タクティクとは証明の状態を操作する関数であり、Tactic 型は Syntax → TacticM Unit という関数型そのものです。
import Lean
open Lean Elab Tactic in
example : Tactic = (Syntax → TacticM Unit) := by rfl
Tactic 型からタクティクを作る
Tactic 型の項からはタクティクを定義することができます。
tada で証明終了をお祝いするタクティク
done タクティクの派生として、ゴールがなくなったら 🎉 でお祝いするタクティクを作ることができます。
import Lean
syntax (name := tada) "tada" : tactic
open Lean Elab Tactic Term
@[tactic tada]
def evalTada : Tactic := fun _stx => do
-- 現在の未解決のゴールを取得する
let goals ← getUnsolvedGoals
-- 未解決のゴールがある場合
unless goals.isEmpty do
reportUnsolvedGoals goals
throwAbortCommand
logInfo "🎉 おめでとうございます！証明完了です！"
/- info: 🎉 おめでとうございます！証明完了です！ -/
example : True := by
trivial
tada
trivial タクティクの制限版
trivial タクティクの機能を制限し、True というゴールを閉じる機能だけを持つタクティクを構成することができます。1
import Qq
import Batteries
/-- True というゴールを閉じる機能だけを持つタクティク -/
syntax (name := myTrivial) "my_trivial" : tactic
open Lean Elab Tactic Qq
@[tactic myTrivial]
def evalMyTrivial : Tactic := fun _stx => do
-- 現在のゴールを取得する
let goal : MVarId ← getMainGoal
try
-- ゴールが `True.intro` で閉じられるか試す
goal.assignIfDefEq q(True.intro)
catch _error =>
-- 失敗した場合はゴールの型を取得してエラーメッセージを表示する
let goalType ← goal.getType
throwError "my_trivialタクティクが失敗しました。ゴールの型は`{goalType}`であって`True`ではありません。"
example : True := by
my_trivial
/- error: my_trivialタクティクが失敗しました。ゴールの型は`False`であって`True`ではありません。 -/
example : False := by
my_trivial
assumption タクティク
assumption タクティクのように、ゴールの証明が既に仮定にあるときにゴールを閉じるタクティクは次のように Tactic 型の関数によって実装できます。
import Batteries
syntax (name := myAssumption) "my_assumption" : tactic
open Lean Elab Tactic
@[tactic myAssumption]
def evalMyAssumption : Tactic := fun _stx => withMainContext do
-- 現在のゴールとローカルコンテキストを取得する
let goal ← getMainGoal
let ctx ← getLCtx
for (decl : LocalDecl) in ctx do
-- ローカル宣言の種類がデフォルトでない場合はスキップする
if decl.kind != .default then
continue
try
-- ゴールにローカル宣言の変数を代入する
goal.assignIfDefEq decl.toExpr
-- 成功したら終了
return
catch _ =>
-- 失敗しても無視して次の候補に進む
pure ()
throwError "my_assumptionタクティクが失敗しました。"
example {P : Prop} (hP : P) : P := by
my_assumption
/- error: my_assumptionタクティクが失敗しました。 -/
example {P Q : Prop} (hP : P) : Q := by
my_assumption
And 専用 constructor
constructor タクティクの機能を制限し、And 型のゴールを分割する機能だけを持つタクティクを構成する例を示します。2
import Qq
/-- ゴールが`P ∧ Q`という形をしていたら、分解してそれぞれ別ゴールにする -/
syntax (name := andConstructor) "and_constructor" : tactic
open Lean Elab Tactic Qq Meta
/-- ゴールが `P ∧ Q` の形をしているかチェックして、
`P ∧ Q` の形をしていたら `P` と `Q` をそれぞれ返す -/
def extracetAndGoals : TacticM (Q(Prop) × Q(Prop)) := do
have tgt : Q(Prop) := ← getMainTarget -- 右辺でQqを使用していないのでhaveを使う
match tgt with
| ~q($p ∧ $q) => return (p, q)
| _ => throwError "ゴールが `P ∧ Q` の形ではありません。"
@[tactic andConstructor]
def evalAndConstructor : Tactic := fun _stx => withMainContext do
-- ゴールを取得する
let goal ← getMainGoal
have (p, q) := ← extracetAndGoals
-- 新しいメタ変数（ゴール）を作成する
have left : Q($p) := ← mkFreshExprSyntheticOpaqueMVar p (tag := `left)
have right : Q($q) := ← mkFreshExprSyntheticOpaqueMVar q (tag := `right)
-- ゴールを`?_ ∧ ?_`の形にはめる
goal.assign q(And.intro $left $right)
-- アクティブなゴールのリストは自動的には更新されないので、
-- ２つのゴールを作ったことを宣言する
replaceMainGoal [left.mvarId!, right.mvarId!]
example : True ∧ True := by
and_constructor
· trivial
· trivial
Iff 専用 constructor
constructor タクティクの機能を制限し、P ↔ Q という形のゴールを分解する機能だけを持つタクティクを構成する例を示します。3
import Qq
/-- ゴールが`P ↔ Q`という形をしていたら`P → Q`と`Q → P`という二つのゴールに分解する -/
syntax (name := iffConstructor) "iff_constructor" : tactic
open Lean Elab Tactic Qq Meta
/-- ゴールが `P ↔ Q` の形をしているかチェックして、
`P ↔ Q` の形をしていたら `P` と `Q` をそれぞれ返す -/
def extractIffGoals : TacticM (Q(Prop) × Q(Prop)) := do
have tgt : Q(Prop) := ← getMainTarget -- 右辺でQqを使用していないのでhaveを使う
match tgt with
| ~q($p ↔ $q) => return (p, q)
| _ => throwError "ゴールが `P ↔ Q` の形ではありません。"
@[tactic iffConstructor]
def evalIffConstructor : Tactic := fun _stx => withMainContext do
-- ゴールを取得する
let goal ← getMainGoal
have (p, q) := ← extractIffGoals
-- 新しいメタ変数（ゴール）を作成する
have mp : Q($p → $q) := ← mkFreshExprSyntheticOpaqueMVar q($p → $q) (tag := `mp)
have mpr : Q($q → $p) := ← mkFreshExprSyntheticOpaqueMVar q($q → $p) (tag := `mpr)
-- ゴールを`?_ ↔ ?_`の形にはめる
goal.assign q(Iff.intro $mp $mpr)
-- アクティブなゴールのリストは自動的には更新されないので、
-- ２つのゴールを作ったことを宣言する
replaceMainGoal [mp.mvarId!, mpr.mvarId!]
example : True ↔ True := by
iff_constructor
· simp
· simp
A₁ ∧ A₂ ∧ ... ∧ Aₙ という形の前提から ⊢ Aᵢ を示すタクティク
h : A₁ ∧ A₂ ∧ ... ∧ Aₙ という形の前提から ⊢ Aᵢ を示すタクティクを実装する例を示します。これは引数を持つタクティクの例であるとともに、再帰的な挙動をするタクティクの例でもあります。4
import Qq
import Batteries
/-- `A₁ ∧ A₂ ∧ ... ∧ Aₙ` という形の前提から `⊢ Aᵢ` を示すタクティク -/
syntax (name := destructAnd) "destruct_and" ident : tactic
open Lean Elab Tactic Qq Meta
/-- 証明項 `hp : Q` が `A₁ ∧ A₂ ∧ ... ∧ Aₙ` の形の命題の証明であるかチェックして、
再帰的に分解して現在のゴールと一致する証明が得られるかを確認し、
もし一致すればゴールを閉じて`true`を返す。一致しなければ`false`を返す。 -/
partial def destructAndExpr (P : Q(Prop)) (hp : Q($P)) : TacticM Bool := withMainContext do
-- 今証明を構成しようとしている命題を取得
have target : Q(Prop) := ← getMainTarget
-- `P` が `target` と一致しているなら、示すべきゴールの証明が得られたことになる。
if (← isDefEq P target) then
let goal ← getMainGoal
goal.assignIfDefEq hp
return true
match P with
| ~q($Q ∧ $R) =>
let hq : Q($Q) := q(And.left $hp)
let success ← destructAndExpr Q hq -- 再帰的にチェック
-- 成功していたら早期リターン
if success then
return true
let hr : Q($R) := q(And.right $hp)
destructAndExpr R hr -- 再帰的にチェック
| _ => return false
@[tactic destructAnd]
def evalDestructAnd : Tactic := fun stx => withMainContext do
match stx with
| `(tactic| destruct_and $h) =>
let h ← getFVarFromUserName h.getId
let success ← destructAndExpr (← inferType h) h
if !success then
failure
| _ => throwUnsupportedSyntax
example (a b c d : Prop) (h : a ∧ b ∧ c ∧ d) : a := by
destruct_and h
example (a b c d : Prop) (h : a ∧ b ∧ c ∧ d) : b := by
destruct_and h
example (a b c d : Prop) (h : a ∧ b ∧ c ∧ d) : c := by
destruct_and h
example (a b c d : Prop) (h : a ∧ b ∧ c ∧ d) : d := by
destruct_and h
example (a b c : Prop) (h : a ∧ b ∧ c) : a ∧ b := by
constructor <;> destruct_and h
A₁ ∧ ⋯ ∧ Aₙ という形の前提を分解して新しい仮定として追加するタクティク
再帰的な挙動をするタクティクの例として、さらに A₁ ∧ A₂ ∧ ... ∧ Aₙ という形の前提を分解して新しい仮定として追加するタクティクを実装する例を示します。5
import Qq
import Batteries
/-- 仮定にある `A₁ ∧ A₂ ∧ ... ∧ Aₙ` を分解する -/
syntax (name := casesAnd) "cases_and" : tactic
open Lean Elab Tactic Meta Qq Parser Term
/-- 命題`P`とその証明項`hp`を受け取り、`P = Q₁ ∧ Q₂ ∧ ... ∧ Qₙ` という形だった場合には
各`Qᵢ`とその証明項`hqᵢ`のリストを返す。その形でなければ単に`[(P, hp)]`を返す。-/
partial def casesAndAux (P : Q(Prop)) (hp : Q($P)) : TacticM (List ((P : Q(Prop)) × Q($P))) := do
if (← inferType hp) != P then
throwError "型の不一致エラー: {hp} は {P} の証明ではありません"
if let ~q($Q₁ ∧ $Q₂) := P then
let hq₁ : Q($Q₁) := q(And.left $hp)
let hq₂ : Q($Q₂) := q(And.right $hp)
return (← casesAndAux Q₁ hq₁) ++ (← casesAndAux Q₂ hq₂)
else
return [⟨P, hp⟩]
@[tactic casesAnd]
def evalCasesAnd : Tactic := fun _stx => withMainContext do
-- 現在のローカルコンテキストを取得する
let ctx ← getLCtx
for (decl : LocalDecl) in ctx do
-- ローカル宣言の種類がデフォルトでない場合はスキップする
if decl.kind != .default then
continue
-- `hp : P` (ただし `P : Prop`)というタイプのローカル宣言に絞り込む
-- `A : Prop` のようなローカル宣言は除外する
let declType := decl.type
let declTypeType ← inferType declType
if ! declTypeType.isProp then
continue
-- 宣言し直す
have P : Q(Prop) := declType
have hp : Q($P) := decl.toExpr
trace[debug] m!"対象となるローカル宣言を見つけました: {hp} : {P}"
let proofList ← casesAndAux P hp
for (⟨Q, hq⟩, idx) in proofList.zipIdx do
let hypName := decl.userName.appendAfter s!"_{idx}"
trace[debug] m!"新しい仮定を追加: {Q}"
evalTactic <| ← `(tactic| have $(mkIdent hypName) : $(← Q.toSyntax) := $(← hq.toSyntax))
-- デバッグ出力をOFFにする
set_option trace.debug false
/-
trace: a b c d : Prop
h : a ∧ (b ∧ c) ∧ d
h_0 : a
h_1 : b
h_2 : c
h_3 : d
⊢ b ∧ d
-/
example (a b c d : Prop) (h : a ∧ (b ∧ c) ∧ d) : b ∧ d := by
cases_and
trace_state -- 現在の infoview の状態を表示
constructor <;> assumption
exact? タクティク
ゴールを直接閉じることができる定理を探すタクティクとして exact? タクティクがあります。これに相当する（しかしかなり原始的で低性能な）ものを自前で実装する例を示します。6
import Lean
-- `my_exact?` というタクティックの構文を定義する（構文として `my_exact?` を認識させる）
syntax (name := myExact?) "my_exact?" : tactic
open Lean Elab Tactic in
-- `my_exact?` タクティックの実装を定義する
@[tactic myExact?]
def evalMyExact? : Tactic := fun _stx => do
-- 現在の環境（定理などが格納されている）を取得
let env ← getEnv
-- 環境中の定数を取得し、以下の条件でフィルターする：
-- 1. unsafe な定数ではない
-- 2. 種類が axiom か thm（定理）のもの
let theorems : List Name := SMap.toList (Environment.constants env)
|>.filter (fun (_name, info) => ! ConstantInfo.isUnsafe info)
|>.filterMap (fun (name, _info) => do
let kind ← getOriginalConstKind? env name
match kind with
| .axiom | .thm => name
| _ => none
)
-- 条件を満たす定理に対して順に試す
for name in theorems do
try
-- 名前を構文ノードに変換
let nameStx := mkIdent name
-- `apply name <;> assumption` を構文的に展開・実行する
evalTactic <| ← `(tactic| apply $nameStx <;> assumption)
-- 成功したらログを出力し、タクティックの実行を終了する
logInfo m!"Applied {name} successfully."
return
catch _ =>
-- 失敗しても続行（次の定理を試す）
continue
-- どの定理も適用できなかった場合はタクティックとして失敗を返す
failure
set_option maxHeartbeats 500000 in
-- 使用例
example (x y : Nat) (h : x = y) : y = x := by
my_exact?
-
このコード例を書くにあたり lean-tactic-programming-guide を参考にしました。 ↩
-
このコード例を書くにあたり lean-tactic-programming-guide を参考にしました。 ↩
-
このコード例を書くにあたり Metaprogramming in Lean 4 を参考にしました。 ↩
-
このコード例を書くにあたり The Hitchhiker’s Guide to Logical Verification を参考にしました。 ↩
-
このコード例を書くにあたり The Hitchhiker’s Guide to Logical Verification の演習問題を参考にしました。 ↩
-
このコード例を書くにあたり The Hitchhiker’s Guide to Logical Verification を参考にしました。 ↩
Type
Type は、型がなす型宇宙です。ここで型宇宙とは、項が再び型であるような型のことをいいます。
たとえば Nat や Int, Bool や String などが Type の項になっています。
#check (Nat : Type)
#check (Int : Type)
#check (Bool : Type)
#check (String : Type)
可算無限個の宇宙
では Type 自身の型はどうなっているのでしょうか？Type は明らかに型なので Type : Type となっているのでしょうか。実際に試してみると、Type の型は Type 1 です。
#check (Type : Type 1)
そして Type 1 の型は Type 2 であり、また Type 2 の型は Type 3 であり…と無限に続いていきます。
#check (Type 1 : Type 2)
#check (Type 2 : Type 3)
universe u
#check (Type u : Type (u+1))
Type は実は Type 0 の略記になっています。
example : Type = Type 0 := rfl
また、Prop と Type u という２つの宇宙の系列をまとめて書き表すために Sort u という書き方があります。 Prop = Sort 0 で、以降順に宇宙レベルが上がっていきます。
example : Sort 0 = Prop := rfl
example : Sort 1 = Type 0 := rfl
example : Sort 2 = Type 1 := rfl
example : Sort (u + 1) = Type u := rfl
なぜ Type : Type ではないのか
何故このような仕様になっているのでしょうか。可算無限個の宇宙を用意するよりも Type : Type とした方が簡単ではないでしょうか？実は、Type : Type となるような型理論を採用すると矛盾が生じてしまいます。
これは ジラールのパラドックス(Girard’s paradox) と呼ばれる有名な結果です。しかしジラールのパラドックスを直接説明しようとすると準備が多く必要になるので、ここではジラールのオリジナルの議論を追うことはせず、代わりに濃度による簡潔な議論を紹介します。
以下証明を説明します。仮に Type が Type の項だったとしましょう。このとき α := Type とすることにより、ある Type の項 α を選べば、全射 f : α → Type を作れることがわかります。したがって、任意の型 α : Type に対して関数 f : α → Type が全射になることはありえないことを示せばよいことになります。
これはカントールの定理の単射バージョンに帰着して示すことができます。
open Function
theorem not_surjective_Type {α : Type} (f : α → Type) : ¬ Surjective f := by
-- f が全射だと仮定する
intro h
-- f から依存ペア型を構成する
let T : Type := (a : α) × f a
-- f は全射なので、Set T の逆像の要素が存在する
let ⟨x, hx⟩ := h (Set T)
-- 関数 `g : Set T → T` を構成できる
let g : Set T → T := fun s ↦ ⟨x, cast hx.symm s⟩
-- このとき、g は単射になる
have hg : Injective g := by
intro s t h
grind
-- これはカントールの定理に反する
exact cantor_injective g hg
Vector
Vector は、長さが固定された配列です。標準ライブラリにおいて、次のように定義されています。
/-- `Vector α n` はサイズが `n` であるような `Array α` -/
structure Vector.{u} (α : Type u) (n : Nat) where
/-- 地の配列 -/
toArray : Array α
/-- 配列のサイズ -/
size_toArray : toArray.size = n
deriving Repr, DecidableEq
Vector の要素を定義するには、#v[a₁, a₂, .. aₙ] のように書きます。
#check #v[1, 2, 3]
用途
典型的な使用場面は、配列に対してその配列の長さが一定であることを保証したい場合です。
たとえば、配列の順番を逆にする関数を定義したいとします。「配列の要素を順に交換していくことで逆順にする」というアルゴリズムで実装してみます。
/-- 配列を逆順にする関数。
インデックスアクセスの妥当性証明を `swapIfInBounds` を使うことで回避している。 -/
def Array.myReverse₁ {α : Type} (arr : Array α) : Array α := Id.run do
let mut array := arr
let size := array.size
for i in [0 : size / 2] do
array := array.swapIfInBounds i (size - 1 - i)
return array
#guard Array.myReverse₁ #[1, 2, 3, 4, 5] = #[5, 4, 3, 2, 1]
#guard Array.myReverse₁ (#[] : Array Nat) = #[]
ここで Array.swapIfInBounds ではなくて Array.swap を使用すると、インデックスアクセスの妥当性の証明が必要になります。しかし、let mut で宣言した配列の長さは変わってしまう可能性があるので、この証明は困難です。
def Array.myReverse₂ {α : Type} (arr : Array α) : Array α := Id.run do
let mut array := arr
-- `array` は可変な配列なので、
-- `size = array.size` が常に成り立つとは限らない！
let size := array.size
for h : i in [0 : size / 2] do
-- これは証明できる
have : i < size := by
dsimp [(· ∈ ·)] at h
grind
have : i < array.size := by
-- `size = array.size` が成り立つことを Lean に伝える手段が難しくて
-- 証明が回らない
dsimp [(· ∈ ·)] at h
fail_if_success grind
sorry
-- 同様に証明できない
have : size - 1 - i < array.size := by
dsimp [(· ∈ ·)] at h
fail_if_success grind
sorry
array := array.swap i (size - 1 - i)
return array
そこで Array の代わりに Vector を使用すると、配列の長さの情報が型レベルで固定されるので、Lean に「for によるループの間、配列のサイズが変わらない」ことを伝えることができ、インデックスアクセスの妥当性が容易に証明できるようになります。
def Array.myReverse₃ {α : Type} (arr : Array α) : Array α := Id.run do
-- 配列ではなくて可変なベクトルとして保持する
-- 可変変数だろうと型は変えられないので、長さが変わらないことを Lean に伝えられる
let mut vec := arr.toVector
let size := vec.size
for h : i in [0 : size / 2] do
-- 証明が通るようになった！
have : i < vec.size := by
dsimp [(· ∈ ·)] at h
grind
have : size - 1 - i < vec.size := by grind
vec := vec.swap i (size - 1 - i)
-- ベクトルを配列に戻して返す
return vec.toArray
do 構文
while
while は、「ある条件が成り立っている間、同じ処理を繰り返す」ための構文です。while P do B という構文で用いて、条件 P が成り立つ間、命令 B を繰り返し実行します。
/-- 1から5までの数字をリストに詰めて返す -/
def packOneToFive : List Nat := Id.run do
let mut result := []
let mut n := 1
while n ≤ 5 do
result := result ++ [n]
n := n + 1
return result
#guard packOneToFive = [1, 2, 3, 4, 5]
while ループと停止性
while ループを使うと、停止するとは限らない計算が（停止性の証明を与えてもいないのに）書けてしまいます。たとえば以下は、述語 P : Nat → Bool を成り立たせる最小の自然数を探してくる関数の例です。
/-- 述語 `P : Nat → Bool` を成り立たせる最小の自然数を返す。
`P` が成り立つ要素が存在する保証はないので停止するとは限らない。 -/
def searchMinExample (P : Nat → Bool) : Nat := Id.run do
let mut n := 0
while !P n do
n := n + 1
return n
#guard searchMinExample (fun n => n > 5) = 6
これは暗黙的に partial で修飾された関数を利用していることを想像させますが、実際には違います。while ループで書かれた関数について何かを証明することは可能です。
/-- 明らかに停止するし明らかに`0`しか返さない関数 -/
def trivialWhile : Nat := Id.run do
let mut m := 0
while false do
m := m + 1
return m
-- `while false` の本体は実行されないので、結果は初期値のままになる
example : trivialWhile = 0 := by
unfold trivialWhile
simp only [ForIn.forIn]
rw [Lean.Loop.forIn_eq_of_monadTail]
simp
タクティク
タクティクは、Lean において証明を対話的に行ったり自動化したりすることを可能にするものです。
なお本書は全部のタクティクを網羅していません。Mathlib の全タクティクのリストが必要であれば Mathlib4 Help を参照してください。
よく使うタクティク早見表
Lean で利用可能なタクティクは多岐にわたるので、ここによく使うタクティクの早見表を載せておきます。
関数と等式系
| タクティク | 用途 |
|---|---|
rw | A = B という等式を使って書き換えを行いたいとき |
rfl | A = B という等式を定義に展開することで示したいとき |
congr | f a = f b を a = b に帰着して示したいとき |
calc | 等式を連鎖させて a = b を示したいとき |
命題論理系
| タクティク | 用途 |
|---|---|
exact | 仮定 h : A からゴール ⊢ A を示したいとき |
assumption | 仮定の中にゴールと同じものがあるとき |
intro | A → B を示したいとき |
apply | h : A → B という仮定や命題を使いたいとき |
constructor | A ∧ B や A ↔ B を示したいとき |
obtain | h : A ∧ B という仮定や命題を分解したいとき |
rw | h : A ↔ B という仮定や命題を使って書き換えを行いたいとき |
left | ⊢ A ∨ B というゴールを ⊢ A に帰着したいとき |
right | ⊢ A ∨ B というゴールを ⊢ B に帰着したいとき |
cases | 仮定 h : A ∨ B をもとに場合分けしたいとき |
by_cases | 命題 A について A ∨ ¬ A という場合分けを行いたいとき |
exfalso | ゴールを矛盾を示すことに帰着したいとき |
contradiction | A と ¬ A が両方成り立つことからゴールを閉じたいとき |
have | 証明の途中で補題を立てたいとき |
suffices | ゴールを十分条件に帰着したいとき |
述語論理系
帰納型と帰納法
| タクティク | 用途 |
|---|---|
induction | 帰納法を行いたいとき |
fun_induction | 関数定義に基づいて帰納法を行いたいとき |
cases | 帰納型の値をコンストラクタに基づいて場合分けしたいとき |
fun_cases | 関数定義に基づいて場合分けしたいとき |
ext | 外延性を利用したいとき |
unfold | 名前を定義に展開したいとき |
ライブラリ検索と自動証明
| タクティク | 用途 |
|---|---|
exact? | ゴールを閉じることのできる補題を検索したいとき |
rw? | ゴールを書き換えることのできる補題を検索したいとき |
decide | 計算によって命題の真偽を判定したいとき |
simp | 等式書き換えによる単純化を自動で行いたいとき |
grind | 書き換え・前方推論・後方推論・場合分けを自動で行いたいとき |
try? | とりあえず証明したいとき |
<;>
<;> は、直前のタクティクによって生成されたすべてのサブゴールに対して後続のタクティクを適用することを意味するタクティク結合子です。1
variable (P Q : Prop)
example (hP : P) (hQ : Q) : P ∧ Q := by
constructor <;> assumption
all_goals との違い
<;> は all_goals とよく似た挙動をします。
しかし、<;> と all_goals は完全に同じではありません。
<;> が「直前のタクティクによって生成された全てのサブゴール」に対して後続のタクティクを実行するのに対して、all_goals は「すべての未解決のゴール」に対して後続のタクティクまたはタクティクブロックを実行します。
実際に以下のような例ではその違いが現れます。
variable (P Q R : Prop)
/-- <;> を使用したとき -/
example (hP : P) (hQ : Q) (hR : R) : (P ∧ Q) ∧ R := by
constructor
constructor <;> try assumption
-- まだ示すべきことが残っている
show R
assumption
/-- all_goals を使用したとき -/
example (hP : P) (hQ : Q) (hR : R) : (P ∧ Q) ∧ R := by
constructor
constructor
all_goals
try assumption
-- 証明完了
done
ゴールが途中で閉じられたとき
tac1 <;> tac2 の実行において、tac1 の実行でゴールが閉じられた場合、tac2 は実行されずスキップされます。これは tac1; tac2 とは異なる挙動であることに注意してください。
example (hP : P) : P := by
-- `assumption`の時点でゴールは閉じているが、エラーにならない
-- `simp`の実行は単にスキップされる
assumption <;> simp
example (hP : P) : P := by
-- `tac1; tac2` では、`tac2` を実行しようとする
-- そのため `tac2` が実行できないとエラーになることがある
fail_if_success
assumption; simp
assumption
-
<;>の正式な呼び名はわかりません。linter.unnecessarySeqFocusというリンタが存在するので、ここではseqFocusと仮に呼んでいます。 ↩
ac_rfl
ac_rfl は、結合的(associative)かつ可換(commutative)な演算に対して、結合性と可換性だけから示せる等式を示すタクティクです。
/-- 3次元格子点がなす空間 -/
@[ext]
structure Point : Type where
x : Int
y : Int
z : Int
namespace Point
/-- `Point` 上の足し算 -/
def add (a b : Point) : Point :=
⟨a.x + b.x, a.y + b.y, a.z + b.z⟩
/-- `Point` 上の足し算を `+` で表せるようにする -/
instance : Add Point where
add := add
@[simp]
theorem x_add (a b : Point) : (a + b).x = a.x + b.x := rfl
@[simp]
theorem y_add (a b : Point) : (a + b).y = a.y + b.y := rfl
@[simp]
theorem z_add (a b : Point) : (a + b).z = a.z + b.z := rfl
/-- `Point` 上の足し算は可換 -/
theorem add_comm (a b : Point) : a + b = b + a := by
ext
all_goals
simp
apply Int.add_comm
/-- `Point` 上の足し算は結合的 -/
theorem add_assoc (a b c : Point) : a + b + c = a + (b + c) := by
ext
all_goals
simp
apply Int.add_assoc
-- `ac_rfl` から使えるように、`Std.Commutative` のインスタンスにする
instance : Std.Commutative (α := Point) (· + ·) where
comm := Point.add_comm
-- `ac_rfl` から使えるように、`Std.Associative` のインスタンスにする
instance : Std.Associative (α := Point) (· + ·) where
assoc := Point.add_assoc
-- 可換性と結合性から示せることなら示せる
example (a b c: Point) : (a + b) + c + (a + b) = a + a + b + b + c := by
ac_rfl
end Point
ac_rfl は、上記の構造体 Point の例のように、自分で定義した演算が可換で結合的であることを後から簡単に利用できるようにしておきたいときに役立ちます。ここで @[simp] タグを付けるのは、可換性や結合法則は項の単純化ではないため上手くいかないということに注意してください。
交換法則と ac_rfl
ac_rfl は、可換性と結合性の両方がインスタンスとして登録されていないと使えないことがあります。以下は、可換性だけが登録されているときに、可換性だけで示せそうな命題が示せないという例です。
@[ext]
structure Color : Type where
r : Nat
g : Nat
b : Nat
namespace Color
def add (a b : Color) : Color :=
⟨a.r + b.r, a.g + b.g, a.b + b.b⟩
instance : Add Color where
add := add
/-- `add` は可換 -/
protected theorem add_comm (a b : Color) : a + b = b + a := by
ext <;> apply Nat.add_comm
/-- `add_comm` を `Std.Commutative` に登録する。 -/
local instance : Std.Commutative (α := Color) (· + ·) where
comm := Color.add_comm
example (a b : Color) : a + b = b + a := by
-- ac_rfl を使うことができない
fail_if_success ac_rfl
ext <;> apply Nat.add_comm
end Color
結合法則と ac_rfl
上記のように、ac_rfl は可換性だけで示せることを可換性だけで示せないのですが、結合法則だけで示せることは結合法則だけで示すことができます。
namespace Color
/-- `Color` の足し算は結合的 -/
theorem add_assoc (a b c : Color) : a + b + c = a + (b + c) := by
ext <;> apply Nat.add_assoc
-- エラーになっているので、
-- Commutative のインスタンスはないことが確認できる
/-
error: failed to synthesize
Std.Commutative fun x1 x2 => x1 + x2
Hint: Additional diagnostic information may be available using the `set_option diagnostics true` command.
-/
#synth Std.Commutative (α := Color) (· + ·)
/-- `add_comm` を `Std.Associative` に登録する。 -/
local instance : Std.Associative (α := Color) (· + ·) where
assoc := Color.add_assoc
-- 結合法則だけで示せることは示すことができる
example {a b c : Color} : (a + b) + (c + (b + a)) = a + b + c + b + a := by
ac_rfl
end Color
grind と ac_rfl
なお、grind タクティクでも ac_rfl と同様のことができます。grind タクティクは ac_rfl の完全上位互換かもしれません。
/-- 自然数をイメージした何か -/
opaque MyNat : Type
variable [Add MyNat]
/-- 加法の結合法則 -/
axiom MyNat.add_assoc (a b c : MyNat) : (a + b) + c = a + (b + c)
/-- 結合法則が成り立つことを型クラス経由で登録する -/
instance : @Std.Associative MyNat (· + ·) :=
⟨MyNat.add_assoc⟩
example (a b c d : MyNat) : (a + b) + (c + d) = a + (b + c) + d := by
-- grind で証明することができる
grind only
/-- 加法の交換法則 -/
axiom MyNat.add_comm (a b : MyNat) : a + b = b + a
/-- 交換法則が成り立つことを型クラス経由で登録する -/
instance : @Std.Commutative MyNat (· + ·) :=
⟨MyNat.add_comm⟩
example (a b c : MyNat) : a + b + c = c + b + a := by
-- grind で証明することができる
grind only
aesop
aesop は汎用的かつ強力な自動証明のためのタクティクです。
Automated Extensible Search for Obvious Proofs (自明な証明の拡張可能な自動探索)からその名があります。様々なタクティクやルールを使用しながら最良優先探索を行い、証明を自動で終わらせようとします。
import Aesop -- `aesop` を使用するため
import Mathlib.Tactic.Says
-- 以下 `X` `Y` `Z`を集合とする
variable {X Y Z : Type}
open Function
-- 合成 `g ∘ f` が単射なら、`f` も単射
example {f : X → Y} {g : Y → Z} (hgfinj : Injective (g ∘ f)) : Injective f := by
rw [Injective]
show ∀ ⦃a₁ a₂ : X⦄, f a₁ = f a₂ → a₁ = a₂
-- `simp_all` では示せない
fail_if_success simp_all
-- 示すべきことがまだまだあるように見えるが、一発で証明が終わる
aesop
aesop?
aesop が成功するとき、aesop? に置き換えるとゴールを達成するのにどんなタクティクを使用したか教えてくれます。
example {f : X → Y} {g : Y → Z} (hgfinj : Injective (g ∘ f)) : Injective f := by
rw [Injective]
aesop? says
intro a₁ a₂ a
apply hgfinj
simp_all only [comp_apply]
上記の例により、とくに aesop が実行の過程で simp_all タクティクや intro タクティク等を使用することがわかります。
特に、aesop は simp_all の強化版であるということができます。
実際には aesop は simp_all とは異なり、単純化だけでなく「試行錯誤しながらよい証明を探索する」ということができます。
カスタマイズ
aesop はユーザがカスタマイズ可能です。補題やタクティクを [aesop] 属性で登録することで、証明可能な命題を増やすことができます。
/-- 自然数 n が正の数であることを表す帰納的述語 -/
inductive Pos : Nat → Prop where
| succ n : Pos (n + 1)
example : Pos 1 := by
-- ルールが登録されていないので、`aesop` で示すことはできない
fail_if_success aesop
-- 手動でコンストラクタを `apply` することで証明できる
apply Pos.succ
-- `Pos` 関連のルールを `aesop` に憶えさせる
attribute [aesop safe constructors] Pos
-- `aesop` で証明できるようになった！
example : Pos 1 := by aesop
カスタマイズ方法の詳細を知りたい方はaesopのリポジトリをご参照ください。また、内部のロジックの詳細については論文 Aesop: White-Box Best-First Proof Search for Lean で説明されています。
all_goals
all_goals は、後に続くタクティクをすべてのゴールに対して適用します。
variable (P Q : Prop)
example (hP : P) (hQ : Q) : P ∧ Q := by
-- `P` と `Q` をそれぞれ示せばよい
constructor
-- どちらも仮定から従うので、
-- 両方に `assumption` を適用する
all_goals assumption
all_goals には、タクティクブロックを渡すこともできます。
example {R : Prop} (hnP : ¬ P) : (P → R) ∧ (P → Q) := by
constructor
all_goals
intro h
contradiction
タクティク結合子 <;> によってもほぼ同じことができます。
example (hP : P) (hQ : Q) : P ∧ Q := by
constructor <;> assumption
apply .. at
apply は通常ゴールに対して適用しますが、at を付けてローカルコンテキストの命題などに対して使用するという使い方ができます。
実際にはこの構文は apply と似ているだけで、別のタクティクです。この at がついている構文は通常の apply とは異なり、後方推論ではなく前方推論になります。
import Mathlib.Tactic.ApplyAt
variable (P Q : Prop)
example (h : P → Q) (hP : P) : Q := by
-- `hP` に `h` を適用してしまう
apply h at hP
-- `hP` が書き換わる
guard_hyp hP : Q
assumption
便利な記法以上のものではなく、他のタクティクを利用しても同じことができます。
example (h : P → Q) (hP : P) : Q := by
-- `apply at` は `replace` と同じように動作する
replace hP := h hP
-- `hP` が書き換わる
guard_hyp hP : Q
assumption
apply_assumption
apply_assumption は、ゴールが ⊢ head であるときに、... → ∀ _, ... → head という形の命題をローカルコンテキストから探し、それを用いてゴールを書き換えます。
variable (P Q R : Prop)
example (hPQ : P → Q) : ¬ Q → ¬ P := by
intro hQn hP
-- 矛盾を示したい
show False
-- 自動で `hQn` を適用
apply_assumption
show Q
-- 自動で `hPQ` を適用
apply_assumption
show P
-- 自動で `hP` を適用
apply_assumption
-- 証明終わり
done
タクティクを繰り返すことを指示するタクティク repeat と組み合わせると、「ローカルコンテキストにある仮定を適切に選んで apply, exact することを繰り返し、ゴールを閉じる」ことができます。
example (hPQ : P → Q) (hQR : Q → R) (hQ : P) : R := by
repeat apply_assumption
apply
apply は含意 → をゴールに適用するタクティクです。ゴールが ⊢ Q で、ローカルコンテキストに h : P → Q があるときに、apply h を実行するとゴールが ⊢ P に書き換わります。
variable (P Q : Prop)
/-- `P → Q` かつ `P` ならば `Q` -/
example (h : P → Q) (hP : P) : Q := by
apply h
-- ゴールが `P` に変わっている
show P
exact hP
「十分条件でゴールを置き換える」タクティクであると言えますが、十分条件がローカルコンテキストに存在しない場合は suffices の使用も検討してください。
特殊な用途
仮説から否定を消去する
Lean では否定 ¬ P は P → False として実装されているため、ゴールが ⊢ False であるときに hn : ¬P に対して apply hn とするとゴールを ⊢ P に書き換えることができます。
-- P の否定は、「P を仮定すると矛盾する」ということに等しい
example : (¬ P) = (P → False) := by rfl
example (hn : ¬ P) (hP : P) : False := by
apply hn
show P
exact hP
exact の強力版として
exact の代わりに apply を使うこともできます。
example (hP : P) : P := by
apply hP
example (h : P → Q) (hP : P) : Q := by
apply h hP
また仮定に全称命題の証明 h : ∀ a, P a があってゴールが P a であるとき、exact h は失敗しますが apply h であれば成功します。これは「exact では通りそうで通らないが apply では通る例」であると言えるかもしれません。
variable {α : Type}
example (a : α) (P : α → Prop) (h : ∀ a, P a) : P a := by
-- `exact h` は失敗する
fail_if_success exact h
apply h
舞台裏
一般に、apply は関数適用を逆算するタクティクです。手元に関数 f : A → B があって型 B の型を作りたいとき、A の項を構成すれば f に適用することで B の項が得られる…といった推論を行います。
-- 関数をタクティクを使用して構成する例
def apply {α β : Type} (f : α → β) (a : α) : β := by
apply f
exact a
apply?
apply? は、カレントゴールを apply や refine で変形することができないか、ライブラリから検索して提案してくれるタクティクです。
複数の候補が提案されたときは、どれを選ぶとゴールが何に変わるのか表示されるので、その中から好ましいものを選ぶと良いでしょう。
import Mathlib.Algebra.Algebra.Basic -- 群を使うのに必要
import Mathlib.Tactic.Says -- `says` を使うのに必要
set_option says.verify true
variable (G H : Type)
/-- 群順同型が積を保つという定理 -/
example [Group G] [Group H] (f : G →* H) (a b : G) :
f (a * b) = f a * f b := by
-- `exact MonoidHom.map_mul f a b` を提案してくれる
apply? says exact MonoidHom.map_mul f a b
補足
apply? はあくまで証明を書くときに補助として使うものです。
sorry と同じように、清書した証明に残してはいけません。
sorry と同じと言いましたが、実際 apply? は sorryAx を裏で使用します。
theorem T (x y : Nat) (_: x ≤ y) : 8 ^ x ≤ 16 ^ y := by
apply?
-- `apply?` しただけで `done` が通り、示せているように見える
done
/- info: 'T' depends on axioms: [propext, sorryAx] -/
#print axioms T
assumption
assumption は、現在のゴール ⊢ P がローカルコンテキストにあるとき、ゴールを閉じます。
variable (P Q : Prop)
example (hP: P) (_: Q) : P := by
assumption
assumption による証明は、どの仮定を使うか明示すれば exact で書き直すことができます。assumption を使用することにより、仮定の名前の変更に対してロバストになるほか、意図がわかりやすくなるというメリットがあります。
example (hP: P) (_: Q) : P := by
exact hP
補足
なお、シングル山括弧 ‹› を使って ‹P› と書くと、「命題 P の証明を by assumption で埋めてください」と Lean に指示したことになります。
example (P Q R : Prop) (hp : P) (hq : Q) (h : P → Q → R) : R := by
exact h ‹P› ‹Q›
by_cases
by_cases は排中律を使って場合分けをするタクティクです。by_cases h : P とすると、P が成り立つときと成り立たないときのゴールがそれぞれ生成されます。
example (P: Prop) : ¬¬P → P := by
intro hnnP
-- `P` が成り立つかどうかで場合分けする
by_cases hP : P
case pos =>
-- `P` が成り立つとき
assumption
case neg =>
-- `¬ P` が成り立つとき
contradiction
by_contra
by_contra は、背理法を使いたいときに役立つタクティクです。
ゴールが ⊢ P であるときに by_contra h を実行すると、h : ¬ P がローカルコンテキストに追加されて、同時にゴールが ⊢ False になります。
import Mathlib.Tactic.ByContra
variable (P Q : Prop)
example (h: ¬Q → ¬P) : P → Q := by
-- `P` であると仮定する
intro hP
-- `¬Q` であると仮定して矛盾を導きたい
by_contra hnQ
show False
-- `¬ Q → ¬ P` と `¬Q` から `¬P` が導かれる
have := h hnQ
-- これは仮定に矛盾
contradiction
calc
calc は計算モードに入るためのタクティクです。推移律が成り立つような二項関係をつなげて、一つの証明項を構成します。
-- `calc` そのものは `import` なしで使える
import Mathlib.Tactic -- 大雑把に import する
example (a b : ℝ) : 2 * a * b ≤ a ^ 2 + b ^ 2 := by
-- `a ^ 2 - 2 * a * b + b ^ 2 ≥ 0` を示せばよい
suffices hyp : a ^ 2 - 2 * a * b + b ^ 2 ≥ 0 from by
linarith
-- 少しずつ式変形して示していく
have : a ^ 2 - 2 * a * b + b ^ 2 ≥ 0 := calc
_ = (a - b) ^ 2 := by ring
_ ≥ 0 := by positivity
assumption
≤ と < を calc で繋げることもできます。
/-- 掛け算 `ℝ × ℝ → ℝ` の原点における連続性 -/
example : ∀ x y ε : ℝ, 0 < ε → ε ≤ 1 → |x| < ε → |y| < ε → |x * y| < ε := by
intro x y ε epos ele1 xlt ylt
have : |x * y| < ε := calc
_ = |x| * |y| := abs_mul x y
_ < ε * ε := by gcongr
_ ≤ 1 * ε := by gcongr
_ = ε := by simp
assumption
カスタマイズ
自前で定義した二項関係も、Trans 型クラスのインスタンスにすれば calc で推移律を連鎖させることができます。（ただし、細かいですが、推移律を連鎖させることが必要なければ Trans 型クラスのインスタンスでなくても calc は使えます）
/-- 絶対値が同じであることを表す二項関係 -/
def same_abs (x y : Int) : Prop := x = y ∨ x = - y
-- same_abs のための中置記法の2項演算子を用意する
infix:50 " ≡ " => same_abs
/-- `same_abs` の反射性 -/
@[refl] theorem same_abs_refl (x : Int) : x ≡ x := by
simp [same_abs]
-- メタ変数の番号を表示しないようにする
set_option pp.mvars false
-- `calc` が推移律と関係なければ使えるが...
example (x : Int) : x ≡ x := calc
_ ≡ x := by rfl
-- `calc` で推移律を連鎖させようとすると
-- `Trans` 型クラスのインスタンスではないというエラーになってしまう
/-
error: invalid 'calc' step, failed to synthesize `Trans` instance
Trans same_abs same_abs ?_
Hint: Additional diagnostic information may be available using the `set_option diagnostics true` command.
-/
example {x y z : Int} (hxy : x ≡ y) (h : y = z) : x ≡ z := calc
x ≡ y := hxy
_ ≡ z := by rw [h]
/-- same_abs の推移律 -/
theorem same_abs_trans {x y z : Int} (hxy : x ≡ y) (hyz : y ≡ z) : x ≡ z := by
dsimp [same_abs]
-- hxy と hyz について場合分けをする
rcases hxy with hxy | hxy <;> rcases hyz with hyz | hyz
-- omega でカタをつける
all_goals omega
/-- same_abs を「推移的な二項関係」として登録する -/
instance : Trans same_abs same_abs same_abs where
trans := same_abs_trans
-- same_abs についても calc が使えるようになった！
example {x y z : Int}(hxy : x ≡ y)(h : y = z) : x ≡ z := calc
x ≡ y := hxy
_ ≡ z := by rw [h]
証明が１行で終わらないとき
calc を使用しているとき、証明を見やすく保つためには各行の証明は１行で完結させた方が良いのですが、そうもいかない場合があります。そのような場合、その行の証明項をメタ変数で置き換えると、証明を後回しにすることができます。
example {x y z : Int} (hxy : x = y) (h : y = z) : x = z := by
have : x = z := calc
x = y := ?lem -- この行の証明を後回しにすることができる
_ = z := by rw [h]
assumption
-- 後回しにした証明を埋める
case lem =>
rw [hxy]
cases
cases は場合分けを行うことができるタクティクです。
たとえば、ローカルコンテキストに h : P ∨ Q があるときに cases h とすると、仮定に P を付け加えたゴールと、仮定に Q を付け加えたゴールをそれぞれ生成します。
よく似たタクティクに rcases があります。
example (P Q R : Prop) : P ∨ Q → (P → R) → (Q → R) → R := by
-- `h: P ∨ Q`
intro h hPR hQR
-- `inl` と `inr` の２つのゴールを生成する
cases h with
-- `P` が成り立つ場合
| inl hP =>
exact hPR hP
-- `Q` が成り立つ場合
| inr hQ =>
exact hQR hQ
=> を省略することもできます。
example (P Q R : Prop) : P ∨ Q → (P → R) → (Q → R) → R := by
intro h hPR hQR
cases h with | inl hP | inr hQ
· exact hPR hP
· exact hQR hQ
case タクティク
cases .. with 構文を使わずに、case タクティクを使って次のように書くこともできます。
example (P Q R : Prop) : P ∨ Q → (P → R) → (Q → R) → R := by
intro h hPR hQR
cases h
case inl hP =>
apply hPR
assumption
case inr hQ =>
apply hQR
assumption
舞台裏
帰納型の分解
cases は、実際には論理和に限らず帰納型をコンストラクタに分解することができるタクティクです。
-- 帰納型として定義した例示のための型
inductive Sample where
| foo (x y : Nat)
| bar (z : String)
example (s : Sample) : True := by
-- cases で場合分けを実行できる
cases s
case foo x y =>
trivial
case bar z =>
trivial
論理和を分解することができるのも、Or が次のように帰納型として定義されているからです。
inductive Or (a b : Prop) : Prop where
| inl (h : a)
| inr (h : b)
帰納的述語の分解
特に、帰納的述語も cases タクティクで分解することができます。
仮定がどのコンストラクタから来たものなのかに応じて場合分けをすることができます。
たとえば、以下のように偶数であることを表す帰納的述語を定義したとします。
このとき Even (n + 2) という仮定があれば Even n を結論出来ますが、これは cases タクティクで行うことができます。
/-- 偶数であることを表す帰納的述語 -/
inductive Even : Nat → Prop where
| zero : Even 0
| cons {n : Nat} (ih : Even n) : Even (n + 2)
example (n : Nat) (h : Even (n + 2)) : Even n := by
-- h に対して場合分けを行う。
-- `Even (n + 2)` という仮定はどのコンストラクタから来たか？で場合分けできる。
-- `cases` タクティクはある程度賢いので、
-- `zero` のケースはありえないと判断してスキップできる。
cases h with
| cons ih =>
exact ih
cases’
cases' は cases に似ていますが Lean3 の cases に近い挙動をします。証明を構造化するため、 cases' は使用しないことをお勧めします。
import Mathlib.Tactic.Cases -- `cases'` を使用するために必要
variable {P Q R : Prop}
example : P ∨ Q → (P → R) → (Q → R) → R := by
intro h hPR hQR
-- 場合分けをする
cases' h with hP hQ
· apply hPR hP
· apply hQR hQ
choose
h : ∀ x, ∃ y, P(x, y) が成り立っているときに、choose f hf using h は関数 f : X → Y と f が満たす性質 hf : ∀ x, P(x, f x) のペアを作ります。
import Mathlib.Tactic.Choose
section
-- X,Y は型で P : X → Y → Prop は述語
variable (X Y : Type) (P : X → Y → Prop)
theorem choice (h : ∀ x, ∃ y, P x y) : ∃ f : X → Y, ∀ x, P x (f x) := by
-- 関数 `f : X → Y` を構成する
choose f hf using h
exact ⟨f, hf⟩
end
舞台裏
choose は裏で選択原理 Classical.choice を使用しています。
/- info: 'choice' depends on axioms: [Classical.choice] -/
#print axioms choice
choose が自動で示してくれることを選択原理 Classical.choice を使って手動で示すこともできます。例えば以下のようになります。
section
/- ## choose タクティクを使わずに同等のことをする例 -/
variable (X Y : Type) (P : X → Y → Prop)
example (h : ∀ x, ∃ y, P x y) : ∃ f : X → Y, ∀ x, P x (f x) := by
-- `f` を作る
let f' : (x : X) → {y // P x y} := by
intro x
have hne_st : Nonempty {y // P x y} := by
let ⟨y, py⟩ := h x
exact ⟨⟨y, py⟩⟩
exact Classical.choice hne_st
let f : X → Y := fun x ↦ (f' x).val
-- 上記で作った関数が条件を満たすことを示す
have h₁ : ∀ x, P x (f x) := by
intro x
exact (f' x).property
exists f
end
clear
Lean で複雑な証明を書いていると、ローカルコンテキストに今まで導入した定義や示した補題が溜まってきて見づらくなることがあります。そうしたとき、clear タクティクを使うと指定した項を削除したり、指定した項以外を削除したりといったことができます。
import Mathlib.Tactic.ClearExcept -- `clear` タクティクで「～以外」を指定できるようにする
-- 未使用の変数に対する警告をオフにする
set_option linter.unusedVariables false
variable (P Q R : Prop)
example (hP : P) (hQ : Q) (hR : R) : R := by
-- `hP` と `hR` 以外をローカルコンテキストから削除する
clear * - hR hP
-- `hP` も削除する
clear hP
exact hR
ローカルコンテキストが複雑で見づらいときに、clear で関係があるもの以外を削除して見やすくするといった使い方ができます。
congr
「f₁ = f₂ かつ a₁ = a₂ ならば f₁ a₁ = f₂ a₂」という事実は、等号が合同(congruence)関係であると解釈できますが、congr はこれを使ってゴールを分解するタクティクです。
congr は、⊢ f as = f bs という形のゴールがあったときに、ゴールを ⊢ as = bs に変えます。再帰的に適用されるので、⊢ g (f as) = g (f bs) という形のゴールでも ⊢ as = bs というゴールになります。
variable (X : Type) (x : Int) (f : Int → Int)
example (h : x = 0) : f (2 + x) = f 2 := by
congr
show 2 + x = 2
simp [h]
congr は等号以外の関係は扱えません。等号以外の関係の合同性も扱えるタクティクに gcongr があります。
variable (a b : Int)
example (h : a = b) : a + 1 = b + 1 := by
-- 等号の場合はOK
congr
example (h : a < b) : a + 1 < b + 1 := by
-- 不等号の場合エラーにはならないが何も起こらない
congr
show a + 1 < b + 1
exact Int.add_lt_add_right h 1
再帰の深さの調節
congr が適用される再帰の深さを引数として渡すことができます。これは、主に単に congr とするだけだと「行き過ぎ」になるときに調整する目的で使用されます。
example (g : Int → X) (h : x = 0) (hf : ∀ x, f x = f (- x)) :
g (f (2 + x)) = g (f (- 2)) := by
-- congr の再帰がアグレッシブすぎて上手くいかないことがある
try
congr
-- 分解しすぎた
show 2 + x = -2
-- これでは示すことができない
fail
-- 再帰の深さを数値として指定できる
congr 1
-- ちょうどよい分解になった
show f (2 + x) = f (-2)
simp only [h]
exact hf _
constructor
constructor はゴールを分割するためのタクティクです。
たとえばゴールが ⊢ P ∧ Q であるとき、constructor を実行すると、ゴールが２つのサブゴール ⊢ P と ⊢ Q に分割されます。
variable (P Q : Prop)
example (hP: P) (hQ: Q) : P ∧ Q := by
-- goal が `left` と `right` に分割される
constructor
case left =>
-- `P` を示す
show P
exact hP
case right =>
-- `Q` を示す
show Q
exact hQ
またゴールが同値 P ↔ Q であるとき、constructor を実行するとゴールが２つのサブゴール ⊢ P → Q と ⊢ Q → P に分割されます。
example (x : Nat) : x = 0 ↔ x + 1 = 1 := by
constructor
case mp =>
-- `x = 0 → x + 1 = 1` を示す
show x = 0 → x + 1 = 1
intro hx
rw [hx]
case mpr =>
-- `x + 1 = 1 → x = 0` を示す
show x + 1 = 1 → x = 0
simp_all
補足
このように、constructor は論理積 ∧ や同値 ↔ を「示す」ために使われます。逆にこういった命題が仮定にあって「使用したい」場合は obtain や have などが使用できます。
example (h: P ∧ Q) : P := by
obtain ⟨hp, _hq⟩ := h
exact hp
example (h : P ↔ Q) (hP : P) : Q := by
have ⟨pq, _qp⟩ := h
apply pq
assumption
また論理積や同値性は構造体なので、次の関数も利用できます。
-- 論理積から構成要素を取り出す関数
#check (And.left : P ∧ Q → P)
#check (And.right : P ∧ Q → Q)
-- 同値から構成要素を取り出す関数
#check (Iff.mp : (P ↔ Q) → P → Q)
#check (Iff.mpr : (P ↔ Q) → Q → P)
舞台裏
constructor は一般に、論理積や同値に限らずゴールにある任意の構造体を分解することができます。
structure Sample where
name : String
index : Nat
def getSample (index : Nat) (name : String) : Sample := by
-- constructor タクティクでゴールの構造体をフィールドに分解する
constructor
· exact name
· exact index
contradiction
矛盾からはどんな命題でも証明することができます。これを爆発律(principle of explosion)と呼びますが、contradiction は、この爆発律を使ってゴールを閉じるタクティクです。
ローカルコンテキストに P と ¬ P が同時にあるなど、矛盾した状況にあるときにゴールを閉じます。
variable (P Q : Prop)
-- `False`
example (h : False) : P := by contradiction
-- 明らかに偽な等式
example (h : 2 + 2 = 3) : P := by contradiction
-- 明らかに偽な等式
example (x : Nat) (h : x ≠ x) : P := by contradiction
-- 矛盾する仮定
example (hP : P) (hnP : ¬ P) : Q := by contradiction
爆発律を利用するタクティクには他に exfalso もありますが、あちらはゴールを False に書き換えるだけで、ゴールを閉じるところまでは行いません。
補足
以下の例では、contradiction がいかにも通りそうに見えるのですが、通りません。順序の扱いは contradiction の仕事ではないからです。contradiction にはあまり強力な前処理は備わっていないので、注意が必要です。
variable (n m : ℕ)
example (hl : n ≤ m) (hg : m < n) : False := by
-- 明らかに矛盾に見えるが、 通らない
fail_if_success contradiction
-- 通らない理由は、 `n ≤ m` が `¬ m < n` を意味することを
-- `contradiction` は知らないから。
-- 次のようにして教えてあげると…
have := hl.not_gt
-- `contradiction` が通るようになる
contradiction
contrapose
contrapose は対偶を取るタクティクです。
ローカルコンテキストに h : P という仮定があるときに contrapose h を実行すると、ゴールの否定がローカルコンテキストに追加されて、同時にゴールが ⊢ ¬ P に変わります。
import Mathlib.Tactic
variable {f : Int → Int} {a b : Int}
/-- 自前で定義した単調性 -/
def MyMonotone (f : Int → Int) : Prop :=
∀ ⦃a₁ a₂⦄, a₁ ≤ a₂ → f a₁ ≤ f a₂
example (h : MyMonotone f) (h' : f a < f b) : a < b := by
-- 対偶をとる
contrapose h'
-- ゴールと仮定が否定になって入れ替わる
show ¬f a < f b
simp_all only [not_lt]
apply h
assumption
contrapose!
contrapose! は、対偶をとった後に簡略化を実行します。
example (h : MyMonotone f) (h' : f a < f b) : a < b := by
-- 対偶をとる
contrapose! h'
-- 不等号の否定を逆向きの不等号に簡略化してくれる
show f b ≤ f a
apply h
assumption
conv
conv は、変換モード(conversion mode)に入るためのタクティクです。ゴールや仮定の中の特定の部分式だけを変形するために使います。
/-- 何らかの自然数 -/
opaque x : Nat
axiom hx : x = x + 1
example (a : Nat) : x + a = x + 1 + a := by
-- rw では解決できない
-- なぜかといえば、`rw` はゴール全体にある `x` を書き換えてしまうので
-- 右辺の `x` も `x + 1` に書き換えてしまうから
fail_if_success solve |
rw [hx]
conv =>
-- 等式の左辺 `x + a` に移動する
lhs
-- 左辺の `x` だけを `x + 1` に書き換える
rw [hx]
適宜 Mathlib の conv ガイド や Theorem Proving in Lean4 なども参照してください。
式の中を移動する
conv => と書くと変換モードに入ります。変換モードでは、ゴールは通常の ⊢ ではなく | の形で表示され、現在注目している式を表します。
変換モードの中でのみ使える、式の中を移動するためのタクティクが用意されています。
lhsは二項演算の左辺に移動します。rhsは二項演算の右辺に移動します。congrは現在注目している式の引数へ移動します。rflは何もしません。式をそのままにします。
example (a b c : Nat) : a * (b * c) = a * (c * b) := by
conv =>
-- 等式の左辺 `a * (b * c)` に移動する
lhs
-- `a` と `b * c` の2つに分ける
congr
-- `a` は書き換えない
· rfl
-- `b * c` だけを `c * b` に書き換える
· rw [Nat.mul_comm]
パターンで場所を指定する
手で lhs や congr を使って移動する代わりに、conv in パターン => ... と書くことで書き換えたい部分式を直接指定できます。
プレースホルダ _ も使えます。
example (a b c : Nat) : a * (b * c) = a * (c * b) := by
conv in b * c =>
rw [Nat.mul_comm b c]
example (a b c : Nat) : a * (b * c) = a * (c * b) := by
conv in _ * c =>
rw [Nat.mul_comm b c]
同じ形の部分式が複数あるときは、occs で何番目の出現を書き換えるか指定できます。
example (a b : Nat) :
(a + b) + (a + b) = (a + b) + (b + a) := by
conv in (occs := 2) a + b =>
rw [Nat.add_comm a b]
convert
ローカルコンテキストに現在のゴールに近いけれども等しくはない h があるとき、exact h としても失敗します。しかし convert h は成功する可能性があり、成功した場合は h とゴールの差分を新たなゴールとします。
import Mathlib.Tactic.Convert
variable (a b c: Nat)
example (f : Nat → Nat) (h : f (a + b) = 0) (hc: a + b = c) : f (c) = 0 := by
-- `h` はゴールと等しくないので失敗する
fail_if_success exact [h]
-- `h` とゴールの差分を新たなゴールにする
convert h
-- ゴールが `⊢ c = a + b` に変わっている
show c = a + b
rw [hc]
decide
decide は、決定可能な命題を示すタクティクです。
命題 P : Prop が決定可能であるとは、型クラス Decidable のインスタンスであることを意味します。P が Decidable のインスタンスであるとき、decide 関数を適用することにより decide P : Bool が得られるので、これを使って証明したり反証したりできます。
-- 決定可能な命題を決定する関数 decide が存在する
#check (decide : (P : Prop) → [Decidable P] → Bool)
つまり一言で言えば、decide とは「計算すればわかる」ことを証明または反証するためのタクティクです。
-- 計算すればわかるので示せる
example : 1 + 1 = 2 := by decide
-- 等式以外でも、決定可能なら示せる
example : 5 * 7 ≤ 21 + 19 := by decide
-- 整除関係も決定可能なので示せる
example : 11 ∣ 121 := by decide
-- 証明しようとしたことが間違っていたら教えてくれる
/-
error: Tactic `decide` proved that the proposition
15 ∣ 21
is false
-/
example : 15 ∣ 21 := by decide
カスタマイズ
Decidable 型クラスのインスタンスに登録すれば、自前で用意した述語を decide に示させることができます。
/-- 奇数であること -/
def Odd (n : Int) : Prop := ∃ t : Int, n = 2 * t + 1
example : Odd (7 : Int) := by
-- 自前で定義したばかりなので decide で示せない
fail_if_success decide
-- 手動で示す
exists 3
/-- 奇数であることが決定可能であること -/
instance (n : Int) : Decidable (Odd n) := by
-- n % 2 の計算に帰着させる
refine decidable_of_iff (n % 2 = 1) ?_
dsimp [Odd]
constructor <;> intro h
· exists (n / 2)
omega
· obtain ⟨t, th⟩ := h
rw [th]
omega
-- decide で証明できる
-- 具体的に 7 = 2 * k + 1 となる k を求める必要がなくなって嬉しい
theorem odd_seven : Odd (7 : Int) := by
decide
よくあるエラー
decide は、整礎再帰 を使って定義された関数に対してはそのまま使用することができません。native_decide タクティクを使えば一応証明は可能です。
/-- 文字列を指定した長さになるまで特定の文字で埋める関数 -/
def String.padWith (s : String) (c : Char) (n : Nat) : String :=
if n ≤ s.length then
s
else
(c.toString ++ s).padWith c n
termination_by n - s.length
#guard String.padWith "abc" 'x' 5 = "xxabc"
example : String.padWith "abc" 'x' 5 = "xxabc" := by
-- decide は整礎再帰の関数には使えない
fail_if_success decide
-- 一応証明できる
native_decide
done
done は、証明終了の合図です。証明すべきゴールが残っていない時に成功し、それ以外の時にはエラーになります。QED のようなものです。証明がサブゴールに分かれている場合、サブゴールごとに判定を行います。
example (P Q : Prop) (h : P → Q) : ¬ P ∨ Q := by
-- `P` が成り立つかどうかで場合分けを行う
by_cases hP : P
-- `P` が成り立つ場合
case pos =>
-- `P → Q` より `Q` が成り立つ
have := h hP
-- したがって結論が従う
exact Or.inr this
-- `P` が成り立つ場合の証明終わり。
done
-- `P` が成り立たない場合
case neg =>
-- `¬ P` が成り立つので、`¬ P ∨ Q` も成り立つ
exact Or.inl hP
-- `P` が成り立たない場合の証明終わり。
done
舞台裏
getUnsolvedGoals という関数で、現在の残りのゴールを取得することができます。これを利用すると、done タクティクと同様のはたらきをするタクティクを自作することができます。ここでは elab コマンドを使った実装を紹介します。
open Lean.Elab Tactic Term in
elab "my_done" : tactic => do
-- 未解決のゴールを List として取得する
let gs ← getUnsolvedGoals
-- ゴールが残っている場合はエラーにする
unless gs.isEmpty do
reportUnsolvedGoals gs
throwAbortTactic
example : 1 = 1 := by
rfl
my_done
/-
error: unsolved goals
⊢ 2 = 2
-/
example : 1 = 1 ∧ 2 = 2 := by
refine ⟨rfl, ?_⟩
my_done
これを使うと、派生タクティクを自作することもできます。ゴールを閉じたときに 🎉 でお祝いしてくれるタクティクを自作してみましょう。
open Lean Elab Tactic Term in
elab "tada" : tactic => do
let gs ← getUnsolvedGoals
unless gs.isEmpty do
reportUnsolvedGoals gs
throwAbortTactic
-- ゴールが残っていない場合はお祝いメッセージを表示する
logInfo "Goals accomplished 🎉"
/- info: Goals accomplished 🎉 -/
example : 1 = 1 := by
rfl
tada
dsimp
dsimp は、定義的に等しい(definitionally equal) 変形だけを行うという制約付きの simp で、一言でいえば「名前を定義に展開する」タクティクです。
dsimp [e₁, e₂, ..., eᵢ] という構文でゴールに登場する名前 e₁, ..., eᵢ を定義に展開します。
section
/-- `n < m`を真似て構成した自前の述語 -/
def Nat.mylt (n m : Nat) := (n + 1) ≤ m
/-- `n < m`と書いたら標準の`Nat.lt`の代わりに上記の`Nat.mylt`を使用する -/
local instance : LT Nat where
lt := Nat.mylt
example : 1 < 2 := by
-- `<`という記号、およびその実装である`Nat.mylt`を展開する
dsimp [(· < ·), Nat.mylt]
-- ゴールが展開されて変形された
guard_target =ₛ 2 ≤ 2
omega
end
舞台裏
「定義的に等しい(definitionally equal)ような変形だけを行う」というのは、rfl で示せるような命題だけを使用するという意味です。rfl で示せないような簡約は dsimp ではできません。
/-- 自前で定義した自然数 -/
inductive MyNat where
| zero : MyNat
| succ : MyNat → MyNat
instance : Zero MyNat where
zero := MyNat.zero
/-- MyNat の足し算 -/
def MyNat.add (n m : MyNat) : MyNat :=
match m with
| .zero => n
| .succ m => MyNat.succ (MyNat.add n m)
/-- MyNat.add を足し算記号で書けるようにする -/
infix:65 " + " => MyNat.add
/-- ゼロを左から足しても変わらない。-/
theorem MyNat.zero_add {n : MyNat} : (0 : MyNat) + n = n := by
induction n with
| zero => rfl
| succ n ih =>
dsimp [MyNat.add]
rw [ih]
example (n : MyNat) : n + (0 : MyNat) = n := by
-- rfl で証明ができる
rfl
example (n : MyNat) : n + (0 : MyNat) = n := by
-- dsimp でも証明ができる
dsimp [MyNat.add]
example (n : MyNat) : (0 : MyNat) + n = n := by
-- rfl では証明ができない
fail_if_success rfl
-- dsimp でも証明ができない
fail_if_success dsimp [MyNat.add]
rw [MyNat.zero_add]
カスタマイズ
dsimp で自動的に示せる命題を増やすには、[defeq] 属性と [simp] 属性を付与します。
ただし、[defeq] 属性は [simp] 属性の前に付与しなければなりません。
theorem MyNat.add_zero (n : MyNat) : n + (0 : MyNat) = n := by
rfl
example (n : MyNat) : n + (0 : MyNat) = n := by
-- 最初は `dsimp` で証明ができない
fail_if_success dsimp
rfl
section
-- `simp`, `defeq` の順に属性を与える
attribute [local simp, defeq] MyNat.add_zero
example (n : MyNat) : n + (0 : MyNat) = n := by
-- まだ `dsimp` では証明ができない
fail_if_success dsimp
-- `simp` では証明ができる
simp
end
-- `defeq` 属性を先に付与する
attribute [defeq, simp] MyNat.add_zero
example (n : MyNat) : n + (0 : MyNat) = n := by
-- `dsimp` で証明ができるようになった！
dsimp
unfold と比べた長所
同じく名前を定義に展開するタクティクとして unfold があります。たいていの場合両者は同じように使うことができますが、unfold は次のような意外な挙動をすることがあります。
-- α の部分集合を表す型
def Set (α : Type) := α → Prop
-- 部分集合の共通部分を取る操作
def Set.inter {α : Type} (s t : Set α) : Set α := fun x => s x ∧ t x
-- ∩ という記法を使えるようにする
instance (α : Type) : Inter (Set α) where
inter := Set.inter
variable {α : Type} (s u : Set α)
example: True ∨ (s ∩ u = u ∩ s) := by
-- ∩ 記号を展開する
dsimp [Inter.inter]
-- Set.inter で書き直される
guard_target =ₛ True ∨ (s.inter u = u.inter s)
left; trivial
example : True ∨ (s ∩ u = u ∩ s) := by
-- ∩ 記号を展開する
unfold Inter.inter
-- 展開結果にインスタンスが入ってしまう
show True ∨ (instInterSet α).1 s u = (instInterSet α).1 u s
-- 再びインスタンスの展開を試みると
unfold instInterSet
-- 振り出しに戻ってしまう！
show True ∨ (s ∩ u = u ∩ s)
left; trivial
また、dsimp は識別子(ident)ではないものに対しても簡約を行うことができますが、unfold は識別子でなければ簡約が行えません。これも dsimp の長所といえます。
example : True ∨ (s ∩ u = u ∩ s) := by
-- dsimp はラムダ式に対する簡約ができる
dsimp [(· ∩ ·)]
-- ゴールが展開される
guard_target =ₛ True ∨ (s.inter u = u.inter s)
left; trivial
open Lean Parser
/-- `s : String` をパースして `Syntax` の項を得る。`cat` は構文カテゴリ。-/
def parse (cat : Name) (s : String) : MetaM Syntax := do
ofExcept <| runParserCategory (← getEnv) cat s
-- 識別子を渡したときはパースできる
#eval parse `tactic "unfold Inter.inter"
-- 識別子でないものを渡すとパースできない
/- error: <input>:1:7: expected identifier -/
#eval parse `tactic "unfold (· ∩ ·)"
unfold と比べた短所
ただし、dsimp が失敗して unfold が成功するケースも存在します。
たとえば、dsimp は [irreducible] 属性が付与された定義を展開することができませんが unfold は展開することができます。
@[irreducible]
def foo : Nat := 0
example : foo = 0 := by
-- dsimp は失敗する
fail_if_success dsimp [foo]
-- unfold は成功する
unfold foo
rfl
exact
ゴールが P で、ローカルコンテキストに hP : P があるときに、exact hP はゴールを閉じます。hP がゴールの証明になっていないときには、失敗してエラーになります。
example {P Q : Prop}(hP : P)(hQ : Q) : P := by
-- `hQ : Q` は `P` の証明ではないのでもちろん失敗する
fail_if_success exact hQ
exact hP
exact は与えられた証明項をそのまま証明として使うタクティクなので、by exact だけで証明が終わるときには、by exact を消しても証明が通ります。
section
/- ## by exact の省略ができるケース -/
variable {P Q : Prop}
example (hP : P) (hQ : Q) : P ∧ Q := by
-- exact を使う証明
exact And.intro hP hQ
example (hP : P) (hQ : Q) : P ∧ Q :=
-- by exact を使わない証明
And.intro hP hQ
end
なお And は構造体なので無名コンストラクタ記法を用いて次のように書くこともできます。
example {P Q : Prop} (hP : P) (hQ : Q) : P ∧ Q := ⟨hP, hQ⟩
assumption との関連
exact は常にどの命題を使うか明示する必要がありますが、「ゴールを exact で閉じることができるような命題をローカルコンテキストから自動で探す」 assumption というタクティクもあります。
exact?
exact? は、カレントゴールを exact で閉じることができないか、import されているファイル群から検索して提案してくれるタクティクです。閉じることができなければ、エラーになります。
import Mathlib.Algebra.Order.Floor.Defs -- `Nat.floor` を使うために必要
import Mathlib.Data.Rat.Floor -- `ℚ` の性質を使うために必要
import Mathlib.Tactic.Says -- `says` を使うために必要
-- `exact?` はライブラリ検索を行う
example (x : Nat) : x < x + 1 := by
exact? says
exact lt_add_one x
-- ローカルコンテキストにある仮定を自動で使ってゴールを導いてくれる
example {P Q R : Prop} (hPQ : P → Q) (hQR : Q → R) (hQ : P) : R := by
exact? says
exact (hQR ∘ hPQ) hQ
exact? using h とするとローカルコンテキストにある仮定 h を使用してほしいと明示的に指定することができます。
example (n m : Nat) (h1 : n ≠ 0) (_h2 : n > 0) : n * m / n = m := by
-- `h1` を指定すると `h2` は使わない
exact? using h1 says
exact Eq.symm (Nat.eq_div_of_mul_eq_right h1 rfl)
example (n m : Nat) (_h1 : n ≠ 0) (h2 : n > 0) : n * m / n = m := by
-- `h2` を指定すると `h1` は使わない
exact? using h2 says
exact Nat.mul_div_right m h2
ローカルにある定理の検索
exact? は現在の環境にある定理・定数などを読み取るので、ローカルにある定理も検索してくれます。
inductive MyNat where
| zero
| succ (n : MyNat)
namespace MyNat
def add (m n : MyNat) : MyNat :=
match n with
| zero => m
| succ n => succ (add m n)
-- `+`記号と`0`が使えるようにする
instance : Add MyNat := ⟨MyNat.add⟩
instance : Zero MyNat := ⟨MyNat.zero⟩
theorem add_zero (n : MyNat) : 0 + n = n := by
induction n
case zero => rfl
case succ n ih =>
rw [show 0 + n.succ = succ (0 + n) from by rfl]
rw [ih]
example (n : MyNat) : 0 + n = n := by
-- 自前で示した定理をちゃんと見つけてくれる
exact? says
exact MyNat.add_zero n
end MyNat
exact? を使用する際のコツ
これは exact? に限らず、Lean でライブラリ検索を行うとき常に意識した方が良いことですが、
強すぎる仮定を使用していたり表現が具体的過ぎたりすると上手くいかないことがあります。
適切な抽象化を心掛けてください。
variable (n : ℕ) (a : ℚ)
example (h : ↑ n < a) : n ≤ Nat.floor a := by
-- ここで単に `exact?` しても通らない
fail_if_success exact?
-- 仮定の `<` が強すぎる。
-- 結論を成り立たせるには `≤` で十分。
suffices ↑ n ≤ a from by
-- そうすると `exact?` が通るようになる
exact? says
exact Nat.le_floor this
-- 後は `<` から `≤` を示せばよいだけ
show ↑n ≤ a
exact LT.lt.le h
exfalso
exfalso はゴールを矛盾を意味する False に換えます。
「矛盾からはどんな命題でも示せる」という命題 False → P のことを爆発律(principle of explosion)といいますが、これはラテン語で ex falso と呼ばれるようで、これが名前の由来のようです。
仮定の中に矛盾があるとき、ゴールが具体的に何であるかは関係がないので、exfalso を使ってゴールを False に変えた方が分かりやすいでしょう。
example {P Q : Prop} (h : P) (hn : ¬ P) : P ∧ Q := by
-- 仮定の中に矛盾があるので、ゴールが何であるかは関係ない
-- なので、ゴールを `False` に変える
exfalso
show False
exact hn h
ローカルコンテキスト内に P と ¬ P があって矛盾することを指摘したい場合は、contradiction を使うとより簡潔です。また、一般に問題が命題論理に帰着されている状況では tauto または itauto が利用できます。
舞台裏
爆発律はどこから来たか
矛盾つまり False の項からはどんな命題でも示せるというのは最初は奇妙に感じるかもしれません。実際に False の構成を真似て自分で帰納型を定義することによって、同様のことを再現できます。
universe u
-- まずコンストラクタを持たない帰納型を定義する
-- これで False を模倣したことになる
inductive MyFalse : Prop
-- 帰納型を定義すると、再帰子(recursor)が自動生成される
-- 再帰子は数学的帰納法の原理に相当する
-- MyFalse の再帰子は以下のようになる
-- 再帰子によって、MyFalse からの関数を定義することができる
#check (@MyFalse.rec : (motive : MyFalse → Sort u) → (t : MyFalse) → motive t)
-- motive の返り値の型の Sort u には Prop も含まれる
-- したがって `fun _ => P` という関数を再帰子に渡すことができて任意の命題の証明ができる
theorem MyFalse.elim {P : Prop} (h : MyFalse) : P := @MyFalse.rec (fun _ => P) h
/-- `MyFalse` についての爆発律。`MyFalse` からはなんでも証明できる -/
example {Q : Prop} (h : MyFalse) : Q := by
apply MyFalse.elim
exact h
exfalso の定義
実際、exfalso は refine False.elim ?_ に展開されるマクロです。
section
open Lean
/-- `#expand` の入力に渡すための構文カテゴリ -/
syntax macro_stx := command <|> tactic <|> term
/-- マクロを展開するコマンド -/
elab "#expand " "(" stx:macro_stx ")" : command => do
let t : Syntax :=
match stx.raw with
| .node _ _ #[t] => t
| _ => stx.raw
match ← Elab.liftMacroM <| Macro.expandMacro? t with
| none => logInfo m!"Not a macro"
| some t => logInfo m!"{t}"
end
/- info: refine False.elim✝ ?_ -/
#expand (exfalso)
exists
exists タクティクは、「～を満たす x が存在する」という命題を示すために、証拠になる x を具体的に示します。
ゴールが ⊢ ∃ x, P x のとき、x : X がローカルコンテキストにあれば、exists x によりゴールが ⊢ P x に変わります。同時に、P x が自明な場合は証明が終了します。
example : ∃ x : Nat, 3 * x + 1 = 7 := by
exists 2
上位互換にあたるタクティクに use タクティクがあります。
舞台裏
なお Lean での存在量化の定義は次のようになっています。
inductive Exists.{u} {α : Sort u} (p : α → Prop) : Prop where
/-- `a : α` と `h : p a` から `∃ x : α, p x` の証明を得る -/
| intro (w : α) (h : p w) : Exists p
したがって Exists は単一のコンストラクタを持つ帰納型なので、上記の exists は exact と無名コンストラクタで次のように書き直すことができます。
example : ∃ x : Nat, 3 * x + 1 = 7 := by
exact ⟨2, show 3 * 2 + 1 = 7 from by rfl⟩
一般に exists e₁, e₂, .., eₙ は refine ⟨e₁, e₂, .., eₙ, ?_⟩; try trivial の糖衣構文です。
section
open Lean
/-- `#expand` の入力に渡すための構文カテゴリ -/
syntax macro_stx := command <|> tactic <|> term
/-- マクロを展開するコマンド -/
elab "#expand " "(" stx:macro_stx ")" : command => do
let t : Syntax :=
match stx.raw with
| .node _ _ #[t] => t
| _ => stx.raw
match ← Elab.liftMacroM <| Macro.expandMacro? t with
| none => logInfo m!"Not a macro"
| some t => logInfo m!"{t}"
end
/- info: (refine ⟨1, 2, 3, ?_⟩; try trivial) -/
#expand (exists 1, 2, 3)
ext
ext は、外延性(extensionality)を使うタクティクです。外延性とは、「同じものから作られているものは同じである」という主張のことです。たとえば、「2つの関数 f g : A → B があるとき ∀ a : A, f a = g a ならば f = g」というのは外延性の一種で、関数外延性(functional extensionality) と呼ばれます。
example {A B : Type} (f g : A → B) (h : ∀ a : A, f a = g a) : f = g := by
-- `x : A` を取って外延性を使用する
ext x
-- ゴールが `f x = g x` に変わる
guard_target =ₛ f x = g x
apply h
カスタマイズ
特定の型の外延性を登録し、ext タクティクで使用できるようにするには、外延性を述べた命題に [ext] 属性を付与します。
/-- `α` を全体集合とする集合の全体。別の言い方をすれば、`α` のベキ集合。
`α` の部分集合と、`α` 上の述語を同一視している。-/
def Set (α : Type u) := α → Prop
namespace Set
variable {α : Type u}
/-- `x : α` が `s : Set α` の要素であるという命題。-/
def Mem (s : Set α) (x : α) : Prop := s x
/-- 集合らしく `s x` を `x ∈ s` と書けるようにする -/
instance : Membership α (Set α) := ⟨Mem⟩
/-- 集合の外延性。同じ要素からなる集合は等しい -/
theorem ext {a b : Set α} (h : ∀ x, x ∈ a ↔ x ∈ b) : a = b := by
-- 関数外延性を使う
apply funext
intro x
rw [show a x ↔ b x from h x]
example {a b : Set α} (h : ∀ x, x ∈ a ↔ x ∈ b) : a = b := by
-- 最初は使えない
fail_if_success ext x
sorry
-- `[ext]` 属性を付与
attribute [ext] Set.ext
example {a b : Set α} (h : ∀ x, x ∈ a ↔ x ∈ b) : a = b := by
-- ext タクティクが使えるようになった！
ext x
apply h
end Set
構造体に対する [ext] 属性
[ext] 属性は構造体に対しても与えることができます。このとき、その構造体に対して自動的に .ext と .ext_iff の２つの定理が生成されます。
variable {α : Type}
structure Point (α : Type) where
x : α
y : α
-- 最初は存在しない
#check_failure Point.ext
#check_failure Point.ext_iff
-- `Point` に `[ext]` 属性を与える
attribute [ext] Point
-- 自動生成された定理
-- 各フィールドの値が等しければ、2つの `Point` は等しいという主張
#check (Point.ext : ∀{x y : Point α}, x.x = y.x → x.y = y.y → x = y)
-- 自動生成された定理その２
-- 2つの `Point` の点が等しいことは、各フィールドの値が等しいことと同値
#check (Point.ext_iff : ∀{x y : Point α}, x = y ↔ x.x = y.x ∧ x.y = y.y)
これにより、構造体に対して ext タクティクが使用できるようになります。
structure Foo where
x : Nat
y : Nat
example (p q : Foo) (hx : p.x = q.x) (hy : p.y = q.y) : p = q := by
-- 最初は ext タクティクが使えない
fail_if_success ext
sorry
-- `Foo` に `[ext]` 属性を与える
attribute [ext] Foo
example (p q : Foo) (hx : p.x = q.x) (hy : p.y = q.y) : p = q := by
-- ext タクティクが使えるようになった！
ext
· exact hx
· exact hy
field_simp
field_simp は、体1における等式を示す際の「分母を払う」操作に対応するタクティクです。
import Mathlib.Tactic
example (n m : Rat) : n * m = ((n + m) ^ 2 - n ^ 2 - m ^ 2 ) / 2 := by
-- 分母を払う
field_simp
-- Rat は可換環なので、 示すべきことが言える
ring
分母がゼロでないことが判らない場合は動作しません。分母がゼロでないことを証明してローカルコンテキストに加えると動作することがあります。
example {x y z : Rat} (hy : y = z ^ 2 + 1) : (x + 2 * y) / y = x / y + 2 := by
-- 最初 `field_simp` は動作しない
fail_if_success solve
| field_simp
-- 分母がゼロでないことを示す
have ypos : y ≠ 0 := by
rw [hy]
positivity
-- 動作するようになった
field_simp
制約
field_simp という名前の通り、割り算が体の割り算でなければ動作しないことがあります。たとえば以下のコードは、自然数 Nat における割り算なので field_simp では扱うことができないという例です。
example (n m : Nat) : n * m = ((n + m) ^ 2 - n ^ 2 - m ^ 2 ) / 2 := by
-- field_simp は動作しない
fail_if_success field_simp
-- 分母を払う
suffices goal : 2 * (n * m) = (n + m) ^ 2 - n ^ 2 - m ^ 2 from by
simp [← goal]
-- `(n + m) ^ 2` を展開する
rw [show (n + m) ^ 2 = n ^ 2 + 2 * n * m + m ^ 2 from by ring]
-- 打消し合う項を消して簡単にすれば、示すべきことが言える
simp [add_assoc, mul_assoc]
また field_simp の扱うのは等式のみで、順序関係は扱いません。体の定義に順序関係は含まれていないので、当然かもしれません。
variable (x y : Rat)
example : x * y ≤ (x ^ 2 + y ^ 2) / 2 := by
-- 何も起こらない
fail_if_success solve
| field_simp
suffices x ^ 2 - 2 * x * y + y ^ 2 ≥ 0 from by
linarith
calc
x ^ 2 - 2 * x * y + y ^ 2 = (x - y) ^ 2 := by ring
_ ≥ 0 := by apply sq_nonneg
example (h : x = y) : x * y = (x ^ 2 + y ^ 2) / 2 := by
-- 等式ならば扱える
field_simp
-- ゴールの分母を払うことができた
show x * y * 2 = x ^ 2 + y ^ 2
rw [h]
ring
-
体とは、四則演算が定義されていて、0 でない要素で割り算ができるものを指します。 ↩
fin_cases
fin_cases は有限通りの場合分けを行うタクティクです。
何度も cases をしないと全通りに場合分けできない場合でも、一発で全てのケースを生成することができます。
h : x ∈ [a₁, ..., aₙ] といった形の仮定に対して fin_cases h とすると、代入 x = a₁, ..., x = aₙ を施した n 個のゴールが生成されます。
import Mathlib.Tactic
example {n : ℕ} (h : n ∈ [2, 4, 42]) : 2 ∣ n := by
-- n に 2, 4, 42 を順に代入した 3 つのゴールが生成される
fin_cases h
-- あとはそれぞれのゴールに対して具体的に計算して証明する
next =>
show 2 ∣ 2; decide
next =>
show 2 ∣ 4; decide
next =>
show 2 ∣ 42; decide
fin_cases を使わない場合、以下のように cases を繰り返し用いて一つずつケースを取り出すことになります。
example {n : ℕ} (h : n ∈ [2, 4, 42]) : 2 ∣ n := by
cases h
case head =>
show 2 ∣ 2; decide
case tail h =>
-- n ∈ [4, 42] であるケース
change n ∈ [4, 42] at h
cases h
case head =>
show 2 ∣ 4; decide
case tail h =>
-- n ∈ [42] であるケース
change n ∈ [42] at h
cases h
case head =>
show 2 ∣ 42; decide
case tail h =>
-- n ∈ [] であるケース
change n ∈ [] at h
contradiction
fin_cases は List α のほかに、Finset α と Multiset α に対して適用可能です。
example {n : ℕ} (h : n ∈ ({2, 4, 42} : Finset ℕ)) : 2 ∣ n := by
fin_cases h
all_goals decide
example {n : ℕ} (h : n ∈ ({2, 4, 42} : Multiset ℕ)) : 2 ∣ n := by
fin_cases h
all_goals decide
また、型 α が「有限な型」である(インスタンス Fintype α が実装されている)場合、fin_cases x は x : α のとりうる値に関する場合分けを行います。
-- `Fin n` は 0 から n-1 までの整数からなる型で、val : ℕ と isLt : val < n の 2 つのフィールドを持つ
example (n : Fin 10) (h : n.val ∣ 6) : n = 1 ∨ n = 2 ∨ n = 3 ∨ n = 6 := by
-- n.val = 0, ..., n.val = 9 の 10 通りに場合分けする
fin_cases n
-- h : n.val ∣ 6 が成り立たないケースは contradiction で示される
any_goals contradiction
-- 残りのケースについて、n = 1 ∨ n = 2 ∨ n = 3 ∨ n = 6 が成り立つ
all_goals decide
fun_cases
fun_cases は、関数定義に応じて場合分けを行うためのタクティクです。
たとえば以下の例では、swapHead はリストに対して「空か、シングルトンか、そのほか」で場合分けをして定義されています。一方でリストは再帰的なデータ型としては「空か、そのほか」で定義されているため、cases タクティクで普通に場合分けをしようとすると場合分けの分岐が合いません。fun_cases を使うと、関数定義で使用された場合分けを再利用することができます。
variable {α : Type}
/-- リストの先頭２要素を入れ替える -/
@[simp]
def swapHead (xs : List α) : List α :=
match xs with
| [] => []
| [x] => [x]
| x :: y :: zs => y :: x :: zs
example (l : List α) : swapHead (swapHead l) = l := by
fun_cases swapHead l <;> simp
-- `fun_cases` を使用しなかった場合、場合分けの手間が増える
example (l : List α) : swapHead (swapHead l) = l := by
cases l with
| nil => simp
| cons x xs =>
cases xs with
| nil => simp
| cons y ys => simp
舞台裏
Lean で関数 f を定義すると f.fun_cases という名前の補助的な定理が自動生成されます。fun_cases タクティクは、この補助定理を使用して場合分けを行っています。cases タクティクでも、using で明示的に指定すれば fun_cases と同様のことができます。
example (l : List α) : swapHead (swapHead l) = l := by
cases l using swapHead.fun_cases <;> simp
関数内で宣言した補題の再利用
以上のように「関数定義に使用した場合分けを再利用できる」のが fun_cases タクティクの主な利点ですが、他にも「関数定義の中で宣言した補題を再利用できる」という利点があります。
variable {α : Type} [LE α] [DecidableEq α] [DecidableLE α]
instance : Min α := minOfLe
/-- リストの最小値を先頭に持ってくる -/
@[simp, grind]
def minFirst (xs : List α) : List α :=
match h : xs with
| [] => []
| x :: xs =>
-- `x :: xs` の最小値を `μ` とする
let μ := List.min (x :: xs) (h := by simp)
-- `x :: xs` から `μ` を削除したリストを `rest` とする
let rest := List.erase (x :: xs) μ
-- `μ` は（最小値なので当然）`x :: xs` に含まれる
have : μ ∈ x :: xs := by
exact List.minOn?_mem rfl
-- 関数定義の中で補題を示しておくと、`fun_cases` で再利用できる
have : (μ :: rest).length = (x :: xs).length := by
grind
μ :: rest
@[grind =]
theorem minFirst_length (xs : List α) :
(minFirst xs).length = xs.length := by
-- 普通にinductionすると失敗する
fail_if_success
induction xs with grind only [minFirst]
-- `fun_cases` を使うと成功する
fun_cases minFirst xs with grind only [minFirst]
fun_induction
fun_induction は、特定の再帰関数用の帰納法ができるようにします。
たとえば、自然数について帰納法を行うと n = 0 の場合と n = n' + 1 の場合に場合分けをすることになります。しかし、関数 f について何かを示そうとしているとき、f が自然数の再帰的構造に沿って定義されているとは限りません。そのような場合に fun_induction を使うと、場合分けの枝が一致しない問題と格闘しないで済みます。
/-- フィボナッチ数列の通常の定義をそのまま Lean の関数として書いたもの -/
@[simp]
def fibonacci (n : Nat) : Nat :=
match n with
| 0 => 0
| 1 => 1
| n + 2 => fibonacci n + fibonacci (n + 1)
/-- フィボナッチ数列の線形時間の実装 -/
def fib (n : Nat) : Nat :=
(loop n).1
where
loop (x : Nat) : Nat × Nat :=
match x with
| 0 => (0, 1)
| n + 1 =>
let p := loop n
(p.2, p.1 + p.2)
@[simp]
theorem fib_zero : fib 0 = 0 := by rfl
@[simp]
theorem fib_one : fib 1 = 1 := by rfl
/-- `fib` が `fibonacci` と同じ漸化式を満たす -/
@[simp]
theorem fib_add (n : Nat) : fib n + fib (n + 1) = fib (n + 2) := by rfl
/-- `fibonacci` と `fib` は同じ結果を返す -/
example (n : Nat) : fibonacci n = fib n := by
fun_induction fibonacci n with
| case1 => rfl
| case2 => simp
| case3 n ih1 ih2 =>
simp [ih1, ih2]
induction タクティクと同様に、with の後にタクティクを続けると、すべての枝に対してそのタクティクを適用します。
example (n : Nat) : fibonacci n = fib n := by
fun_induction fibonacci n with simp_all
引数の省略
fun_induction f x₁ ... xₙ と書く代わりに、引数 x₁ ... xₙ を省略して fun_induction f と書くこともできます。引数が省略されると、Lean はゴールの中から f の適用箇所を探して引数を自動的に特定しようとします。ゴール中で f が一意に決まる引数に適用されていれば（すなわち、どの引数について帰納法を回すかが一意に決まれば）、引数を省略することができます。たとえば、先ほどの例では n を省略しても動作します。
-- n を省略しても動作する
example (n : Nat) : fibonacci n = fib n := by
fun_induction fibonacci with simp_all
一方、ゴール中に f が 複数の異なる引数で 呼ばれているとき、どの引数について帰納法を回すかを特定できなくなるため、引数を省略するとエラーになります。次の例では、ゴール中に myLast? が l ++ r、l、r という 3 つの引数を与えられてそれぞれ現れており、引数を省略するとエラーになります。
variable {α : Type}
/-- リストの最後の要素を返す関数 -/
@[grind]
def myLast? (l : List α) : Option α :=
match l with
| [] => none
| [a] => some a
| _ :: rest => myLast? rest
@[grind =, simp]
theorem myLast?_append_singleton (l : List α) (a : α) :
myLast? (l ++ [a]) = some a := by
induction l with grind
-- ゴール中に myLast? が複数の異なる引数で現れるため、引数を省略するとエラーになる
example (l r : List α) :
myLast? (l ++ r) = if r = [] then myLast? l else myLast? r := by
-- 引数を省略するとエラー
fail_if_success fun_induction myLast?
-- 帰納法に使う引数 r を明示することで成功する
fun_induction myLast? r generalizing l with
| case1 => simp
| case2 => simp
| case3 b rest h ih =>
replace ih := ih (l ++ [b])
grind
舞台裏
再帰関数 foo を定義すると、裏で Lean が帰納原理(induction principle) foo.induct と foo.induct_unfolding を生成します。
/-- フィボナッチ数列 -/
def fibonacci (n : Nat) : Nat :=
match n with
| 0 => 0
| 1 => 1
| n + 2 => fibonacci (n + 1) + fibonacci n
#check fibonacci.induct
#check fibonacci.induct_unfolding
帰納原理が生成されるのは再帰的な関数のみです。再帰的でない関数には生成されません。
def swapHead (l : List Nat) : List Nat :=
match l with
| [] => []
| [x] => [x]
| x :: y :: xs => y :: x :: xs
-- 帰納原理が生成されていない
#check_failure swapHead.induct
fun_induction タクティクは、この自動生成された foo.induct_unfolding を利用して帰納法を行っています。
帰納的述語への応用
帰納原理が自動生成されるのは再帰関数に対してだけで、帰納的述語に対しては生成されません。しかし、帰納的述語を再帰関数として書き直すことができるのであれば、その再帰関数に対して生成された *.induct 定理を使って帰納法を行うことができます。
これにより、（再帰関数として書き直せるような）帰納的述語に対しても、帰納法の枝が上手くハマらない問題を解決することができます。
/-- 回文を表す帰納的述語 -/
@[grind]
inductive Palindrome {α : Type} : List α → Prop
/-- 空リストは回文 -/
| nil : Palindrome []
/-- 要素が一つだけのリストは回文 -/
| single (a : α) : Palindrome [a]
/-- 回文の両端に同じ要素を追加しても回文 -/
| sandwich {a : α} {as : List α} (ih : Palindrome as) : Palindrome ([a] ++ as ++ [a])
variable {α : Type}
-- 普通に帰納法を使おうとすると、場合分けの枝がうまくはまらない
example (as : List α) (h : as.reverse = as) : Palindrome as := by
induction as with
| nil => grind
| cons a as ih =>
/-
ih : as.reverse = as → Palindrome as
h : (a :: as).reverse = a :: as
⊢ Palindrome (a :: as)
-/
-- 簡単には証明できない
fail_if_success grind
sorry
-- `α`に対して`(· = ·)`が決定可能という仮定がないため、
-- 古典論理を使用する
open scoped Classical in
/-- 回文判定を行う再帰関数。
`Palindrome` の定義になるべく忠実に書き直したもの -/
def PalindromeRec (as : List α) : Prop :=
match as with
| [] => True
| [a] => True
| a₁ :: a₂ :: as =>
let xs := (a₂ :: as).dropLast
let x := (a₂ :: as).getLast (by simp)
-- 後に証明に使うときの利便性のために補題を示しておく
have : [a₁] ++ xs ++ [x] = a₁ :: a₂ :: as := by
grind [List.dropLast_concat_getLast]
if a₁ = x then
PalindromeRec xs
else
false
termination_by as.length
-- あっさり証明できる！
example (as : List α) (h : as.reverse = as) : Palindrome as := by
induction as using PalindromeRec.induct with grind
fun_prop
fun_prop は、連続性や可測性など、関数に関する性質を示すタクティクです。
import Mathlib.Tactic
import Mathlib.MeasureTheory.Constructions.BorelSpace.Basic
variable {u v : ℝ → ℝ} (hu : Continuous u) (hv : Continuous v)
/-- 連続関数の積は連続関数 -/
example : Continuous (fun x ↦ u x * v x) := by
fun_prop
/-- 有理関数が可測関数であることを示す -/
example : Measurable fun x : ℝ => (x * x - 1) / x + (x - x * x) := by
fun_prop
funext
関数 f と g が等しいことを示す際に、引数 x をとって f x = g x を示そうとすることがありますが、funext はそれを行うタクティクです。
def f := fun (x : Nat) ↦ x + x
def g := fun (x : Nat) ↦ 2 * x
example : f = g := by
-- 引数 `x` を取る
funext x
-- `f` と `g` を定義に展開する
dsimp [f, g]
-- `x + x` と `2 * x` が等しいことを証明する
show x + x = 2 * x
grind
なお funext は ext で置き換えることができます。
example : f = g := by
-- `ext` で書き換えることができる
ext x
dsimp [f, g]
grind
gcongr
gcongr は合同関係(congruence)を扱うタクティクです。
n 変数関数 f と n+1 個の2項関係 ∼, ~₁, … ∼ₙ に対して、x₁ ~₁ x₁' → ... xₙ ~ₙ xₙ' → f x₁ ... xₙ ∼ f x₁' ... xₙ' が成り立つという形の補題を使って、ゴールを書き換えます。
同様に合同性を扱うタクティクに congr がありますが、あちらは等号を扱います。
import Mathlib.Tactic.GCongr -- `gcongr` を使うため
import Mathlib.Analysis.SpecialFunctions.Log.Basic -- `log` を使うため
open Real
variable (a b : ℝ) (x y : ℝ)
example (h : a ≤ b) : log (1 + exp a) ≤ log (1 + exp b) := by
gcongr
example (h1 : x ≤ y) (h2 : a ≤ b) (h3 : 0 ≤ a) (h4 : 0 ≤ y)
: x * a ≤ y * b := by
gcongr
gcongr はデフォルトでは分解できなくなるまで分解するので、「行き過ぎ」になることがあります。gcongr に分解パターンを直接指定することで、行き過ぎを防ぐことができます。
example {c d : ℝ} (h : a + c + 1 ≤ b + d + 1) :
x ^ 2 * (a + c) + 5 ≤ x ^ 2 * (b + d) + 5 := by
-- 単に `gcongr` とすると
try
gcongr
-- 分解が行き過ぎてしまう
· show a ≤ b
-- これは証明できない
fail
-- 引数でパターンを指定できる
gcongr x ^ 2 * ?_ + 5
-- 望ましい分解になった
show a + c ≤ b + d
linarith
補題の登録
さらに [gcongr] 属性を付与することにより、 gcongr で呼び出して使える補題を増やすことができます。
variable {U : Type*}
variable (A B C : Set U)
/-- 独自に定義した二項関係。中身は `⊆` と同じ。-/
def mysubset (A B : Set U) : Prop := ∀ x, x ∈ A → x ∈ B
/-- `mysubset` を二項関係らしく書けるようにしたもの。-/
infix:50 " ⊆ₘ " => mysubset
example : B ∩ C ⊆ₘ (A ∪ B) ∩ C := by
-- gcongr が使えない
fail_if_success gcongr
intro x hx
aesop
-- `@[gcongr]` で `gcongr` が使える補題を増やす
@[gcongr]
lemma inter_subset_inter_left (h : A ⊆ B) : A ∩ C ⊆ₘ B ∩ C := by
intro x hx
aesop
example : B ∩ C ⊆ₘ (A ∪ B) ∩ C := by
-- gcongr が使えるようになった
gcongr
-- ゴールが変わった
show B ⊆ A ∪ B
intro x hx
aesop
generalize
generalize は、示したい命題を一般化するために使用されます。
variable {n m : Nat}
example : (n + m) ^ 2 + n * (n + m) = n * (n + m) + (n + m) ^ 2 := by
-- 式の代わりに `x` に置き換えて一般化する
generalize n * (n + m) = x
-- `y` に置き換えて一般化する
generalize (n + m) ^ 2 = y
-- `y + x = x + y` を示せばよい
show y + x = x + y
-- 足し算の可換性から従う
simp [Nat.add_comm]
単に generalize e = x とすると、非可逆的に置換されますが、generalize h : e = x とすると置換に使用した命題に後からアクセスできるようになります。
example : m ^ 2 + 1 ≥ m ^ 2 := by
-- 一般化する
generalize h : m ^ 2 = x
-- ローカルコンテキストに命題 `h` が追加される
guard_hyp h : m ^ 2 = x
simp
grind
grind は、汎用的かつ強力な証明自動化タクティクです。1
非常に強力であり、時に驚くほどギャップのある証明を自動で完了させることができます。2
/-- 階乗関数 -/
@[grind]
def factorial (n : Nat) : Nat :=
match n with
| 0 => 1
| n + 1 => (n + 1) * factorial n
@[inherit_doc factorial]
notation:max n "!" => factorial n
/-- 階乗関数の値は１以上 -/
@[simp]
theorem one_le_factorial (n : Nat) : 1 ≤ n ! := by
fun_induction factorial <;> grind
-- `n !` を見かけたら `one_le_factorial` を利用するよう `grind` に指示
grind_pattern one_le_factorial => n !
/-- Pascal の三角形 -/
def pascal (a b : Nat) : Nat :=
match a, b with
| _, 0 => 1
| 0, _ + 1 => 1
| a + 1, b + 1 => pascal (a + 1) b + pascal a (b + 1)
/-- Pascal の三角形の性質 -/
theorem pascal_le_factorial (a b : Nat) : pascal a b ≤ (a + b)! := by
-- １行で証明できてしまう！
fun_induction pascal with grind
-- `grind` を使用しない証明の例
example (a b : Nat) : pascal a b ≤ (a + b)! := by
fun_induction pascal with
| case1 => simp
| case2 => simp
| case3 a b iha ihb =>
dsimp
calc
_ = pascal (a + 1) b + pascal a (b + 1) := by rfl
_ ≤ (a + 1 + b)! + (a + (b + 1))! := by omega
_ = (a + b + 1)! + (a + b + 1)! := by congr 1; ac_rfl
_ = 2 * (a + b + 1)! := by omega
_ ≤ (a + b + 2) * (a + b + 1)! := ?step
_ = (a + b + 2)! := by rfl
_ = (a + 1 + (b + 1))! := by congr 1; ac_rfl
case step =>
generalize h : (a + b + 1)! = k
suffices 2 ≤ (a + b + 2) from by
exact Nat.mul_le_mul_right k this
omega
grind が複雑な証明を自動で完了させる様子をもっと見たい方は、付録: 選択ソート なども参考にしてください。
動作原理の概要
grind タクティクの動作原理を理解するには、仮想的な黒板を思い浮かべると良いでしょう。
新しい等式や不等式を見つけるたびに、grind はその事実を黒板に書き込んでいきます。
grind は「最初に結論の否定を仮定して矛盾を示す」ことでゴールを示すように設計されているため、最初に黒板に書き込むのは仮定と示したい結論の否定です。
set_option trace.grind.assert true in
/-
trace: [grind.assert] P
[grind.assert] ¬P
-/
example (P : Prop) (h : P) : P := by
grind
そうやって黒板に事実を書き込みながら、grind は同値類（equivalence class、互いに等しいもの同士のグループのこと）を管理していて、等しいと分かった同値類をマージしていきます。そして最終的に True のグループと False のグループをマージする（つまり、矛盾を示す）ことでゴールを閉じます。
set_option trace.grind.eqc true in
/-
trace: [grind.eqc] P = True
[grind.eqc] P = False
-/
example (P : Prop) (h : P) : P := by
grind
以上の「仮想的な黒板による同値類の管理」が中核的な動作原理で、さらに grind には以下のようなエンジンが組み込まれています。
- 合同閉包(congruence closure)
- E-マッチング(E-matching)
- 制約伝播(Constraint Propagation)
- サテライトソルバー(特定の代数系に対するソルバー群)
なお上記で説明したように、grind は「最初に結論を否定して矛盾を示すことでゴールを閉じる」という原理で動くため、必要がない場合であっても選択原理を使用します。
theorem easy_theorem (P : Prop) (h : P) : P := by
grind
/- info: 'easy_theorem' depends on axioms: [propext, Classical.choice, Quot.sound] -/
#print axioms easy_theorem
合同閉包(congruence closure)
grind には、合同閉包(congruence closure)アルゴリズムが使用されています。3
合同閉包は、等式とその否定のグループが充足可能かどうかを決定するアルゴリズムです。既知の等式から以下のルールによって新たな等式が出てこなくなるまで等式を導出し、矛盾があれば充足不能と判断します。(ただし、無限ループを避けるために合同性ルールの適用は制限します)
- 等式の反射律:
a = a - 等式の対称律:
a = bならばb = a - 等式の推移律:
a = bかつb = cならばa = c - 合同性:
a = bならばf a = f b
variable {α : Type} (a₁ a₂ : α)
set_option trace.grind.debug.congr true in
/-
trace: [grind.debug.congr] f a₂ = f a₁
[grind.debug.congr] f (f a₂) = f (f a₁)
-/
example (f : α → α) (h : a₁ = a₂) : f (f a₁) = f (f a₂) := by
grind
-- 複雑な例も扱うことができる
example (f : α → α) (x : α)
(h1 : f (f (f x)) = x) (h2 : f (f (f (f (f x)))) = x) :
f x = x := by
grind
E-マッチング
ある定理を適用して新たに分かったことを grind が黒板に書き込むことを「定理をインスタンス化する」と呼びます。grind は、定理を効率的にインスタンス化するために E-マッチング(E‑matching)と呼ばれる手法を使用します。なおE-マッチングとは、SMT ソルバなどで使われる、等式を考慮したパターンマッチの手法のことです。
grind_pattern
grind_pattern コマンドを使うと、特定の定理をいつインスタンス化するかを grind タクティクに指示することができます。
grind_pattern (定理名) => (パターン) という構文で使用し、「ローカルコンテキストに宣言されたパターンが見つかった時に定理をインスタンス化してください」という指示をしたことになります。
/-- 二項関係`R`がリストの隣接要素に対して成立するという述語。
つまり `[x₁, x₂, ..., xₙ].IsChain R` は `R x₁ x₂ ∧ R x₂ x₃ ∧ ... ∧ R xₙ₋₁ xₙ` を表す。-/
inductive List.IsChain {α : Type} (R : α → α → Prop) : List α → Prop
| nil : IsChain R []
| single (a : α) : IsChain R [a]
| cons_cons {a b : α} {l : List α} (hab : R a b) (ih : IsChain R (b :: l)) :
IsChain R (a :: b :: l)
namespace List
variable {α : Type} {R : α → α → Prop}
-- `grind`を使用しない証明の例
example (a b : α) (h : R a b) : [a, b].IsChain R := by
apply IsChain.cons_cons h
apply IsChain.single
-- `grind_pattern`を使って定理のインスタンス化を`grind`に指示する。
-- ローカルコンテキストに`=>`の右側のパターンを見かけたらインスタンス化させる。
grind_pattern IsChain.cons_cons => IsChain R (a :: b :: l)
grind_pattern IsChain.single => IsChain R [a]
example (a b : α) (h : R a b) : [a, b].IsChain R := by
-- 一撃で片づけることができるようになった
grind
-- どの定理がインスタンス化されたかのログを出す
set_option trace.grind.ematch.instance true in
/-
trace: [grind.ematch.instance] IsChain.cons_cons: R a b → IsChain R [b] → IsChain R [a, b]
[grind.ematch.instance] IsChain.single: IsChain R [b]
-/
example (a b : α) (h : R a b) : [a, b].IsChain R := by
grind
end List
複数のパターンを指定することもできます。その場合は、「指定されたパターンのすべてが見つかった時に定理をインスタンス化してください」という指示になります。
/-- 何らかの関数 -/
opaque f : Nat → Nat
/-- `f` は単調増加関数 -/
axiom f_monotone {a b : Nat} (h : a ≤ b) : f a ≤ f b
section
-- 多くのパターンを指定してインスタンス化ルールを設定
local grind_pattern f_monotone => f a, f b, a ≤ b
example (a : Nat) (h1 : a ≤ 1) (h2 : f 2 = 10) : f a ≤ 10 := by
-- 最初は示すことができない
fail_if_success grind
-- `a ≤ 2` であることを明示的に教えると通るようになる。
-- `f_monotone` のインスタンス化パターンが満たされるからだと考えられる。
have : a ≤ 2 := by grind
grind
end
-- インスタンス化の条件を緩めると、`grind` 一発で通るようになる
grind_pattern f_monotone => f a, f b
example (a : Nat) (h1 : a ≤ 1) (h2 : f 2 = 10) : f a ≤ 10 := by
grind
[grind =]
等式を主張する定理に [grind =] 属性を付与すると、結論の等式の左辺がパターンとして登録され、「左辺を見かけたらその定理をインスタンス化して、黒板に新たな事実を書き留める」という挙動をするようになります。
def f : Nat → Nat := fun x => x - 1
def g : Nat → Nat := fun x => x + 1
theorem fg (x : Nat) : f (g x) = x := by
dsimp [f, g]
-- `f (g x)` を見かけたら `f (g x) = x` という事実を
-- 黒板に書き込んで覚えておくよう指示
attribute [grind =] fg
set_option trace.grind.assert true in
set_option trace.grind.debug.congr true in
set_option trace.grind.ematch.instance true in
/-
trace: [grind.assert] f a = b
[grind.assert] a = g c
[grind.assert] ¬b = c
[grind.ematch.instance] fg: f (g c) = c
[grind.assert] f (g c) = c
[grind.debug.congr] f (g c) = f a
-/
example (a b c : Nat) (h1 : f a = b) (h2 : a = g c) : b = c := by
grind
なお、結論が等式になっていないような命題に付与するとエラーになります。
theorem bar (n m : Nat) (h : n ≤ m) (hm : m = 1) : n ≤ 1 := by
grind
/-
error: invalid E-matching equality theorem, conclusion must be an equality
n ≤ 1
-/
attribute [grind =] bar
[grind _=_]
等式を主張する定理に [grind _=_] 属性を付与すると、結論の等式の左辺と両辺がともにパターンとして登録され、「左辺か右辺のパターンを見かけたら定理を黒板に書き込む」という挙動をするようになります。
/-- 自前で定義した可換モノイド -/
class CommMonoid (M : Type) [One M] [Mul M] where
/-- 掛け算は結合的 -/
mul_assoc : ∀ a b c : M, (a * (b * c)) = ((a * b) * c)
/-- 単位元を左から掛けても変わらない -/
one_mul : ∀ a : M, (1 * a) = a
/-- 単位元を右から掛けても変わらない -/
mul_one : ∀ a : M, (a * 1) = a
/-- 掛け算は可換 -/
mul_comm : ∀ a b : M, (a * b) = (b * a)
namespace CommMonoid
variable {M : Type} [One M] [Mul M] [inst : CommMonoid M]
@[grind _=_]
theorem mul_assoc' (a b c : M) : a * (b * c) = (a * b) * c := by
apply mul_assoc
@[grind =]
theorem mul_comm' (a b : M) : a * b = b * a := by
apply mul_comm
example (a b c : M) : a * b * (c * c * a) = a * a * b * c * c := by
grind
end CommMonoid
なお、結論が等式になっていないような定理に付与するとエラーになります。
/-
error: invalid E-matching equality theorem, conclusion must be an equality
n ≤ 1
-/
@[grind _=_]
theorem bar₂ (n m : Nat) (h : n ≤ m) (hm : m = 1) : n ≤ 1 := by
grind
[grind →]
定理に [grind →] 属性を付与すると、定理の前提の命題が満たされたときに定理がインスタンス化されるようになります。
/-- 自然数上の広義の順序関係を再定義する -/
protected inductive Nat.myle (n : Nat) : Nat → Prop
/-- `∀ n, n ≤ n` -/
| refl : Nat.myle n n
/-- `n ≤ m`ならば`n ≤ m + 1` -/
| step {m : Nat} : Nat.myle n m → Nat.myle n (m + 1)
/-- `Nat.myle`のための記号。標準の`≤`と被らないようにする -/
infix:50 " ≤? " => Nat.myle
attribute [grind →] Nat.myle.step
variable {m n a b k : Nat}
/-- 推移律 -/
@[grind →]
theorem Nat.myle_trans (hnm : n ≤? m) (hmk : m ≤? k) : n ≤? k := by
induction hmk with grind
example (h1 : a ≤? b) (h2 : b ≤? k) (h3 : k ≤? m) : a ≤? m := by
grind
なお [grind →] は定理の前提となる命題からパターンを作るので、Prop 値の前提を持たない定理は登録できません。
theorem Nat.add_le (n m : Nat) : n ≤ n + m := by
omega
/-
error: invalid `grind` forward theorem,
theorem `Nat.add_le` does not have propositional hypotheses
-/
attribute [grind ->] Nat.add_le
[grind =>]
[grind =>] は、[grind →] と同様に定理の前提が見つかった時にインスタンス化するように指示をするのですが、[grind ->] とは異なり、前提だけでなく必要なら結論も見てパターンを作ります。
/-- 何らかの述語 -/
opaque P : Nat → Prop
/-- 何らかの二項関係 -/
opaque R : Nat → Nat → Prop
axiom R_of_P (x y : Nat) (h : P x) : R x y
-- `[grind ->]` 属性は登録できない。
-- これは、前提の `P x` だけからは引数の `y` が特定できないため
/-
error:
`@[grind →] theorem R_of_P` failed to find patterns in the antecedents of the theorem,
consider using different options or the `grind_pattern` command
-/
attribute [grind →] R_of_P
-- `[grind =>]` 属性は付与できる
-- これは、結論の `R a b` も手掛かりにしてインスタンス化できるため
attribute [grind =>] R_of_P
example (a b : Nat) (hP : P a) : R a b := by
-- 成功する
grind
また、[grind =>] 属性は、[grind ->] とは異なり定理の前提が命題であることを要求しません。
/-- 群 -/
class Group (G : Type) extends One G, Mul G, Inv G where
/-- 単位元を右から掛けても変わらない -/
mul_one (g : G) : g * 1 = g
/-- 単位元を左から掛けても変わらない -/
one_mul (g : G) : 1 * g = g
/-- 元とその逆元を掛けると単位元になる -/
mul_inv_cancel (g : G) : g * g⁻¹ = 1
/-- 逆元と元を掛けると単位元になる -/
inv_mul_cancel (g : G) : g⁻¹ * g = 1
/-- 掛け算は結合的である -/
mul_assoc (g₁ g₂ g₃ : G) : (g₁ * g₂) * g₃ = g₁ * (g₂ * g₃)
attribute [grind =>]
Group.mul_one Group.one_mul
Group.mul_inv_cancel Group.inv_mul_cancel Group.mul_assoc
namespace Group
variable {G : Type} [Group G]
@[grind ->]
theorem mul_right_inv {g h : G} (hy : g * h = 1) : h = g⁻¹ := calc
_ = 1 * h := by grind
_ = g⁻¹ := by grind
@[grind ->]
theorem mul_left_inv {g h : G} (hy : h * g = 1) : h = g⁻¹ := by
grind
theorem inv_inv (g : G) : g⁻¹⁻¹ = g := by
grind
end Group
[grind intro]
帰納的述語に [grind intro] 属性を付与すると、コンストラクタの適用を自動で行うようになります。
/-- 偶数であることを表す帰納的述語 -/
inductive Even : Nat → Prop where
| zero : Even 0
| step {n : Nat} : Even n → Even (n + 2)
example : Even 0 := by
-- 最初は証明できない
fail_if_success grind
apply Even.zero
example {m : Nat} (h : Even m) : Even (m + 2) := by
-- 最初は証明できない
fail_if_success grind
apply Even.step h
attribute [grind intro] Even
example {m : Nat} (h : Even m) : Even (m + 2) := by
-- 証明できるようになった
grind
外延性定理
[grind ext] 属性を付与すると、外延性定理を grind に使わせることができます。
以下は、構造体に対して [grind ext] 属性を付与する例です。
/-- 2次元の点を表す構造体 -/
@[ext]
structure Point where
x : Int
y : Int
-- `@[ext]` タグを付けているので外延性定理が自動生成される
#check Point.ext
example (p : Point) (a : Int) : a = p.x → p = ⟨a, p.y⟩ := by
-- 最初は grind だけでは証明できない
fail_if_success grind
rcases p with ⟨p_x, p_y⟩
simp_all
-- 属性を付与すると...
attribute [grind ext] Point
example (p : Point) (a : Int) : a = p.x → p = ⟨a, p.y⟩ := by
-- grind で証明できるようになった！
grind
構造体ではなく、外延性定理そのものに [grind ext] 属性を与えることもできます。
/-- 値を一つ持つラッパー型 -/
structure Box where
val : Nat
@[ext, grind ext]
theorem Box.ext {a b : Box} (h : a.val = b.val) : a = b := by
rcases a with ⟨a_val⟩
rcases b with ⟨b_val⟩
simp at *
assumption
example (a b : Box) (h : a.val = b.val) : a = b := by
grind
関数外延性には最初から標準ライブラリにおいて [grind ext] が付与されているため、grind は関数等式の形のゴールを扱うことができます。
-- 外延性を使用したときにログを出させる
set_option trace.grind.ext true in
/- trace: [grind.ext] funext: ∀ {h : ∀ (x : Nat), f x = g x}, False -/
example (f g : Nat → Nat) (h : ∀ x, f x = g x) : f = g := by
grind
ガイド付き場合分け(guided case analysis)
grind は match 式や if 式を場合分けして分解することができます。
def oneOrTwoIf (n : Nat) : Nat :=
if n = 0 then 1 else 2
example (n : Nat) : oneOrTwoIf n > 0 := by
dsimp [oneOrTwoIf]
grind
def oneOrTwoMatch (n : Nat) : Nat :=
match n with
| 0 => 1
| _ => 2
-- どういう場合分けを行ったかトレースを出す
set_option trace.grind.split true in
/-
trace: [grind.split] match n with
| 0 => 1
| x => 2, generation: 0
-/
example (n : Nat) : oneOrTwoMatch n > 0 := by
dsimp [oneOrTwoMatch]
grind
[grind cases] 属性が付与されている帰納的命題に対しても、場合分けを行います。
example : ¬ Even 1 := by
-- まだ示せない
fail_if_success grind
-- grind なしで証明する
intro h
cases h
-- 属性を付与する
attribute [grind cases] Even
example : ¬ Even 1 := by
-- grind で示せるようになった
grind
制約伝播(Constraint Propagation)
grind タクティクが黒板に新たな事実を書き込み、True または False の同値類が更新されたとき、grind は多数の前方推論を行い、新たな事実を導出していきます。これを制約伝播(Constraint Propagation)と呼びます。
制約伝播で使用される導出ルールには様々な種類のものがあります。
ブール演算
grind は A が True であれば A ∨ B も True である、などの基本的な導出を行います。
example {P Q : Prop} (h : P) : P ∨ Q := by
grind
example {P Q R : Prop} (h : P ∧ Q ∧ R) : P ∧ Q := by
grind
example (a : Bool) : (a && !a) = false := by
grind
サテライトソルバー
ac ソルバー
結合的(associative)もしくは結合的かつ可換(commutative)な二項演算を持つ代数系に対して、grind は推論を行うことができます。この機能は ac と呼ばれるソルバーによって提供されています。
/-- 自然数をイメージした何か -/
opaque MyNat : Type
variable [Add MyNat]
/-- 加法の結合法則 -/
axiom MyNat.add_assoc (a b c : MyNat) : (a + b) + c = a + (b + c)
/-- 結合法則が成り立つことを型クラス経由で登録する -/
instance : @Std.Associative MyNat (· + ·) :=
⟨MyNat.add_assoc⟩
example (a b c d : MyNat) : (a + b) + (c + d) = a + (b + c) + d := by
-- ac ソルバーを無効にすると証明できない
fail_if_success grind -ac
-- grind で証明することができる
grind only
/-- 加法の交換法則 -/
axiom MyNat.add_comm (a b : MyNat) : a + b = b + a
/-- 交換法則が成り立つことを型クラス経由で登録する -/
instance : @Std.Commutative MyNat (· + ·) :=
⟨MyNat.add_comm⟩
example (a b c : MyNat) : a + b + c = c + b + a := by
-- ac ソルバーを無効にすると証明できない
fail_if_success grind -ac
-- grind で証明することができる
grind only
前提選択(premise selection)
grind には premise selection の仕組みが組み込まれており、grind +suggestions とすることで利用することができます。
import Lean.LibrarySuggestions.Default
/--
Lean リポジトリの `tests/elab/library_suggestions_persistent.lean` で使われている例。
`Dyadic.roundDown_le` などの補題は `grind` だけでは見つけられないが、
`grind +suggestions` は premise selection によって関連する補題を見つける。
-/
example {x : Dyadic} {prec : Int} : x.roundDown prec ≤ x := by
fail_if_success grind -- grind だけでは証明できない
grind +suggestions
example {x : Dyadic} {prec : Int} : x.roundDown prec ≤ x := by
grind only [Dyadic.roundDown_le]
ただし premise selection とは、一般に自動定理証明において「証明したいゴールに関係のある定理・補題を探し出す」ことを指す言葉です。grind +suggestions は premise selection を行い、選び出した定理・補題を grind の引数に与えて実行します。
-
このページの記述は全体的に The Lean Language Reference の The grind tactic という章 を参考にしています。 ↩
-
この例は Zulip の Grind is impressive というトピックにおける Sorrachai Yingchareonthawornchai さんの投稿を元にしたものです。 ↩
-
Marijn J. H. Heule “Logic and Mechanized Reasoning” を参考にしました。 ↩
guard_hyp
guard_hyp は、ローカルコンテキストにある命題を確認するタクティクです。指定した仮定が存在すれば成功し、そうでなければ失敗します。
通常の証明で使うことはあまりないかもしれません。本書では、ローカルコンテキストの変化を説明するために使用することがあります。
variable (P : Prop)
example (hP : P) : P := by
-- 現在ローカルコンテキストにある命題を確認できる
guard_hyp hP : P
exact hP
have
have は、証明の途中でわかったことを補題としてローカルコンテキストに追加するタクティクです。
have h : P := ... で P という命題の証明を構成し、その証明に h という名前を付けることができます。
/-- 3重否定の簡略化 -/
example (P : Prop) : ¬¬¬ P → ¬ P := by
intro hn3p hp
-- ここで`¬¬ P`が成り立つ。
have hn2p : ¬¬ P := by
-- なぜなら、`¬ P`であると仮定したとき
intro hnp
-- 仮定の`P`と矛盾するから
contradiction
-- これで`¬¬¬ P`と`¬¬ P`が得られたが、これは矛盾である
contradiction
have で示した補題には必ず名前がつきます。名前を省略して have : P := ... とすると、自動的に this という名前になります。無名の補題が欲しい場合、代わりに show .. from 構文を検討してみてください。
example (P : Prop) : ¬¬¬ P → ¬ P := by
intro hn3p hp
-- 名前をつけないと…
have : ¬¬ P := by
intro hnp
contradiction
-- `this : ¬¬ P`という仮定が得られている
guard_hyp this : ¬¬ P
contradiction
また have で同じ名前を2回宣言すると、古い方はアクセス不能になってしまいます。ローカルコンテキストの補題の置き換えを行いたいときは、代わりに replace を使用してください。
無名コンストラクタ
P の証明 hp : P と Q の証明 hq : Q があるとき、P ∧ Q の証明は And.intro hp hq で構成できます。ここで And.intro は構造体 And 型のコンストラクタです。
これを、コンストラクタ名を明示せずにシンプルに ⟨hp, hq⟩ と書くことができます。これは無名コンストラクタと呼ばれるものです。
section
variable (P Q : Prop)
theorem hpq (hp : P) (hq : Q) : P ∧ Q := ⟨hp, hq⟩
theorem hpq' (hp : P) (hq : Q) : P ∧ Q := And.intro hp hq
end
無名コンストラクタを利用することで、記述を簡略化できます。
論理積 ∧
次のように、P ∧ Q という命題から P と Q を取り出すことができます。
example (P Q : Prop) (hPQ : P ∧ Q) : P := by
-- `P ∧ Q` という仮定を分解する
-- `hQ : Q` は不要なのでアンダースコアに置き換える
have ⟨ hP, _ ⟩ := hPQ
assumption
存在 ∃
次のように、∃ x : X, P x という命題から、条件を満たす x を取り出すことができます。x : X と hx : P x がローカルコンテキストに追加されます。
-- `x` が偶数のとき `3 * x` も偶数
example (x : Nat) (hx : ∃ y, x = 2 * y) : ∃ z, 3 * x = 2 * z := by
-- `hx` で存在が主張されている `y` と、
-- `x = 2 * y` という命題を得る
have ⟨y, hy⟩ := hx
exists 3 * y
rw [hy]
omega
hint
hint は複数のタクティクを試し、上手くいったものを報告してくれるタクティクです。
import Mathlib.Tactic -- `hint` は検索を伴うので、おおざっぱに import している
/-
info: Try these:
[apply] 🎉️ simp_all only [forall_const]
[apply] norm_num
Remaining subgoals:
⊢ Q
-/
example (P Q : Prop) (p : P) (h : P → Q) : Q := by
hint
/-
info: Try these:
[apply] 🎉️ simp_all only [and_self]
[apply] norm_num
Remaining subgoals:
⊢ Q ∧ P ∧ R
-/
example (P Q R : Prop) (x : P ∧ Q ∧ R ∧ R) : Q ∧ P ∧ R := by
hint
登録されているタクティク
hint に登録されているタクティクのリストは、Mathlib.Tactic.Hint.getHints 関数を介して確認することができます。
open Lean Mathlib.Tactic in
/-- `hint` タクティクに登録されているタクティクの完全なリストを出力する -/
def getRegisteredTactics : CoreM Unit := do
let hintTactics := (← Hint.getHints).map (fun (_n, tac) => tac.raw)
for tactic in hintTactics do
let .node _ _ arr := tactic
| panic! "error: unexpected syntax term"
IO.println arr[0]!
/-
info: "compute_degree"
"noncomm_ring"
"finiteness"
"linarith"
"field"
"field_simp"
"positivity"
"bound"
"add_group"
"group"
"ring"
"abel"
"norm_num"
"aesop"
"fun_prop"
"omega"
"grind"
"tauto"
"exact?"
"simp_all?"
"decide"
"intro"
"split"
"trivial"
"gcongr"
-/
#eval getRegisteredTactics
タクティクの新規登録
登録されているタクティクに tac を追加するには、register_hint tac を実行します。
register_hint 1000 nlinarith
/-
info: Try these:
[apply] 🎉️ nlinarith
-/
example (a b : Nat) (h : a ≤ b) : (a + b) ^ 2 ≤ 4 * b ^ 2 := by
hint
induction
induction は、帰納法のためのタクティクです。自然数 Nat や連結リスト List など、帰納的に定義されたものに対して何か証明しようとしているとき、帰納法を使うことが自然な選択です。
典型的な例は、自然数に対する数学的帰納法です。前提として、ある述語 P : Nat → Prop に対して ∀ n, P n を示そうとしているとします。このとき、以下を示せば十分であるというのが、数学的帰納法の主張です。
P 0が成り立つ。∀ n, P n → P (n + 1)が成り立つ。
/-- `0` から `n` までの和を計算する関数 -/
def sum (n : Nat) : Rat :=
match n with
| 0 => 0
| n + 1 => (n + 1) + sum n
example (n : Nat) : sum n = n * (n + 1) / 2 := by
-- `n` についての帰納法で示す
induction n with
-- `n = 0` の場合
| zero => grind [= sum]
-- `0` から `n` までの自然数で成り立つと仮定する
| succ n ih =>
-- 帰納法の仮定が手に入る
guard_hyp ih : sum n = n * (n + 1) / 2
-- `sum` の定義を展開し、帰納法の仮定を適用する
simp [sum, ih]
-- 後は可換環の性質から示せる
grind
なお、=> は省略することができます。
example (n : Nat) : sum n = n * (n + 1) / 2 := by
induction n with | zero | succ n ih
· grind [= sum]
· simp [sum, ih]
grind
また induction .. with の直後にタクティクを書くと、そのタクティクをすべてのゴールに対して適用します。
example (n : Nat) : sum n = n * (n + 1) / 2 := by
induction n with grind [= sum]
inductive コマンドとの関係
実際には帰納法は自然数の専売特許ではありません。inductive コマンドで定義されたものであれば、帰納法を使うことができます。
/-- 標準ライブラリの定義を真似て構成した順序関係 -/
inductive Nat.myle (n : Nat) : Nat → Prop where
/-- 常に `n ≤ n` が成り立つ -/
| refl : myle n n
/-- `n ≤ m` ならば `n ≤ m + 1` が成り立つ -/
| step {m : Nat} : myle n m → myle n (m + 1)
@[inherit_doc] infix:50 " ≤ₘ " => Nat.myle
-- 順序関係について帰納法を回して証明をする例
example {m n k : Nat} (h₁ : m ≤ₘ n) (h₂ : n ≤ₘ k) : m ≤ₘ k := by
induction h₂ with
| refl => assumption
| @step l h₂ ih =>
apply Nat.myle.step (by assumption)
generalizing 構文
時として、帰納法の仮定が弱すぎることがあります。
/-- 階乗関数 -/
def factorial (n : Nat) : Nat :=
match n with
| 0 => 1
| n + 1 => factorial n * (n + 1)
/-- 階乗関数の末尾再帰バージョン -/
@[grind]
def factorialTR (n : Nat) : Nat :=
aux n 1
where
@[grind] aux (n acc : Nat) :=
match n with
| 0 => acc
| n + 1 => aux n (acc * (n + 1))
example (n acc : Nat) : factorialTR.aux n acc = acc * factorialTR.aux n 1 := by
induction n with
| zero => simp [factorialTR.aux]
| succ n ih =>
dsimp [factorialTR.aux]
-- 得られている帰納法の仮定では `.aux` の2つめの引数は `acc` だが
guard_hyp ih : factorialTR.aux n acc = acc * factorialTR.aux n 1
-- これは示すべきことに合致しないので使えない。
guard_target = factorialTR.aux n (acc * (n + 1)) = acc * factorialTR.aux n (1 * (n + 1))
sorry
generalizing 構文で帰納法の仮定の中の特定の変数を一般化することができて、そうすると証明が通るようになることがあります。
example (n acc : Nat) : factorialTR.aux n acc = acc * factorialTR.aux n 1 := by
induction n generalizing acc with
| zero => simp [factorialTR.aux]
| succ n ih =>
dsimp [factorialTR.aux]
-- 帰納法の仮定が強くなっている！！
guard_hyp ih : ∀ (acc : Nat), factorialTR.aux n acc = acc * factorialTR.aux n 1
grind
ただし注意点として、induction .. generalizing 構文を実行するとき、帰納法を行う変数が一般化される変数に依存していてはいけないというルールがあります。
/-- 偶数を表す帰納的述語 -/
inductive Even : Nat → Prop where
| zero : Even 0
| succ : {n : Nat} → Even n → Even (n + 2)
/- error: Variable `m` cannot be generalized because the induction target depends on it -/
example {n m : Nat} (h : Even (n + m)) (hm : Even m) : Even n := by
induction hm generalizing m
完全帰納法
時には、より強い帰納法が必要なこともあります。 強い帰納法とは、 たとえば以下のような形式で表されるような帰納法のことです。
∀ n, (∀ k < n, P (k)) → P (n)を示す。- したがって
∀ n, P (n)である。
これは超限帰納法の特別な場合で、完全帰納法や累積帰納法とも呼ばれます。
自然数の場合は、Nat.strongRecOn を using キーワードに渡せば使うことができます。
/-- 素数であるという述語 -/
@[simp]
def IsPrime (n : Nat) := 1 < n ∧ ∀ k, 1 < k → k < n → ¬ k ∣ n
@[grind ->]
theorem IsPrime_pos (n : Nat) (h : IsPrime n) : 1 < n := by
simp_all
/-- 1より大きい任意の自然数は素因数を持つ -/
theorem exists_prime_factor (n : Nat) (hgt : 1 < n) :
∃ k, IsPrime k ∧ k ∣ n := by
induction n using Nat.strongRecOn with
| ind n ih =>
-- nが素数であるかどうかによって場合分けをする。
by_cases hprime : IsPrime n
case pos =>
-- nが素数であるときは明らか。
grind [Nat.dvd_refl]
-- 以下、nは素数でないとする。
-- nは素数ではないのでnより真に小さい約数を持つ。
have ⟨k, _, _, _⟩ : ∃ k, 1 < k ∧ k < n ∧ k ∣ n := by
simp_all
-- 帰納的に、k には素因数が存在するとしてよい。
have := ih k ‹k < n›
-- k ∣ n なので、k に素因数があるなら n にも存在する。
grind [Nat.dvd_trans]
再帰的定理
Lean では、実は帰納法を使用するのに必ずしも induction は必要ありません。場合分けの中で示されたケースを帰納法の仮定として使うことができます。これは recursive theorem(再帰的定理) と呼ばれることがあります。1
theorem sum_exp (n : Nat) : sum n = n * (n + 1) / 2 := by
match n with
-- `n = 0` の場合
| 0 => grind [= sum]
-- `0` から `n` までの自然数で成り立つと仮定する
| n + 1 =>
-- 仮定から、`n` について成り立つ
have ih := sum_exp n
-- 仮定を適用して展開する
simp [sum, ih]
-- 後は可換環の性質から示せる
grind
have で宣言された命題の証明の中では、この方法は使用できません。
theorem sample : True := by
have h : ∀ n, sum n = n * (n + 1) / 2 := by
intro n
match n with
| 0 => grind [= sum]
| n + 1 =>
-- h 自身を参照することができない
fail_if_success have ih := h n
sorry
trivial
再帰的定理のテクニックと termination_by を組み合わせるとかなり複雑な帰納法も実行できますが、引数の中に帰納法で使用する変数が入っていなければいけません。induction タクティクを使うと、引数の中に入っていない変数に対しても帰納法を回すことができるので、それは induction タクティクの強みであると言えるでしょう。
/-- 空でない自然数の部分集合は最小元を持つ。 -/
theorem Nat.exists_min_of_exists (P : Nat → Prop) (h : ∃ n, P n) :
∃ m, P m ∧ ∀ n, P n → m ≤ n := by
-- 存在が主張されている `n ∈ P` の大きさに対する帰納法によって証明する。
obtain ⟨n, hn⟩ := h
induction n using Nat.strongRecOn with
| ind n ih =>
-- n が最小元のときは明らか。
-- n は最小元ではないとして良い。
by_cases hsmall : ∃ k, k < n ∧ P k
case neg => grind
case pos =>
-- n は最小元ではないので、n より小さい P の要素 k が存在する。
obtain ⟨k, hk⟩ := hsmall
-- k に対して帰納法の仮定から、最小元 m が存在する。
obtain ⟨m, hm⟩ := ih k (show k < n from by grind) (show P k from by grind)
-- この m が求めるものであった。
exists m
よくあるエラー
induction タクティクを使ったときに、index in target's type is not a variable というエラーが出ることがあります。
/-- 偶数であることを表す帰納的述語 -/
inductive MyEven : Nat → Prop where
| zero : MyEven 0
| succ : {n : Nat} → MyEven n → MyEven (n + 2)
/-
error: Invalid target: Index in target's type is not a variable (consider using the `cases` tactic instead)
0
-/
example (h : MyEven 0) : True := by
induction h
これは型族の添え字が変数ではないから起こることです。その証拠に、変数にするとエラーにならなくなります。
example (n m : Nat) (h : MyEven (n + m)) : True := by
generalize n + m = x at h
induction h
· trivial
· trivial
-
lean公式ブログの Functional induction についての記事 で recursive theorem という言葉が使われています。 ↩
induction’
induction' は induction タクティクの構文が異なるバージョンです。
import Mathlib.Tactic -- 大雑把に import する
/-- `0` から `n` までの和を計算する。
多項式関数として表現する都合で、返り値は `Rat` にしてある。-/
def sum (n : Nat) : Rat :=
match n with
| 0 => 0
| n + 1 => (n + 1) + sum n
example (n : Nat) : sum n = n * (n + 1) / 2 := by
-- `n` についての帰納法で示す
induction' n with n ih
-- `n = 0` の場合
case zero =>
simp_all [sum]
-- `0` から `n` までの自然数で成り立つと仮定する
case succ =>
-- `sum` の定義を展開し、帰納法の仮定を適用する
simp [sum, ih]
-- 後は可換環の性質から示せる
ring
完全帰納法
時には、より強い帰納法が必要なこともあります。 強い帰納法とは、 たとえば以下のような形式で表されるような帰納法のことです。
∀ n, (∀ k < n, P (k)) → P (n)を示す。- したがって
∀ n, P (n)である。
これは超限帰納法の特別な場合で、完全帰納法や累積帰納法とも呼ばれます。
/-- フィボナッチ数列の通常の定義をそのまま Lean の関数として書いたもの -/
def fibonacci : Nat → Nat
| 0 => 0
| 1 => 1
| n + 2 => fibonacci n + fibonacci (n + 1)
/-- フィボナッチ数列の線形時間の実装 -/
def fib (n : Nat) : Nat :=
(loop n).1
where
loop : Nat → Nat × Nat
| 0 => (0, 1)
| n + 1 =>
let p := loop n
(p.2, p.1 + p.2)
/-- `fib` が `fibonacci` と同じ漸化式を満たすことを証明する -/
@[simp]
theorem fib_add (n : Nat) : fib n + fib (n + 1) = fib (n + 2) := by rfl
/-- `fibonacci` と `fib` は同じ結果を返す -/
example : fibonacci = fib := by
-- 関数が等しいことを示すので、引数 `n` が与えられたとする
ext n
-- `n` についての強い帰納法で示す
induction' n using Nat.strong_induction_on with n ih
match n with
| 0 => rfl
| 1 => rfl
| n + 2 => simp_all [fibonacci]
intro
intro は数学で慣習的に行われる
P → Qを示すときに最初にPを仮定する∀ x ∈ A, P(x)を示すときに最初にx ∈ Aが与えられたと仮定する
といった導入(introduction)を行います。
具体的には、intro は次のような挙動をします。
- ゴールが
⊢ P → Qという形であるときにPをローカルコンテキストに追加して、ゴールを⊢ Qに変える。 - ゴールが
⊢ ∀ x, P xという形であるときにxをローカルコンテキストに追加してゴールを⊢ P xに変える。
variable (P Q R : Prop)
example (hPQ: P → Q) (hQR: Q → R) : P → R := by
-- 示したいことが `P → R` なので、`P` だと仮定する
intro hP
-- 仮定 `hPQ : P → Q` と `hP : P` から `Q` が導かれる
have hQ : Q := hPQ hP
-- 仮定 `hQR : Q → R` と `hQ : Q` から `R` が導かれる
exact hQR hQ
特定の形の命題に対しての使用法
A ∧ B → C
前提が論理積の形をしていた場合、無名コンストラクタで仮定を分解することができます。
example {S : Prop} (hPR : P → R) (hQR : Q → S) : P ∧ Q → R ∧ S := by
-- `P ∧ Q` だと仮定する
intro ⟨hP, hQ⟩
constructor
. exact hPR hP
. exact hQR hQ
A ∨ B → C
前提が論理和の形をしていた場合、次のように分解することができます。
example (hPR : P → R) (hQR : Q → R) : P ∨ Q → R := by
intro
-- `P` が成り立つとする
| Or.inl hP =>
exact hPR hP
-- `Q` が成り立つとする
| Or.inr hQ =>
exact hQR hQ
rcases を使って分解することも一般的です。
example (hPR : P → R) (hQR : Q → R) : P ∨ Q → R := by
intro h
rcases h with hP | hQ
-- `P` が成り立つとする
case inl =>
exact hPR hP
-- `Q` が成り立つとする
case inr =>
exact hQR hQ
また、rintro を使うと上記の intro と rcases の組み合わせを同時に行うことができます。
example (hPR : P → R) (hQR : Q → R) : P ∨ Q → R := by
rintro (hP | hQ)
-- `P` が成り立つとする
case inl =>
exact hPR hP
-- `Q` が成り立つとする
case inr =>
exact hQR hQ
∀ x, P x
intro は ∀ x, P x という形のゴールにも使用できます。
example (P Q : Nat → Prop) (h : ∀ n, P n ↔ Q n) : ∀ y, P (y + 1) → Q (y + 1) := by
-- 任意の `y` について示すので、`intro` で `y` を導入する
-- そして `P (y + 1) → Q(y + 1)` を示したいので、`P (y + 1)` を仮定する
intro y hyP
-- `Q (y + 1)` を示せば良い
show Q (y + 1)
-- 同値を使ってゴールを書き換える
rw [← h]
-- 仮定 `P (y + 1)` より従う
assumption
否定 ¬ について
Lean では否定 ¬ P は P → False として定義されているので、ゴールが ¬ P のときに intro すると P が仮定に追加されて、ゴールが False に変わります。
False は矛盾を導けば証明できます。
example (h: P → Q) : ¬Q → ¬P := by
-- 示したいことが `¬Q → ¬P` なので、`¬Q` だと仮定する
-- そうするとゴールが `¬P` になるので、
-- さらに `intro` を行って仮定 `hP : P` を導入する
intro hnQ hP
-- 矛盾を示したい
show False
-- `hP : P` と `h : P → Q` から `Q` が導かれる
have hQ : Q := h hP
-- `hQ : Q` と `hnQ : ¬Q` から矛盾が導かれる
contradiction
関数の構成
より一般的には、intro は関数の構成に使うことができます。
intro が全称命題 ∀ x, P x や含意 P → Q を統一的に扱うことができるのも、これらが Lean 内部で関数として扱われているからです。
variable {α : Type}
/-- `intro` による恒等関数の構成 -/
def f : α → α := by
intro x
exact x
example (x : α) : f x = id x := by dsimp [f]
itauto
itauto は、直観主義論理(intuitionistic logic)の範囲内でトートロジー(tautology)を証明します。「Contraction-free sequent calculi for intuitionistic logic」という1992年の論文に基づいて実装されています。
命題論理を扱うタクティクには他にも tauto がありますが、あちらは選択原理 Classical.choice を勝手に使用することがあります。なお選択原理は Lean が標準で用意している公理のひとつで、排中律 P ∨ ¬ P や二重否定の除去 ¬¬ P → P を示すのに必要です。
import Mathlib.Tactic.ITauto
import Mathlib.Tactic.Tauto
-- 命題とその否定は同値ではない
-- itauto で示したバージョン
theorem not_iff_not₀ (p : Prop) : ¬ (p ↔ ¬ p) := by itauto
-- tauto で示したバージョン
theorem not_iff_not₁ (p : Prop) : ¬ (p ↔ ¬ p) := by tauto
-- 選択原理に依存していない
/- info: 'not_iff_not₀' does not depend on any axioms -/
#print axioms not_iff_not₀
-- 勝手に選択原理を使用している！
/- info: 'not_iff_not₁' depends on axioms: [propext, Classical.choice, Quot.sound] -/
#print axioms not_iff_not₁
tauto と同様に、扱えるのは命題論理のトートロジーだけです。述語論理は扱えないことがあります。
/-- 排中律の二重否定 -/
example (P : Prop) : ¬¬ (P ∨ ¬ P) := by
-- `itauto` で示せる
itauto
example : ∀ (P : Prop), ¬¬ (P ∨ ¬ P) := by
-- 量化されただけで `itauto` で示せなくなる
fail_if_success itauto
intro P hP
-- 量化がなくなると扱えるようになる
itauto
left
ゴールが ⊢ P ∨ Q であるとき、left はゴールを ⊢ P に変えます。類似のタクティクに right があります。
variable (P Q : Prop)
example (hP : P) : P ∨ Q := by
left
-- ゴールが変わる
guard_target =ₛ P
assumption
left, right を使わない方法
以下に示すように、Or.inl は a から a ∨ b を得る関数です。また Or.inr は b から a ∨ b を得る関数です。これを使うことで left や right を使わずに証明できます。
#check (Or.inl : P → P ∨ Q)
#check (Or.inr : Q → P ∨ Q)
example (hP: P) : P ∨ Q := by
apply Or.inl
exact hP
linarith
linarith は線形算術(linear arithmetic)を行うタクティクです。Fourier-Motzkin elimination を用いて、線形な(不)等式系から矛盾を導こうとします。一般に、ゴールが False でないときにはゴールの否定を仮定に加えることで、ゴールを閉じようとします。
import Mathlib.Tactic.Linarith -- `linarith` のために必要
example (x y : ℚ) (h1: x = 2 * y) (h2 : - x + 2 * y = 1) : False := by
linarith
example (x y z : ℚ) (h1 : 2 * x < 3 * y) (h2 : -4 * x + 2 * z < 0) :
12 * y - 4 * z ≥ 0 := by
linarith
linarith はローカルコンテキストにある命題を読むので、linarith が通らないとき、追加で補題を示すことで解決することがあります。
example (x : ℚ) : id x ≤ x := by
-- `linarith` で示すことはできない
fail_if_success linarith
have : id x = x := rfl
-- `id x = x` だと教えてあげると `linarith` で示せる
linarith
また、使ってほしい補題を直接渡すこともできます。
example (x y : ℚ) (h : x ≤ y) (pos : 0 ≤ x) : x + x ^ 2 ≤ y + y ^ 2 := by
-- `linarith` では示せない
fail_if_success linarith
-- `linarith` 単独で扱えない部分、つまり `x ^ 2 ≤ y ≤ 2` を示すための
-- 補題を引数で渡してやると通る
linarith [pow_le_pow_left₀ pos h 2]
舞台裏
linarith は一般に、[CommRing R], [LinearOrder R], [IsStrictOrderedRing R] のインスタンスであれば使用することができます。ここで linear order とは全順序のことです。
variable {R : Type} [CommRing R] [LinearOrder R] [IsStrictOrderedRing R]
variable (x y z : R)
-- `R` 上の不等式だが `linarith` で証明できる
example (h1 : 2 * x < 3 * y) (h2 : -4 * x + 2 * z < 0) :
12 * y - 4 * z ≥ 0 := by
linarith
linarith と他のタクティクの使い分け
1 < 2 のような簡単な数値のみの不等式の場合、norm_num や simp でも証明ができます。
同じ命題を示すのに複数のタクティクがあるわけですが、タクティク実行にかかる時間に違いがあります。
実行環境により正確な実行時間は異なりますが、linarith は比較的重いタクティクです。
#time example : 1 < 2 := by simp
#time example : 1 < 2 := by norm_num
#time example : 1 < 2 := by linarith
mvcgen
mvcgen は、モナディック(monadic)なプログラムを含むゴールを 検証条件(verification condition) に分解して処理するようなタクティクです。ただしここでいう検証条件とは、do 構文の背景にあるモナドを参照しない部分ゴールのことを指します。1
do 構文を使って手続き的に定義された関数に対して証明を行うことを支援するフレームワークが Lean には組み込まれているのですが、mvcgen はその一部です。
シンプルな使用例として、リストの和を for ループを使って計算する関数が、標準ライブラリに用意されている関数と等しいことを mvcgen を使って証明する例を紹介します。このとき、ループを回しても変わらずに成り立ち続ける 不変条件(invariant) を指定することに注意してください。
import Lean
-- mvcgen はまだ使用しないでというwarningを消す
set_option mvcgen.warning false
variable {α : Type} [Zero α] [Add α]
variable [@Std.Associative α (· + ·)] [@Std.LawfulIdentity α (· + ·) 0]
/-- for文を使って命令的に実装された、和を計算する関数 -/
@[grind]
def sumDo (l : List α) : α := Id.run do
let mut out := 0
for i in l do
out := out + i
return out
-- 証明の中で必要になる補題
@[grind =, simp]
theorem List.sum_append_singleton {l : List α} {x : α} :
(l ++ [x]).sum = l.sum + x := by
induction l with simp_all <;> grind
-- `scoped` で用意された表記法を有効にする
open Std.Do
/-- 手続き的に実装した和の計算と、標準ライブラリに用意されている`List.sum`関数が等しい -/
theorem sumImp_eq_sumFunc (l : List α) : sumDo l = List.sum l := by
-- モナディックに実装されている（`Id.run do ...`）部分にフォーカスする
generalize h : sumDo l = s
apply Id.of_wp_run_eq h
-- 検証条件に分解する
mvcgen
-- ループ全体を通して成り立たせたい不変条件を指定する
-- * `out` は `let mut` で導入した変数の現在値を表す
-- * `cursor` は `List.Cursor` で，リストを接頭辞 `cursor.prefix` と接尾辞 `cursor.suffix` に
-- 分割して表すデータ構造。どこまでループが進んだかを追跡する。
-- つまり進捗（ループの到達位置）を記録する。
-- 不変条件は「`out` が接頭辞の総和を保持している」こと。
-- 記法 `⌜p⌝` は，命題 `p : Prop` をアサーション言語に埋め込む。
case inv1 => exact ⇓⟨cursor, out⟩ => ⌜cursor.prefix.sum = out⌝
-- `mleave` はある決まった `simp` 補題に対する `simp only [...] at *` の糖衣構文。
all_goals mleave
-- 各反復で不変条件が保たれることを示す
case vc1.step pref cur suff hyp b ih =>
-- 与えられているリストは
-- * `pref`: for 文で既に処理された部分
-- * `cur`: 今回処理する要素
-- * `suff`: まだ処理されていない残りの部分
-- に分割されているという仮定がある。
guard_hyp hyp :ₛ l = pref ++ cur :: suff
-- そして今まで処理された部分に関しては不変条件が成り立っているという帰納法の仮定がある
guard_hyp ih :ₛ pref.sum = b
-- このとき、現在の要素 `cur` を処理した後でも不変条件が成り立つことを示せばよい
guard_target =ₛ (pref ++ [cur]).sum = b + cur
-- 証明そのものは `grind` で終わる
grind
-- ループ開始時に不変条件が成り立つことを示す
case vc2.pre =>
-- 空リストの和が 0 であることを示せばよい
guard_target =ₛ ([] : List α).sum = 0
grind
-- ループ終了時の不変条件から目標の性質が従うことを証明する
case vc3.post.success result hr =>
-- ループ終了時には「処理された部分」は全体なので、
-- 不変条件から次が成りたつ
guard_hyp hr :ₛ l.sum = result
-- したがって目標も成り立つ
grind
構文
mvcgen タクティクを使用するとき、まず不変条件を指定し、そのあとに all_goals mleave を実行するというパターンがよく見られます。そこで、定型文を減らすために以下のように mvcgen invariants という構文が用意されています。
import Std.Tactic.Do
set_option mvcgen.warning false
open Std.Do
/-- 素朴に実装されたべき乗関数 -/
def naiveExpo (x n : Nat) : Nat := Id.run do
let mut result := 1
for _ in [:n] do
result := result * x
return result
theorem naiveExpo_correct (x n : Nat) : naiveExpo x n = x ^ n := by
generalize h : naiveExpo x n = r
apply Id.of_wp_run_eq h
mvcgen invariants
-- 不変条件を指定する
-- ここでは`cursor`がループの進捗を表していて、
-- `cursor.prefix.length`はこれまでにループが回った回数を表す
-- `result`はループ内で更新される変数の値を表す
· ⇓⟨cursor, result⟩ => ⌜result = x ^ cursor.prefix.length⌝
with simp_all <;> grind -- すべてのゴールに対して `mleave` に加えて `simp_all <;> grind` を適用してみる
機能
早期リターン
for 文の途中で return 文があるような場合でも、mvcgen は対応できます。その場合は不変条件の書き方が変わって、「早期終了した場合」と「早期終了せず継続する場合」の２つを考慮する必要が生じます。
import Lean
open Std.Do
set_option mvcgen.warning false
variable {α : Type} [Hashable α] [DecidableEq α]
/-- リストに重複がないか判定する。
true なら重複がない。false なら重複がある。-/
def nodupDo (l : List α) : Bool := Id.run do
let mut seen : Std.HashSet α := ∅
for x in l do
if x ∈ seen then
return false
seen := seen.insert x
return true
/-- `nodupDo` の結果は標準ライブラリに用意されている `Nodup` と一致する -/
theorem nodup_correct (l : List α) : nodupDo l ↔ l.Nodup := by
generalize h : nodupDo l = r
apply Id.of_wp_run_eq h
mvcgen invariants
· Invariant.withEarlyReturnNewDo
-- forループの１ステップが平常終了したとき。
-- プログラム中の可変変数`seen`は、現在までに見た要素の集合`cursor.prefix`に等しく、
-- かつ`cursor.prefix`は重複がない。
(onContinue := fun cursor seen => ⌜(∀ x, x ∈ seen ↔ x ∈ cursor.prefix) ∧ cursor.prefix.Nodup⌝)
-- 早期リターンしたとき。
-- 返り値は`false`であり、かつ`l`に重複がある
(onReturn := fun ret seen => ⌜ret = false ∧ ¬l.Nodup⌝)
with grind
break 文
for ループを途中で抜ける構文としては return 文のほかに break 文もあります。break 文に対しては retrun 文のように不変条件を指定する方法がそれ専用に用意されていはいないため、不変条件に工夫が必要になります。具体的には、通常通りループが終了した場合でも break で抜けた場合でも成り立つような不変条件を考える必要があります。
以下は、takeWhile 関数を早期リターンと break のそれぞれを使って実装し、それぞれの不変条件を比較する例です。2
import Lean
open Std.Do
variable {α : Type}
/-- `takeWhile` を命令型スタイルで実装したもの。
`return` 文を使うバージョン。
（ただし、`result ++ [x]` の部分が非効率的で、あまり高速ではない）
-/
def takeWhileReturn (p : α → Bool) (l : List α) : List α := Id.run do
let mut result := []
for x in l do
if ! p x then
return result
result := result ++ [x]
return result
set_option mvcgen.warning false
@[grind =, simp]
theorem takeWhile_simplify_false (P : α → Bool) (pref suff : List α) (cur : α) (h : P cur = false) :
List.takeWhile P (pref ++ cur :: suff) = List.takeWhile P pref := by
fun_induction List.takeWhile with simp_all
@[grind =>]
theorem takeWhile_eq_self_iff_all (P : α → Bool) (l : List α) :
List.takeWhile P l = l ↔ l.all P := by
fun_induction List.takeWhile with simp_all
theorem takeWhileReturn_spec (p : α → Bool) (l : List α) :
takeWhileReturn p l = l.takeWhile p := by
generalize h : takeWhileReturn p l = r
apply Id.of_wp_run_eq h
mvcgen invariants
· Invariant.withEarlyReturnNewDo
(onContinue := fun cursor result =>
⌜result = cursor.prefix ∧ result = cursor.prefix.takeWhile p⌝)
(onReturn := fun ret result => ⌜ret = result ∧ result = l.takeWhile p⌝)
with grind
/-- `takeWhile` を命令型スタイルで実装したもの。
`break` 文を使うバージョン。-/
def takeWhileBreak (p : α → Bool) (l : List α) : List α := Id.run do
let mut result := []
for x in l do
if ! p x then
break
result := result ++ [x]
return result
theorem takeWhileBreak_spec (p : α → Bool) (l : List α) :
takeWhileBreak p l = l.takeWhile p := by
generalize h : takeWhileBreak p l = r
apply Id.of_wp_run_eq h
mvcgen invariants
· ⇓⟨cursor, result⟩ =>
-- `return` を使うものと比較すると、不変条件に `cursor.suffix = []` が追加されている。
-- これは `break` でループを抜けた場合にも成り立つようにするための工夫
⌜(cursor.suffix = [] ∨ result = cursor.prefix) ∧ result = cursor.prefix.takeWhile p⌝
with grind
continue 文
continue 文がある場合も break 文の場合と同様で、continue で抜けた場合でも通常終了した場合でも常に成り立つような不変条件を考えて指定します。
import Lean
variable {α : Type}
/-- `continue` 文を使って実装した `Array.filter` -/
def Array.filterDo (p : α → Bool) (l : Array α) : Array α := Id.run do
let mut res : Array α := #[]
for x in l do
if ! p x then
continue
res := res.push x
return res
-- 証明のための補題を用意する
attribute [grind =] Array.toList_inj
attribute [grind _=_] Array.toList_filter
open Std.Do
set_option mvcgen.warning false
theorem Array.filterDo_spec (p : α → Bool) (l : Array α) :
l.filterDo p = l.filter p := by
generalize h : l.filterDo p = r
apply Id.of_wp_run_eq h
mvcgen invariants
· ⇓⟨cursor, res⟩ => ⌜res.toList = cursor.prefix.filter p⌝
with grind
複数の可変変数
for ループの中で複数の可変変数が let mut で導入されている場合には、以下のように不変条件の書き方を変えることで対応できます。3
import Lean
open Std.Do
/-- フィボナッチ数列の仕様 -/
@[grind]
def fibSpec (n : Nat) : Nat :=
match n with
| 0 => 0
| 1 => 1
| k + 2 => fibSpec (k + 1) + fibSpec k
/-- 手続き的に実装された、フィボナッチ数列の実装 -/
def fibImpl (n : Nat) : Nat := Id.run do
if n = 0 then
return 0
let mut a := 0
let mut b := 1
for _i in [1:n] do
let a' := a
a := b
b := a' + b
return b
-- `mvcgen` はまだ安定していないという警告を消す
set_option mvcgen.warning false
theorem fibImpl_eq_fibSpec (n : Nat) : fibImpl n = fibSpec n := by
generalize h : fibImpl n = r
apply Id.of_wp_run_eq h
mvcgen invariants
-- 不変条件の指定。
-- `a` と `b` はループ内で更新される可変変数。
-- `let mut` で定義された順番に拘束される。
-- `cursor.pos` はループの進捗を表していて、いままでにループが回った回数を表す。
· ⇓⟨cursor, a, b⟩ => ⌜a = fibSpec cursor.pos ∧ b = fibSpec (cursor.pos + 1)⌝
with grind
二重の for ループ
for ループがネストしていても mvcgen は対応できます。その場合は、外側のループと内側のループそれぞれについて不変条件を指定する必要があります。また、内側のループの不変条件において、外側のループの進捗状況に言及することができます。
import Lean
open Std.Do
-- `α` は加法的な可換モノイドであると仮定する
variable {α : Type} [Add α] [Zero α]
variable [@Std.Associative α (· + ·)] [@Std.LawfulIdentity α (· + ·) 0]
variable [@Std.Commutative α (· + ·)]
/-- 二重リストに対する和を計算する、関数型スタイルで定義された関数 -/
@[grind]
def doubleSum (l : List (List α)) : α :=
l.foldr (fun xs acc => acc + xs.sum) 0
/-- 二重リストに対する和を計算する、命令型スタイルで定義された関数 -/
def doubleSumDo (l : List (List α)) : α := Id.run do
let mut result := 0
for sublist in l do
for x in sublist do
result := result + x
return result
set_option mvcgen.warning false
@[grind =, simp]
theorem List.sum_append_singleton {l : List α} {x : α} :
(l ++ [x]).sum = l.sum + x := by
induction l with simp_all <;> grind
/-- `doubleSum` は `append` を和に変換する -/
@[grind =]
theorem doubleSum_append {l1 l2 : List (List α)} :
doubleSum (l1 ++ l2) = doubleSum l1 + doubleSum l2 := by
induction l1 with grind
theorem doubleSum_spec (l : List (List α)) : doubleSumDo l = doubleSum l := by
generalize h : doubleSumDo l = r
apply Id.of_wp_run_eq h
mvcgen invariants
-- 外側のループについての不変条件。
-- `cursor.prefix` はこれまでに外側の`for`ループで見てきた部分を指している
· ⇓⟨cursor, result⟩ => ⌜result = doubleSum cursor.prefix⌝
-- 内側のループについての不変条件。
· ⇓⟨cursor, result⟩ => by
expose_names -- すべての死んだ変数に名前を付ける
-- `pref` は外側のループで今まで見てきた部分を表していて、
-- `l = pref ++ (cur :: suff)` が成り立つ。
guard_hyp h_1 :ₛ l = pref ++ cur :: suff
-- `cursor` は内側のループの進捗を表している。
exact ⌜result = doubleSum pref + (cursor.prefix).sum⌝
with grind
while ループ
mvcgen タクティクは while ループにも対応しています。for ループと異なり while ループは停止することが明らかではないため、停止することを保証するために「ループごとに減少していくもの」を不変量とともに指定します。
import Lean
open Std.Do
set_option mvcgen.warning false
/-- 繰り返し自乗法で自然数の指数計算を行う -/
def binaryExpo (root n : Nat) : Nat := Id.run do
let mut x := root
let mut y := 1
let mut e := n
while 0 < e do
if e % 2 = 1 then
y := x * y
e := e - 1
else
x := x * x
e := e / 2
return y
#guard binaryExpo 2 10 = 1024
#guard binaryExpo 23 0 = 1
private theorem pow_zero_for_grind {n a : Nat} (h : a = 0) : n ^ a = 1 := by
simp_all
grind_pattern pow_zero_for_grind => n ^ a where
guard a = 0
@[grind =]
private theorem pow_mul_self_halve_of_even (x e : Nat) (he : e % 2 = 0) :
(x * x) ^ (e / 2) = x ^ e := calc
_ = (x ^ 2) ^ (e / 2) := by grind
_ = x ^ (2 * (e / 2)) := by grind [Nat.pow_mul]
_ = x ^ e := by grind
@[grind! ·]
private theorem mul_pow_sub_one_of_odd (x e : Nat) (he : 0 < e) :
x * x ^ (e - 1) = x ^ e := calc
_ = x ^ (1 + (e - 1)) := by grind
_ = x ^ e := by grind
theorem binaryExpo_spec (root n : Nat) : binaryExpo root n = root ^ n := by
generalize h : binaryExpo root n = r
apply Id.of_wp_run_eq h
mvcgen invariants
· -- while ループが停止することを保証するために
-- e がループごとに減少していくと指定する
fun ⟨x, y, e⟩ => ⟨e⟩
· -- 不変条件を指定する。
-- for ループとは異なり各ループの開始ごとに「次も続けるのか」の判定が来るので、
-- どちらであるかに応じて２つの不変条件を記述する必要がある。
post⟨ fun
| .inl (x, y, e) => ⌜y * x ^ e = root ^ n⌝
| .inr (_x, y, _e) => ⌜y = root ^ n⌝ ⟩
with grind
使用例
農民の掛け算
農民の掛け算は、２で割る操作と２倍する操作と足し算だけで掛け算を行うアルゴリズムです。mvcgen を使って、このアルゴリズムが正しいことを証明する例を紹介します。4
import Lean
set_option mvcgen.warning false
open Std.Do
/-- 農民の掛け算。２で割る操作と２倍する操作と足し算だけで掛け算を行う -/
def peasantMul (x y : Nat) : Nat := Id.run do
let mut curX := x
let mut curY := y
let mut prod := 0
for _ in [0:x] do
if curX % 2 = 1 then
prod := prod + curY
curX := curX / 2
curY := curY * 2
if curX = 0 then
break
return prod
theorem Nat.div_pow_add (x a b c : Nat) : x / c ^ (a + b) = (x / c ^ a) / c ^ b := by
grind [Nat.div_div_eq_div_mul, Nat.pow_add]
-- 左辺をみかけたらインスタンス化する
-- ただし a, b, c が 0 や 1 になっているときは(無駄なので)インスタンス化しない
grind_pattern Nat.div_pow_add => x / c ^ (a + b) where
a =/= 0
b =/= 0
c =/= 0
c =/= 1
-- a / b を見かけたらインスタンス化する
grind_pattern Nat.div_add_mod' => a / b where
not_value a
is_value b
b =/= 0
b =/= 1
@[grind =]
theorem Nat.div_pow_self_two_eq_zero (n : Nat) : n / 2 ^ n = 0 := by
have : n < 2 ^ n := Nat.lt_two_pow_self
simp_all
example (x y : Nat) : peasantMul x y = x * y := by
generalize h : peasantMul x y = s
apply Id.of_wp_run_eq h
mvcgen invariants
· ⇓⟨cursor, curX, curY, prod⟩ =>
⌜curX = x / 2 ^ cursor.pos ∧ curX * curY + prod = x * y⌝
with (simp at * <;> grind)
繰り返し自乗法による指数計算
繰り返し自乗法(binary exponentiation)は、x ^ n を計算する際に指数部を２冪の和に分解することで計算を高速化するアルゴリズムのことです。mvcgen を使って、このアルゴリズムが正しいことを証明する例を紹介します。5
import Lean
/-- 繰り返し自乗法で自然数の指数計算を行う -/
def binaryExpo (root n : Nat) : Nat := Id.run do
let mut x := root
let mut y := 1
let mut e := n
for _ in [0:n] do
if e % 2 = 1 then
y := x * y
e := e - 1
else
x := x * x
e := e / 2
if e = 0 then
break
return y
open Std.Do
set_option mvcgen.warning false
@[grind =]
theorem Nat.Grind.pow_zero {n a : Nat} (h : a = 0) : n ^ a = 1 := by
simp_all
@[grind =]
theorem Nat.pow_mul_self_halve_of_even (x e : Nat) (he : e % 2 = 0) :
(x * x) ^ (e / 2) = x ^ e := calc
_ = (x ^ 2) ^ (e / 2) := by grind
_ = x ^ (2 * (e / 2)) := by grind [Nat.pow_mul]
_ = x ^ e := by grind
@[grind! ·]
theorem Nat.mul_pow_sub_one_of_odd (x e : Nat) (he : e % 2 = 1) :
x * x ^ (e - 1) = x ^ e := calc
_ = x ^ (1 + (e - 1)) := by grind
_ = x ^ e := by congr; grind
theorem binaryExpo_spec (root n : Nat) :
binaryExpo root n = root ^ n := by
generalize h : binaryExpo root n = r
apply Id.of_wp_run_eq h
mvcgen invariants
-- 不変条件の指定。
-- ローカル可変変数は定義順に拘束される。
· ⇓⟨cursor, x, y, e⟩ => ⌜y * x ^ e = root ^ n ∧ e + cursor.pos ≤ n⌝
with grind
先頭から足して和が0未満になる時点があるか判定する
整数のリストに対して、前から順に足していったときに和が0未満になる瞬間があるかチェックする関数について仕様を証明する例を紹介します。6
import Std.Tactic.Do
/-- `operations : List Int` を先頭から順に足していったときに、
どこかの時点で合計値が 0 未満になることがあるか判定する -/
def belowZero (operations : List Int) : Bool := Id.run do
let mut balance := 0
for op in operations do
balance := balance + op
if balance < 0 then
return true
return false
namespace List
variable {α : Type}
/-- リスト `l` の先頭からある部分までを取り出せば述語 `P : List α → Prop` が成り立つ -/
def HasPrefix (P : List α → Prop) (l : List α) : Prop := ∃ n, P (l.take n)
/-- `HasPrefix` の定義を言い換えるだけの定義 -/
theorem hasPrefix_iff {P : List α → Prop} {l : List α} :
l.HasPrefix P ↔ ∃ n, P (l.take n) := by
simp [HasPrefix]
@[simp, grind =]
theorem hasPrefix_nil {P : List α → Prop} : [].HasPrefix P ↔ P [] := by
simp [hasPrefix_iff]
@[simp, grind =>]
theorem hasPrefix_of_nil {P : List α → Prop} {l : List α} (h : P []) : l.HasPrefix P := by
exists 0
@[simp, grind =>]
theorem hasPrefix_of_all {P : List α → Prop} {l : List α} (h : P l) : l.HasPrefix P := by
exists l.length
simpa
@[grind =]
theorem hasPrefix_cons {P : List α → Prop} {a : α} {l : List α} :
(a :: l).HasPrefix P ↔ P [] ∨ l.HasPrefix (fun l' => P (a :: l')) := by
constructor
· intro ⟨n, hn⟩
by_cases nzero : n = 0
· simp_all
· right
exists n - 1
suffices a :: take (n - 1) l = take n (a :: l) from by
simp_all
grind [take_cons]
· rintro (h | ⟨⟨n, hn⟩⟩)
· grind
· exists n + 1
@[grind =]
theorem hasPrefix_append {P : List α → Prop} {l l' : List α} :
(l ++ l').HasPrefix P ↔ l.HasPrefix P ∨ l'.HasPrefix (fun l'' => P (l ++ l'')) := by
induction l generalizing P with grind [= HasPrefix]
@[grind =]
theorem sum_append_singleton {α : Type} {l : List α} {x : α}
[Add α] [Zero α] [@Std.Associative α (· + ·)] [@Std.LawfulIdentity α (· + ·) 0] :
(l ++ [x]).sum = l.sum + x := by
induction l with simp_all <;> grind
end List
open Std.Do
set_option mvcgen.warning false
theorem belowZero_iff {l : List Int} : belowZero l ↔ l.HasPrefix (fun l => l.sum < 0) := by
generalize h : belowZero l = res
apply Id.of_wp_run_eq h
mvcgen invariants
-- 早期終了がある場合の不変条件
· Invariant.withEarlyReturnNewDo
-- 早期終了しなかった場合、現在の接頭辞の和が `balance` に等しく、
-- かつ「今までループで見てきた部分」は「和が0未満になる接頭辞」を持たない
(onContinue := fun cursor (balance : Int) =>
⌜balance = cursor.prefix.sum ∧ ¬ cursor.prefix.HasPrefix (fun l => l.sum < 0)⌝)
-- 早期終了した場合、返り値の`ret`は`true`であり、かつ和が0未満になる接頭辞がある
(onReturn := fun ret (balance : Int) => ⌜ret = true ∧ l.HasPrefix (fun l => l.sum < 0)⌝)
with grind
足してゼロになるペアがあるか判定する
整数のリストに対して、足してゼロになるペアが存在するか判定する関数について仕様を証明する例を紹介します。7
import Std.Data.HashSet.Lemmas
import Std.Tactic.Do
open Std Do
variable {α : Type}
/-- リストに、与えられた条件を満たすペアが存在する -/
def List.Any₂ (P : α → α → Prop) (l : List α) : Prop := ¬ l.Pairwise (fun x y => ¬P x y)
@[simp, grind ·]
theorem List.not_any₂_nil {P : α → α → Prop} : ¬List.Any₂ P [] := by
simp [List.Any₂]
@[simp, grind =]
theorem List.any₂_cons {P : α → α → Prop} {x : α} {xs : List α} :
List.Any₂ P (x :: xs) ↔ (∃ y ∈ xs, P x y) ∨ List.Any₂ P xs := by
grind [List.Any₂, pairwise_cons]
@[simp, grind =]
theorem List.any₂_append {P : α → α → Prop} {xs ys : List α} :
List.Any₂ P (xs ++ ys) ↔ List.Any₂ P xs ∨ List.Any₂ P ys ∨ (∃ x ∈ xs, ∃ y ∈ ys, P x y) := by
grind [List.Any₂]
/-- 与えられた整数のリストの中に、足してゼロになるペアがあるか判定する -/
def pairsSumToZero (l : List Int) : Bool := Id.run do
let mut seen : HashSet Int := ∅
for x in l do
if -x ∈ seen then
return true
seen := seen.insert x
return false
set_option mvcgen.warning false
theorem pairsSumToZero_spec (l : List Int) :
pairsSumToZero l = true ↔ l.Any₂ (fun a b => a + b = 0) := by
generalize h : pairsSumToZero l = r
apply Id.of_wp_run_eq h
mvcgen invariants
· Invariant.withEarlyReturnNewDo
(onContinue := fun cursor seen =>
⌜(∀ x, x ∈ seen ↔ x ∈ cursor.prefix) ∧ ¬cursor.prefix.Any₂ (fun a b => a + b = 0)⌝)
(onReturn := fun r b => ⌜r = true ∧ l.Any₂ (fun a b => a + b = 0)⌝)
with simp_all <;> grind
ICan’tBelieveItCanSort
P.Y.Fung さんによる「Is this the simplest (and most surprising) sorting algorithm ever?」という論文で、非常に単純かつ動作が理解しにくいソートアルゴリズムが提案されました。ここでは、その論文での呼称にならってそのアルゴリズムを ICan’tBelieveItCanSort と呼ぶことにします。mvcgen を使って、このアルゴリズムが配列を正しくソートすることを証明することができます。8
import Std.Tactic.Do
import Batteries.Data.Array
open Std
variable {α : Type}
variable [LT α] [DecidableLT α]
def ICan'tBelieveItCanSort (arr : Array α) := Id.run do
let n := arr.size
let mut vec := arr.toVector
for hi : i in [0:n] do
for hj : j in [0:n] do
if vec[i] < vec[j] then
vec := vec.swap i j
return vec.toArray
open Std.Do
set_option mvcgen.warning false
theorem ICan'tBelieveItCanSort_perm (arr : Array α) : Array.Perm (ICan'tBelieveItCanSort arr) arr := by
generalize h : ICan'tBelieveItCanSort arr = x
apply Id.of_wp_run_eq h
mvcgen invariants
· ⇓⟨_cursor, vec⟩ => ⌜Array.Perm arr vec.toArray⌝
· ⇓⟨_cursor, vec⟩ => ⌜Array.Perm arr vec.toArray⌝
with grind [Array.Perm.trans, Array.Perm.symm, Array.swap_perm]
@[grind =]
theorem Vector.toArray_extract_size {α : Type} {n : Nat} (v : Vector α n) :
v.toArray.extract 0 n = v.toArray := by
grind
@[grind! =>]
theorem List.Cursor.pos_le_length' (n : Nat) (xs : [0:n].toList.Cursor) : xs.pos ≤ n := by
have : xs.prefix.length + xs.suffix.length = n := by
simp [← List.length_append, xs.property]
grind only
@[grind <=]
theorem Array.sorted_take_swap {α : Type} [LE α] [IsPreorder α] {arr : Array α}
(s t : Nat) (hs : s < arr.size) (ht : t < arr.size)
(h : Array.Pairwise (· ≤ ·) (arr.take s))
(le1 : arr[s] ≤ arr[t])
(le2 : ∀ (i : Nat) (_ : i < t), arr[i] ≤ arr[s])
: Array.Pairwise (· ≤ ·) ((arr.swap s t).take s) := by
simp [Array.pairwise_iff_getElem] at h ⊢
grind
@[grind <=]
theorem Array.pairwise_take_succ {α : Type} {R : α → α → Prop} {arr : Array α}
(k : Nat) (hk : k < arr.size)
(h : Array.Pairwise R (arr.take k))
(le : ∀ (i : Nat) (_ : i < arr.size), R arr[i] arr[k])
: Array.Pairwise R (arr.take (k + 1)) := by
simp [Array.pairwise_iff_getElem] at h ⊢
grind
variable [LE α] [IsLinearOrder α] [LawfulOrderLT α]
theorem ICan'tBelieveItCanSort_sorted (arr : Array α) : ICan'tBelieveItCanSort arr |>.Pairwise (· ≤ ·) := by
generalize h : ICan'tBelieveItCanSort arr = x
apply Id.of_wp_run_eq h
mvcgen invariants
| inv1 => ⇓⟨cursor, vec⟩ =>
-- 外側のforループの不変条件。
-- 外側ループが要素`i ∈ [0:n]`を処理する反復の開始時に、
-- `vec[0...i]`はソート済みである。
let i := cursor.pos
⌜vec.take i |>.toArray.Pairwise (· ≤ ·)⌝
| inv2 i _ _ _ _ => ⇓⟨cursor, vec⟩ =>
-- 内側のforループの不変条件。
-- 外側ループが要素`i ∈ [0:n]`を処理する反復の途中で、
-- 内側ループが要素`j ∈ [0:n]`を処理する反復の開始時に、以下が成立。
-- * `vec[0...i]`はソート済み
-- * `vec[0...j]`のすべての要素は`vec[i]`以下
let j := cursor.pos
⌜(vec.take i |>.toArray.Pairwise (· ≤ ·)) ∧
∀ k (_ : k < j), vec[k]'(by grind) ≤ vec[i]'(by grind)⌝
with (simp at *; grind)
-
このページの内容およびコード例は、公式のドキュメントである Verifying imperative programs using mvcgen を参考にしています。 ↩
-
このコード例は Lean の公式 Zulip の new monadic program verification framework というトピックにおける Sebastian Graf さんの投稿を参考にしました。 ↩
-
このコード例は、Lean のリポジトリの doLogicTests.lean の内容を参考にしました。 ↩
-
このコード例は Lean の公式 Zulip の new monadic program verification framework というトピックにおける pandaman さんの投稿を参考にしました。 ↩
-
このコード例は Lean の公式 Zulip の new monadic program verification framework というトピックにおける Aaron Liu さんの投稿を参考にしました。 ↩
-
このコード例は human-eval-lean の
HumanEval3.leanのコードを参考にしています。 ↩ -
このコード例は human-eval-lean の
HumanEval43.leanのコードを参考にしています。 ↩ -
このコード例は Lean の公式 Zulip の new members > mvcgen doesn’t produce any invariant goals というトピックにおける Anthony Wang さんの投稿を参考にしています。 ↩
native_decide
native_decide は、式を評価したときに判ることを示すことができます。
たとえば、Lean では再帰関数 f を定義したらそれが停止することの証明を求められますが、それを sorry で回避したとしましょう。このとき f の具体的な値を評価することは #eval! を使えば可能ですが、その値をとることを rfl で証明することはできなくなります。
しかし、native_decide を使うと証明が可能です。
/-- Euclide のアルゴリズム -/
def gcd (m n : Nat) : Nat :=
if m = 0 then
n
else
gcd (n % m) m
-- 停止性を証明しない
decreasing_by sorry
-- 値を評価することはできる
#eval! gcd 42998431 120019
-- `rfl` では証明できない
-- これは停止性を証明していないため
#check_failure (by rfl : gcd 42998431 120019 = 1)
-- `native_decide` ならば証明できる
#check (by native_decide : gcd 42998431 120019 = 1)
補足すると、native_decide を使用するときにはコンパイラを信頼することになります。具体的には（定理ごとに個別の）追加の公理が使用されます。
theorem native_thm : Nat.gcd 42998431 120019 = 1 := by native_decide
/- info: 'native_thm' depends on axioms: [native_thm._native.native_decide.ax_1_1] -/
#print axioms native_thm
注意
native_decide を使うことは安全ではなく、native_decide を使うと簡単に False を示す（つまり矛盾を導く）ことができてしまいます。つまり、native_decide を使った証明は正式な証明ではありません。しかし、native_decide を使用した不正な証明は #print axioms コマンドを確認することで見破ることができます。
def one := 1
-- 間違った実装をわざと提供する
@[implemented_by one] def zero := 0
theorem zero_ne_eq_one : False := by
have : zero ≠ one := by decide
-- native_decide は implemented_by を真に受けるので、
-- 実際には間違いだが示せてしまう
have : zero = one := by native_decide
contradiction
/- info: 'zero_ne_eq_one' depends on axioms: [zero_ne_eq_one._native.native_decide.ax_1_1] -/
#print axioms zero_ne_eq_one
nlinarith
nlinarith は 非線形(non-linear)な式も扱えるように linarith にいくつか前処理を追加したものです。
import Mathlib.Tactic.Linarith -- `linarith` や `nlinarith` を使うため
variable (a b : ℕ)
example (h : a ≤ b) : a ^ 2 ≤ b ^ 2 := by
-- `linarith` では示すことができない
fail_if_success linarith
nlinarith
norm_cast
norm_cast は、型キャスト（ある型からある型への変換）を簡約するタクティクです。
詳細については論文 「Simplifying Casts and Coercions」 などを参照してください。
import Mathlib.Tactic
-- `x, m, n` は自然数とする
variable (x m n : ℕ)
example (left : (x : ℝ) < ↑m + ↑n) (right : ↑m + ↑n < (x : ℝ) + 1) : False := by
-- `linarith` では示すことができない
fail_if_success linarith
-- `omega` でも示すことができない
fail_if_success omega
-- 仮定の `left` と `right` は実数上の不等式だが、
-- 自然数上の不等式と解釈できるはずである。
-- `norm_cast` はそれを実行してくれる。
norm_cast at left right
-- 仮定が自然数における不等式に変わった！
guard_hyp left : x < m + n
guard_hyp right : m + n < x + 1
-- 後は `omega` で示せる
omega
[norm_cast] 属性によるカスタマイズ
命題に [norm_cast] 属性を付与することにより、norm_cast タクティクでできることを増やすことができます。
/-- 自然数のペア -/
def IntBase := Nat × Nat
/-- 自然数のペアが「整数として等しい」という同値関係 -/
def IntBase.equiv : IntBase → IntBase → Prop :=
fun (a₁, b₁) (a₂, b₂) => a₁ + b₂ = b₁ + a₂
/-- `IntBase` と同値関係 `IntBase.equiv` をペアにする -/
instance IntBase.sequiv : Setoid IntBase where
r := IntBase.equiv
iseqv := by
constructor
case refl =>
intro ⟨x, y⟩
dsimp [IntBase.equiv]
ac_rfl
case symm =>
intro ⟨x, y⟩ ⟨x', y'⟩ h
dsimp [IntBase.equiv] at *
omega
case trans =>
intro ⟨x, y⟩ ⟨x', y'⟩ ⟨x'', y''⟩ hxy hyz
dsimp [IntBase.equiv] at *
omega
/-- 自前で定義した整数 -/
abbrev MyInt := Quotient IntBase.sequiv
/-- 自然数を `myInt` と解釈する関数 -/
def MyInt.ofNat (n : Nat) : MyInt := ⟦(n, 0)⟧
@[grind inj]
theorem MyInt.ofNat_inj : Function.Injective MyInt.ofNat := by
intro n m h
dsimp [MyInt.ofNat] at h
have h' : IntBase.equiv (n, 0) (m, 0) := by
apply Quotient.exact h
suffices IntBase.equiv (n, 0) (m, 0) from by
grind [= IntBase.equiv]
assumption
/-- 型強制を定義 -/
instance : Coe Nat MyInt where
coe := MyInt.ofNat
/-- 型キャストの簡約を行う補題。`ℕ` の項が `myInt` として等しいなら、元から等しい。 -/
theorem MyInt_eq {x y : ℕ} : (x : MyInt) = (y : MyInt) ↔ x = y := by
grind
-- `[norm_cast]` 属性の制約として、
-- 登録する補題の中には型強制が含まれていなくてはいけない
-- たとえば `↑` など
/-
error: Invalid `norm_cast` lemma: At least one coe function must appear in the left-hand side
MyInt.ofNat x = MyInt.ofNat y
Note: coe functions are registered using the `[coe]` attribute
-/
attribute [norm_cast] MyInt_eq
-- `[coe]` 属性を付与し、`MyInt.ofNat` を型キャストを行う関数として認識させる
attribute [coe] MyInt.ofNat
example {x y z : ℕ} (h : (x : MyInt) = (y : MyInt)) : x + z = y + z := by
norm_cast at h
-- `norm_cast` の効果が出ていない
guard_hyp h : (x : MyInt) = (y : MyInt)
simp [MyInt_eq] at h
omega
-- `norm_cast` に使ってもらえるように登録する
attribute [norm_cast] MyInt_eq
example {x y z : Nat} (h : (x : MyInt) = (y : MyInt)) : x + z = y + z := by
norm_cast at h
-- `norm_cast` で簡約できるようになった！
guard_hyp h : x = y
omega
norm_num
norm_num は、数値リテラルを含む式を正規化するタクティクです。変数を含まない等式・不等式・整除関係等を示したいときに使います。
import Mathlib.Tactic.NormNum
example : 37 * 23 + 19 = 870 := by
norm_num
example : ¬ (15 : Int) ^ 2 < 100 := by
norm_num
example : (2 : ℚ) / 3 + 1 / 6 = 5 / 6 := by
norm_num
norm_num は仮定に対しても使うことができます。
たとえば norm_num at h とすると、仮定 h の中の数値式を正規化します。
example {n : Nat} (h : 3 ∣ n + 4) : 3 ∣ n + 1 := by
-- 最初は、h とゴールは違う式なので証明できない
fail_if_success assumption
-- `n + 4` は `n + 1 + 3` と同じなので、3 で割った余りは変わらない
norm_num at h
assumption
norm_num は norm_num [f] のように補題や定義を渡して使うこともできます。
渡した補題で式を展開してから、数値計算を正規化します。
def taxIncluded (price : Nat) (taxRate : Nat) : Nat :=
price + price * taxRate / 100
example : taxIncluded 1200 10 = 1320 := by
-- 最初は norm_num だけでは証明が終わらない
fail_if_success solve |
norm_num
norm_num [taxIncluded]
nth_rw
rw はマッチした項をすべて置き換えてしまいます。特定の項だけを書き換えたいとき、nth_rw が使用できます。対象の式中に現れる順番を1始まりで指定することで、項を指定します。
import Mathlib.Tactic.NthRewrite
import Mathlib.Algebra.Group.Basic -- 群の定義を import する
-- `G` は群
variable (G : Type) [Group G]
example (a b : G) : a * b⁻¹ = 1 ↔ a = b := by
-- `one_mul: 1 * b = b` を使って `b` を `1 * b` に書き換えたい
try
-- 仮に普通に `rw` しようとすると…
rw [← one_mul b]
-- 左側にある `b` まで一緒に置き換わってしまった！
show a * (1 * b)⁻¹ = 1 ↔ a = 1 * b
-- これは失敗
fail
-- `b` は2回出現するが、2番目だけ置き換える
nth_rw 2 [← one_mul b]
-- `mul_inv_eq_iff_eq_mul: a * b⁻¹ = c ↔ a = c * b` を使う
exact mul_inv_eq_iff_eq_mul
obtain
obtain は、分解して何かを得るときに使います。たとえばローカルコンテキストの h : P ∧ Q から hP : P と hQ : Q を取り出したり、h : ∃ e : X, P e から e : X と hP : P e を取り出したりすることができます。
基本的には obtain <パターン> : 型または命題 := 証明項 という構文で使用します。型は省略することができます。
-- 論理積の分解
example (P Q : Prop) (h : P ∧ Q) : True := by
obtain ⟨hP, hQ⟩ : P ∧ Q := h
-- 分解することができた
guard_hyp hP : P
guard_hyp hQ : Q
trivial
-- P は X 上の述語
variable (X : Type) (P : X → Prop)
-- 存在命題の分解
example (h : ∃ e : X, P e) : True := by
obtain ⟨e, hP⟩ := h
-- 分解することができた
guard_hyp e : X
guard_hyp hP : P e
trivial
obtain に与えることのできるパターンは rcases に与えられるパターンと同様で、一般の帰納型を分解することができます。
inductive Sample where
| foo (x y : Nat)
| bar (z : String)
example (s : Sample) : True := by
obtain ⟨x, y⟩ | ⟨z⟩ := s
case foo =>
-- `x`, `y` が取り出せている
guard_hyp x : Nat
guard_hyp y : Nat
trivial
case bar =>
-- `z` が取り出せている
guard_hyp z : String
trivial
omega
omega タクティクは、「The omega test: a fast and practical integer programming algorithm for dependence analysis」に基づいて実装されたタクティクで、整数や自然数の線形制約を扱う能力を持ちます。
似たタクティクに linarith がありますが、linarith が有理数や実数を扱うのに長けているのに対して、omega は自然数や整数を扱うのに長けています。
import Mathlib.Tactic.Linarith
import Mathlib.Tactic.Ring
example (n m : Nat) : n * m = ((n + m) ^ 2 - n ^ 2 - m ^ 2 ) / 2 := by
-- `(n + m) ^ 2` を展開する
ring_nf
-- `n * m` の部分は、一般の `x` に置き換えて証明してもよい
generalize n * m = x
-- つまり、以下を示せばよい
show x = (x * 2 + n ^ 2 + m ^ 2 - n ^ 2 - m ^ 2) / 2
-- これは `linarith` では示せない
fail_if_success linarith
-- `omega` では示せる
omega
Lean では自然数同士の引き算は整数同士の引き算とは異なる結果になって厄介なのですが、omega はこの問題を上手く処理します。たとえば、以下は linarith では示すことができない線形な命題です。
section
variable (a b : Nat)
example (h : (a - b : Int) ≤ 0) : (a - b = 0) := by
-- `linarith` では示すことができない
fail_if_success linarith
-- `omega` では示すことができる
omega
example (h : a > 0) : (a - 1) + 1 = a := by
fail_if_success linarith
omega
example (h : a / 2 < b) : a < 2 * b := by
fail_if_success linarith
omega
example : (a - b) - b = a - 2 * b := by
fail_if_success linarith
omega
end
omega は整数や自然数の整除関係を扱うこともできます。
example {a b c : ℤ} : 3 ∣ (100 * c + 10 * b + a) ↔ 3 ∣ (c + b + a) := by omega
example {a b c : ℕ} : 3 ∣ (100 * c + 10 * b + a) ↔ 3 ∣ (c + b + a) := by omega
補題を渡す構文
omega に明示的に補題を渡す構文を自作することができます。
open Lean Elab.Tactic in
/-- `omega [lem₁, lem₂, .. , lemₙ]` のように、カンマ区切りで補題を渡す構文 -/
elab "omega" "[" s:term,* "]" : tactic => do
for term in s.getElems do
evalTactic <| ← `(tactic| have := $term)
evalTactic <| ← `(tactic| omega)
/-- テスト用の構造体 -/
structure Test where
val : Nat
property : 30 ≤ val
example (x y : Test) : 2 ≤ x.val + y.val := by
-- 通常の omega では示すことができない
fail_if_success omega
-- 補題を渡す構文を使えば示せる
omega [x.property, y.property]
order
order タクティクは、順序関係を扱うための専用のタクティクです。Preorder クラスや PartialOrder, LinearOrder クラスのインスタンスに対して使用することができます。
import Mathlib.Tactic.Order
section
/- ## Preorder に対して使用する例 -/
variable {α : Type} [Preorder α] (a b c d : α)
example (h1 : a ≤ b) (h2 : b ≤ c) : a ≤ c := by
order
example (h1 : a ≤ b) (h2 : b ≤ c) (h3 : c ≤ d) : a ≤ d := by
order
example (h1 : a ≤ b) (h2 : ¬ (a < b)) : b ≤ a := by
order
end
section
/- ## PartialOrder に対して使用する例 -/
variable {α : Type} [PartialOrder α] (a b c d : α)
example (h1 : a ≤ b) (h2 : ¬ (a < b)) : a = b := by
order
example : ¬ (a < a) := by
order
end
section
/- ## LinearOrder に対して使用する例 -/
variable {α : Type} [LinearOrder α] (a b c d : α)
example (h1 : ¬ (a < b)) (h2 : ¬ (b < a)) : a = b := by
order
end
plausible
plausible は、証明しようとしているゴールが間違っていないかランダムに例を生成してチェックし、反例を見つけるとエラーで警告するタクティクです。
import Plausible
variable (a b : Nat)
/- error: Found a counter-example! -/
example (h : 0 ≤ a + b) : 1 ≤ a := by
plausible (config := { quiet := true })
sorry
100 個のテストケースでテストして反例が見つからなかった場合、ギブアップして sorry と同様にはたらきます。
/- warning: Gave up after failing to generate values that fulfill the preconditions 100 times. -/
example (a : Nat) : a ≠ a → a ≤ 1 := by
plausible
同様の機能を持つコマンドとして #test コマンドがあります。
引数
引数として、オプションを渡すことができます。
numInst
numInst を設定すると、ギブアップするまでに行うテストの回数を指定することができます。
/- warning: Gave up after failing to generate values that fulfill the preconditions 10 times. -/
example (a : Nat) : a ≠ a → a ≤ 1 := by
plausible (config := { numInst := 10 })
カスタマイズ
組み込みではない、自作の型に対して plausible は準備なしには使うことができません。
open Plausible
/-- 自前で `Nat` を模倣して定義した型 -/
inductive MyNat where
| zero
| succ (n : MyNat)
deriving Repr
example : ∀ (a b : MyNat), a = b := by
-- `plausible` は最初使うことができない
fail_if_success plausible
sorry
ここで定義した MyNat のような自作の型に対して plausible を使用するためには、いくつかのステップがあります。
1. Shrinkable クラスのインスタンスにする
plausible が反例を見つけたときに、「より小さな反例を見つける」ことができるようにするために、Shrinkable 型クラスのインスタンスを実装する必要があります。
/-- 引数よりも小さい `MyNat` の項のリストを返す -/
def MyNat.shrink : MyNat → List MyNat
| zero => []
| succ n => n :: n.shrink
instance : Shrinkable MyNat where
shrink := MyNat.shrink
2. Arbitrary クラスのインスタンスにする
plausible はテストするための要素をランダムに生成します。その方法を指定するのが Arbitrary 型クラスです。Arbitrary 型クラスは deriving ハンドラを持っているので、自動的にインスタンスを生成することができます。
deriving instance Arbitrary for MyNat
Arbitrary 型クラスのインスタンスであることは、#sample コマンドで確認できます。
#sample MyNat
3. 決定可能にする
plausible でテストが行えるようにするためには、テスト対象の主張が決定可能（Decidable 型クラスのインスタンス）である必要があります。
-- `MyNat` 同士の比較を決定可能にする
deriving instance DecidableEq for MyNat
以上の準備で plausible が使えるようになります。
/- error: Found a counter-example! -/
example : ∀ (a b : MyNat), a = b := by
-- `plausible` が使えるようになった！
plausible (config := { quiet := true})
positivity
positivity は、0 ≤ x や 0 < x や x ≠ 0 という形のゴールを証明するためのタクティクです。
import Mathlib.Tactic
variable {a b : ℤ}
example (ha : 3 < a) : 0 ≤ a ^ 3 + a := by
-- linarith では示せない
fail_if_success linarith
-- omega でも示せない
fail_if_success omega
positivity
example (ha : 1 < a) : 0 < |3 + a| := by
-- linarith では示せない
fail_if_success linarith
-- omega でも示せない
fail_if_success omega
positivity
ゴールを構成する式がすべて数値的な下界を持つならば、positivity は再帰的に適用されます。
example : 0 ≤ max (-3) (b ^ 2) := by positivity
example : 0 < max (-3) ((1 + a) ^ 2 + 3) := by positivity
example : 0 < |2 + a| + |3 + b| + |1 + a ^ 2| := by positivity
push_cast
push_cast タクティクは、ゴールや仮定に含まれる型強制を「内側へ押し込む」はたらきをします。
import Mathlib.Tactic
example (m n : ℕ) (h : m ≥ n) : n + ((m - n) : ℕ) = (m : ℤ) := by
-- 示すべき命題には `m - n : ℕ` を整数 `ℤ` に型キャストしたものが含まれている。
guard_target =ₛ ↑n + ↑(m - n) = (m : ℤ)
-- この状態では整数と自然数の演算が混ざっていてややこしいので、
-- `ring` だけで示すことはできない。
fail_if_success solve
| ring
-- 自然数の引き算は整数での引き算とは異なる定義がされているが、
-- この場合は `h : m ≥ n` という仮定があるので、`m - n : ℤ` と一致する。
-- この変換を `push_cast` タクティックで行うことができる。
push_cast [h]
-- 型キャストが「内側に押し込まれ」て、整数の話になった。
show ↑n + (↑m - ↑n) = (m : ℤ)
-- `ring` で示せるようになった！
ring
norm_cast や zify などの型キャスト系のタクティクと併用されることもあります。
example (m n : ℕ) (h : n ≥ m) : (n + m) * (n - m) = n * n - m * m := by
-- 整数にキャストする
zify
-- 自然数の引き算が含まれているので、`ring` では示せない
fail_if_success solve
| ring
-- 仮定 `h : n ≥ m` を使って、`n - m` と `n * n - m * m` を整数にキャストする
push_cast [h, show n * n ≥ m * m from by bound]
-- `ring` で示せるようになった！
ring
push
push タクティクは、演算子などを式の内側に押し込む(push)ためのタクティクです。
否定の押し込み
典型的な push の使用例は、ドモルガン則を使って否定(negation)を式の中に押し込むことです。
デフォルトの設定だと、次のように変形します。
¬ (P ∧ Q)はP → ¬ Qに変形。¬ ∀ x, P xは∃ x, ¬ P xに変形。
import Mathlib.Tactic
example (P Q : Prop) (h : P → Q) : ¬ (P ∧ ¬ Q) := by
-- ドモルガン則を適用して、`¬` を内側に押し込む
push Not
-- デフォルトの設定だと `P → Q` に変形される
show P → Q
exact h
以下の例は、「酔っぱらいのパラドクス」として有名な命題です。
-- `People` という空ではない集合がある
variable {People : Type} [Inhabited People]
-- 人が飲んでいるかどうかを表す述語を考える
variable (isDrinking : People → Prop)
/-- ある `x` という人が存在して、以下が成り立つ:
「`x` が飲んでいるのであれば、すべての人が飲んでいる」 -/
example : ∃ (x : People), isDrinking x → ∀ (y : People), isDrinking y := by
-- 「すべての人が飲んでいる」かどうかで場合分けをする
by_cases h : ∀ (y : People), isDrinking y
case pos =>
-- すべての人が飲んでいると仮定したので、
-- 任意の誰かを `x` として取ればよい
exists default
intro _
assumption
case neg =>
-- 「すべての人が飲んでいる」が偽の場合。
-- このとき、飲んでいない人が存在する。
push Not at h
-- このとき、飲んでいない人を `x` として取れば前件が偽になるので条件を満たす
replace ⟨x, h⟩ := h
exists x
simp_all
distrib オプション
option で +distrib を渡すと、¬ (p ∧ q) を ¬ p ∨ ¬ q に変形します。
example (P Q : Prop) (h : P → Q) : ¬ (P ∧ ¬ Q) := by
-- ドモルガン則を適用して、`¬` を内側に押し込む
push +distrib Not
-- goal が論理和の形になる
show ¬ P ∨ Q
-- 場合分けで示す
by_cases hP : P
· right
exact h hP
· left
assumption
他の使用例
以下は、push タクティクを使って所属関係 _ ∈ _ を式の内側に押し込む例です。
x ∈ A ∪ B を x ∈ A ∨ x ∈ B に変形することができます。
open Set in
example {α : Type} (x y : α) (s : Set α) :
x ∈ ({y} : Set α) ∪ sᶜ ↔ x = y ∨ ¬ x ∈ s := by
push _ ∈ _
-- ∈ が内側に押し込まれる
guard_target =ₛ x = y ∨ x ∉ s ↔ x = y ∨ x ∉ s
simp
qify
qify は自然数や整数に関する命題を有理数に関する命題にキャストします。
import Mathlib.Tactic.GCongr
import Mathlib.Tactic.Linarith
import Mathlib.Tactic.Qify -- `qify` を使うために必要
example (x : Nat) (h : x ≥ 1) : 2 * x ≥ 2 := by
-- 自然数から有理数にキャストする
qify at h ⊢
-- 次の状態になる
guard_hyp h : 1 ≤ (x : ℚ)
have : (2 : ℚ) ≤ 2 * x := calc
_ = 2 * 1 := by simp
_ ≤ 2 * (x : ℚ) := by gcongr
assumption
用途
自然数や整数は体ではないので、体を想定したタクティクが使えないことがあります。
qify で有理数にキャストすることで、そのようなタクティクが使えるようになり、証明が楽になることがあります。
example (n m : Nat) (x : Rat) (hx : x > 0) (h : n * m = x) : m > 0 := by
-- 最初は `nlinarith` が使えない
fail_if_success nlinarith
-- 有理数にキャストする
qify
-- `nlinarith` が使えるようになった！
nlinarith
rcases
rcases は cases をパターンに従って再帰的(recursive)に適用します。cases の上位互換という立ち位置です。
variable (P Q R : Prop)
example : P ∨ Q → (P → R) → (Q → R) → R := by
intro h hPR hQR
-- 場合分けをする
rcases h with hP | hQ
· apply hPR hP
· apply hQR hQ
-- 論理積 ∧ に対しても使える
example : P ∧ Q → Q ∧ P := by
-- `h: P ∧ Q` と仮定する
intro h
-- `h: P ∧ Q` を `hP: P` と `hQ: Q` に分解する
rcases h with ⟨hP, hQ⟩
-- `Q ∧ P` を証明する
exact ⟨hQ, hP⟩
rcases は一般には ⟨x₁, x₂, ...⟩ | ⟨y₁, y₂, ...⟩ | ... という記法で帰納型の分解が可能です。
inductive Sample where
| foo (x y : Nat)
| bar (z : String)
example (s : Sample) : True := by
rcases s with ⟨x, y⟩ | ⟨z⟩
case foo =>
-- `x`, `y` が取り出せている
guard_hyp x : Nat
guard_hyp y : Nat
trivial
case bar =>
-- `z` が取り出せている
guard_hyp z : String
trivial
rfl パターン
rcases のパターンには rfl も使えます。等式の仮定 h : a = b に対して rcases h with rfl と書くと、b が a に書き変わります。つまり、rw タクティクで書き換える手間が省けます。
example {a b c : Nat} (h : a = b) : a + c = b + c := by
rcases h with rfl
-- `b` が `a` に書き変わる
guard_target =ₛ a + c = a + c
rfl
example {a b : Nat} (h : a = b ∧ b = 3) : a = 3 := by
rcases h with ⟨rfl, hb⟩
-- `b` が `a` に書き変わる
guard_target =ₛ a = 3
exact hb
refine
refine は exact タクティクと同様に機能しますが、メタ変数(? から始まる変数で、プレースホルダとして機能する)を受け入れて新しいゴールを生成するという違いがあります。
example {P Q : Prop} (hP : P) (hQ : Q) : P ∧ Q := by
-- 穴埋め形式で証明を作ることができる
refine ⟨?_, hQ⟩
-- ゴールが `⊢ P` になる
show P
exact hP
用途
refine はかなり一般的なタクティクであり、様々な場面で使うことができます。
constructor の一般化として
refine は constructor の代わりに使うこともできます。実際 refine は constructor よりも柔軟で、⊢ P ∧ Q ∧ R のような形のゴールは constructor よりも簡潔に分割できます。
example {P Q R : Prop} (hP : P) (hQ : Q) (hR : R) : P ∧ Q ∧ R := by
-- ゴールを３つに分割する
refine ⟨?_, ?_, ?_⟩
· exact hP
· exact hQ
· exact hR
constructor を使った場合、一度に２つのゴールに分割することしかできません。
example {P Q R : Prop} (hP : P) (hQ : Q) (hR : R) : P ∧ Q ∧ R := by
constructor
· exact hP
· constructor
· exact hQ
· exact hR
apply の一般化として
h : P → Q という命題があって、ゴールが ⊢ Q であるとき refine h ?_ は apply h と同様に機能するので、refine で apply を代用することができます。
example {P Q : Prop} (hPQ : P → Q) (hP : P) : Q := by
refine hPQ ?_
-- ゴールが `⊢ P` になる
show P
refine hP
自明なケースを示す
ゴールが ⊢ P ∧ Q であり、P が成り立つことが自明であった場合、いちいち ⊢ P と ⊢ Q の２つのサブゴールを作って示すのは面倒に思えます。こうしたとき、refine を使うとサブゴールを生成せずにゴールを単に ⊢ Q に変えることができます。
example {P Q : Prop} (hP : P) (hQ : ¬ P ∨ Q) : P ∧ Q := by
-- `P` が成り立つのは自明なので、`Q` だけ示せばよい
refine ⟨by assumption, ?_⟩
-- ゴールが `⊢ Q` になる
guard_target =ₛ Q
simp_all
場合分けの他の枝で示したことを再利用する
メタ変数を使って、場合分けの他の枝で示したことを再利用することができます。
example {P Q : Prop} (h1 : P → Q) (h2 : P → Q → False) (hP : P) : False := by
refine h2 ?a ?_ -- `?a` は `P` の証明を要求するメタ変数
· exact hP
· exact h1 ?a -- `?a` を `P` の証明の代替として使うことができる
example {P : Prop} (h : P → P → False) (hP : P) : False := by
-- 本来２つの場合分けがあるが、証明が全く同じなので１つの証明で済ませることができる
refine h ?a ?a
· exact hP
rel
rel は、一般化された合同性を用いてゴールを分解し、命題を代入することで示すタクティクです。ゴールが関係(relation)について述べているときに使用できます。
典型的には不等式を代入して適用し、不等式を示します。
import Mathlib.Tactic
example {a b c d : Nat} (h1 : a ≤ b) (h2 : c ≤ d) : a + c ≤ b + d := by
rel [h1, h2]
下記で示すように、ゴールが関係式でないときにはエラーになります。
/- error: rel failed, goal not a relation -/
example (x : Nat) : Nat := by rel [x]
なお、基本的に rel よりも gcongr の方が強いタクティクです。gcongr は rel とは異なり、ローカルコンテキストから必要な命題を自動的に読み込むことができます。
example {a b c d : Nat} (h1 : a ≤ b) (h2 : c ≤ d) : a + c ≤ b + d := by
-- 引数を与えないと通らない
fail_if_success rel []
-- `gcongr` は必要な仮定をローカルコンテキストから取得する
gcongr
rename_i
rename_i は、✝ がついてアクセス不能になった変数に名前を付けることができます。
一般に、rename_i x₁ x₂ ... xₐ により、最初の a 個のアクセス不能変数に名前を付けることができます。
example {n : Nat} (h0 : n ≠ 0) : n ≥ 1 := by
cases n
case zero =>
contradiction
case succ _ =>
-- `n✝` が infoview に表示される
-- これは `succ` の引数に名前をつけなかったため
-- 名前をつける
rename_i n
show Nat.succ n ≥ 1
simp
必要な変数をアクセス不能にしてしまうこと自体を避けるべきであるため、rename_i を使うべき場面は多くありませんが rename_i の使用によりコードが簡単になることがあります。
variable {m : Nat}
/-- 自然数が0でも1でも2でもなければ3以上。
`case` をネストさせて示した場合。-/
example (h0 : m ≠ 0) (h1 : m ≠ 1) (h2 : m ≠ 2) : 3 ≤ m := by
cases m with
| zero => contradiction
| succ m =>
cases m with
| zero => contradiction
| succ m =>
cases m with
| zero => contradiction
| succ m =>
show 3 ≤ m + 3
simp
/-- 自然数が0でも1でも2でもなければ3以上。
`rename_i` を使って示した場合。-/
example (h0 : m ≠ 0) (h1 : m ≠ 1) (h2 : m ≠ 2) : 3 ≤ m := by
-- 仮定から `m = 0, 1, 2` のときは考えなくていい
repeat
cases m
contradiction
rename_i m
-- 自然数 `m` に対して `3 ≤ m + 3` を示せばよい
clear h0 h1 h2
show 3 ≤ m + 3
-- これは明らか
simp
/-- 補足。おそらく最も簡潔な証明。 -/
example (h0 : m ≠ 0) (h1 : m ≠ 1) (h2 : m ≠ 2) : 3 ≤ m := by
let .succ m := m
let .succ m := m
let .succ m := m
show 3 ≤ m + 3
simp
repeat
repeat は、指定したタクティクを失敗するまで繰り返します。
variable (P Q R S T : Prop)
example : (P → Q) → (Q → R) → (R → S) → (S → T) → P → T := by
repeat intro
repeat apply_assumption
replace
replace は have と同じく補題を入手するためのタクティクですが、have とは異なりローカルコンテキストにすでにある命題を置き換えることができます。
have を使った場合、ローカルコンテキストにすでに h : P がある状態で、再び h という名前で別の命題を示すと、古い方の h はアクセス不能になって † が付いた状態になってしまいます。
replace であれば、古い方が新しい方に置き換えられ、† の付いた命題は出現しません。
import Mathlib.Tactic -- 大雑把に import する
/-- `5 * n` が偶数なら、`n` も偶数 -/
example : ∀ (n : ℤ), Even (5 * n) → Even n := by
intro n hn
-- `Even (5 * n)` という仮定を分解
obtain ⟨k, hk⟩ := hn
-- 以下がローカルコンテキストに追加される
guard_hyp hk : 5 * n = k + k
-- `k + k` という形が使いづらいので、`2 * k` に置き換える
replace hk : 5 * n = 2 * k := by
rw [hk]
ring
-- `hk` の内容が変化している
guard_hyp hk : 5 * n = 2 * k
-- 計算をする
have : n = 2 * (k - 2 * n) := calc
_ = 5 * n - 4 * n := by ring
_ = 2 * k - 4 * n := by rw [hk]
_ = 2 * (k - 2 * n) := by ring
exists k - 2 * n
nth_rw 1 [this]
ring
revert
revert は、intro の逆の操作をするタクティクです。ゴールが ⊢ P x であるときに revert x を実行すると、ゴールが ∀ x, P に変わります。
example (x : Nat) : x = 1 := by
revert x
-- ゴールが `∀ x, x = 1` に変わる
guard_target =ₛ ∀ x, x = 1
sorry
また、ゴールが ⊢ P であって仮定 hq : Q があるときに revert hq を実行すると、ゴールが ⊢ Q → P に変わります。
example {P Q : Prop} (hq : Q) (h : Q → P) : P := by
revert hq
-- ゴールが `Q → P` に変わる
guard_target =ₛ Q → P
assumption
用途
revert には一見使い道がないようですが、識別子をマクロ内で導入するのを避けたいときに役に立ちます。
たとえば次のように自然数の商として整数を定義したとしましょう。
def PreInt := Nat × Nat
def PreInt.r (m n : PreInt) : Prop :=
match m, n with
| (m₁, m₂), (n₁, n₂) => m₁ + n₂ = m₂ + n₁
namespace PreInt
/- ## PreInt.rは同値関係である -/
/-- 反射律 -/
theorem r.refl : ∀ (m : PreInt), r m m := by
intro (m₁, m₂)
dsimp [r]
ac_rfl
/-- 対称律 -/
theorem r.symm : ∀ {m n : PreInt}, r m n → r n m := by
intro (m₁, m₂) (n₁, n₂) h
dsimp [r] at *
omega
/-- 推移律 -/
theorem r.trans : ∀ {l m n : PreInt}, r l m → r m n → r l n := by
intro (l₁, l₂) (m₁, m₂) (n₁, n₂) hlm hmn
dsimp [r] at *
omega
/-- `PreInt.r`は同値関係 -/
theorem r.equiv : Equivalence r :=
{ refl := r.refl, symm := r.symm, trans := r.trans }
end PreInt
/-- `PreInt`上の同値関係 -/
instance PreInt.sr : Setoid PreInt := ⟨r, r.equiv⟩
/-- 整数。`Nat × Nat`を同値関係で割ることで構成している。 -/
@[reducible] def MyInt := Quotient PreInt.sr
namespace MyInt
/- ## MyInt を数値リテラルで表せるようにする -/
/-- 同値類を表す記法 -/
notation:arg (priority := low) "⟦" a "⟧" => Quotient.mk _ a
def ofNat (n : Nat) : MyInt := ⟦(n, 0)⟧
instance {n : Nat} : OfNat MyInt n where
ofNat := MyInt.ofNat n
end MyInt
このとき、整数上の足し算を次のように構成することができます。
def PreInt.add (m n : PreInt) : MyInt :=
match m, n with
| (m₁, m₂), (n₁, n₂) => ⟦(m₁ + n₁, m₂ + n₂)⟧
/-- 整数の足し算 -/
def MyInt.add : MyInt → MyInt → MyInt := Quotient.lift₂ PreInt.add <| by
intro (m₁, m₂) (n₁, n₂) (m'₁, m'₂) (n'₁, n'₂) rm rn
dsimp [PreInt.add]
apply Quotient.sound
dsimp [(· ≈ ·), Setoid.r, PreInt.r, instHasEquivOfSetoid] at *
omega
instance : Add MyInt where
add := MyInt.add
ここで m + 0 = m と 0 + m = m の証明は次のように書けます。
example (m : MyInt) : m + 0 = m := by
refine Quotient.inductionOn m ?_
intro (a₁, a₂)
apply Quot.sound
dsimp [(· ≈ ·), Setoid.r, PreInt.r] at *
omega
example (m : MyInt) : 0 + m = m := by
refine Quotient.inductionOn m ?_
intro (a₁, a₂)
apply Quot.sound
dsimp [(· ≈ ·), Setoid.r, PreInt.r] at *
omega
2つの証明はまったく同じです！そこで証明を共通化すべく macro コマンドでマクロを定義してみると、素朴には上手くいきません。
section
local macro "unfold_int" : tactic => `(tactic| focus
refine Quotient.inductionOn m ?_
intro (a₁, a₂)
apply Quot.sound
dsimp [(· ≈ ·), Setoid.r, PreInt.r] at *
omega
)
example (m : MyInt) : m + 0 = m := by
-- 証明が通らない！
fail_if_success unfold_int
sorry
end
なぜ上手くいかないかというと、マクロ内で参照しているmという識別子がLeanのマクロ衛生機構に引っかかって使用不可になってしまうからです。実際、hygiene オプションでマクロ衛生を無効にすると通るようになります。
section
set_option hygiene false
local macro "unfold_int" : tactic => `(tactic| focus
refine Quotient.inductionOn m ?_
intro (a₁, a₂)
apply Quot.sound
dsimp [(· ≈ ·), Setoid.r, PreInt.r] at *
omega
)
example (m : MyInt) : m + 0 = m := by
-- 証明が通るようになる
unfold_int
end
しかしこの解決策は本質的な解決ではありません。仮にマクロ衛生機構に引っかからなかったとしても、証明すべき命題の変数が m ではなかったらどうするのでしょうか？このままではこのマクロは使い物になりません。
この問題を解決する方法の一つが、revert を使って自由変数を消してしまうことです。
section
local macro "unfold_int" : tactic => `(tactic| focus
intro m
refine Quotient.inductionOn m ?_
intro (a₁, a₂)
apply Quot.sound
dsimp [(· ≈ ·), Setoid.r, PreInt.r] at *
omega
)
example (m : MyInt) : m + 0 = m := by
revert m
unfold_int
example (m : MyInt) : 0 + m = m := by
revert m
unfold_int
end
rfl
rfl は、定義的に等しい(definitionally equal) もの同士が等しいことを示すタクティクです。
/-- 自前で定義した自然数 -/
inductive MyNat where
| zero
| succ (n : MyNat)
namespace MyNat
/- ## 足し算の定義 -/
/-- MyNat の足し算 -/
def add : MyNat → MyNat → MyNat
| a, .zero => a
| a, .succ b => .succ (add a b)
/-- MyNat.add を `+` で書けるようにする -/
instance : Add MyNat where
add := MyNat.add
end MyNat
/-- 1 に相当する項 -/
def MyNat.one : MyNat := .succ zero
/-- 2 に相当する項 -/
def MyNat.two : MyNat := .succ one
/-- 1 + 1 = 2 に相当する命題 -/
example : MyNat.one + MyNat.one = MyNat.two := by
rfl
-- 定義的に等しい(definitionally equal)場合でないと証明できない
/-
error: Tactic `rfl` failed: The left-hand side
MyNat.one
is not definitionally equal to the right-hand side
MyNat.two
⊢ MyNat.one = MyNat.two
-/
example : MyNat.one = MyNat.two := by
rfl
#reduce コマンドとの関係
ここで定義的に等しい(definitionally equal)というのは、おおむね #reduce コマンドに与えた結果の式が等しいというのと同じことです。
section
/- ## rfl で等しいと示せるもの同士の #reduce の出力が等しいことの確認 -/
-- フィールド記法を無効にする
set_option pp.fieldNotation false
/- info: MyNat.succ (MyNat.succ MyNat.zero) -/
#reduce MyNat.one + MyNat.one
/- info: MyNat.succ (MyNat.succ MyNat.zero) -/
#reduce MyNat.two
end
ただし、rfl で示せる等式と、#reduce コマンドでの両辺の簡約結果が等しい等式とは完全には一致しません。以下のように、両辺の #reduce 結果は異なるものの rfl で示せる等式も存在します。
section
variable {α : Type} {β : α → Type} (f : (x : α) → β x)
/- info: f -/
#reduce f
/- info: fun x => f x -/
#reduce (fun x => f x)
example : f = (fun x => f x) := by
rfl
end
カスタマイズ
rfl は、実は等式だけでなく一般の反射的(reflexive)な関係 R に対して関係式 R a b を示すために使用することができます。ここで二項関係 R : α → α → Prop が反射的であるとは、∀ a, R a a が成り立つことをいいます。
関係 R が反射的であることを rfl に利用させるには、R の反射性を示した定理に [refl] 属性を付与します。
-- `MyEq` という二項関係を定義する
inductive MyEq.{u} {α : Type u} : α → α → Prop where
| refl (a : α) : MyEq a a
example (n : Nat) : MyEq n n := by
-- `rfl` で示すことはできない。
fail_if_success rfl
apply MyEq.refl
-- `MyEq` が反射的であることを登録する
attribute [refl] MyEq.refl
-- `rfl` で示せるようになった！
example (n : Nat) : MyEq n n := by rfl
right
ゴールが ⊢ P ∨ Q であるとき、right はゴールを ⊢ Q に変えます。類似のタクティクに left があります。
variable (P Q : Prop)
example (hQ : Q) : P ∨ Q := by
right
-- ゴールが変わる
guard_target =ₛ Q
assumption
left, right を使わない方法
以下に示すように、Or.inl は a から a ∨ b を得る関数です。また Or.inr は b から a ∨ b を得る関数です。これを使うことで left や right を使わずに証明できます。
#check (Or.inl : P → P ∨ Q)
#check (Or.inr : Q → P ∨ Q)
example (hP: P) : P ∨ Q := by
apply Or.inl
exact hP
ring_nf
ring_nf は、ring タクティクの変種で、等式を証明する代わりに式を標準形に変形します。
ring_nf は部分項の変形を行うことができます。
import Mathlib.Tactic.Ring
example {x y : Rat} (F : Rat → Rat) : F (x + y) + F (y + x) = 2 * F (x + y) := by
ring_nf
example {x y : Int} (h : x + y - x = -2) : y = -2 := by
ring_nf at h
assumption
ring
ring は、可換環(commutative ring)上の等式を示すタクティクです。「Proving Equalities in a Commutative Ring Done Right in Coq」 という論文に基づいて実装されています。
ただし環とは、加法 + と乗法 * とマイナスを取る演算 - が定義されていて、それぞれが分配法則や結合法則などのいくつかの法則を満たしているものをいいます。その中でも乗法が可換、つまり a * b = b * a が成り立つような環を可換環と呼びます。可換環の典型的な例は、整数全体 ℤ や有理数全体 ℚ や、多項式環 ℚ[X] などです。
import Mathlib.Tactic.Ring -- `ring` のために必要
example (x y : ℤ) : (x - y) ^ 2 = x ^ 2 - 2 * x * y + y ^ 2 := by
ring
example (x : ℤ) : x ^ 3 - 1 = (x ^ 2 + x + 1) * (x - 1) := by
ring
また、可換な半環(semiring)上の等式も示すことができます。
ただし半環とは、加法 + と乗法 * が定義されていて、分配法則や結合法則などの法則が満たされているものをいいます。半環の典型的な例は、自然数全体 ℕ などです。
example (n m : Nat) : (n + m) ^ 2 = n ^ 2 + 2 * n * m + m ^ 2 := by
ring
example (n m : Nat) : (n + m) ^ 3 = n ^ 3 + 3 * n * m * (n + m) + m ^ 3 := by
ring
ring はローカルコンテキストの仮定は読まず、(半)環の公理だけを使います。
example (x y z : ℤ) (hz : z = x - y) : x * z = x ^ 2 - x * y := by
-- `ring` はローカルコンテキストの仮定を読まないので、証明できない
fail_if_success solve
| ring
-- `rw` などで、環の公理だけを使って示せる形にすれば証明できるようになる
rw [hz]
ring
ring_nf
ring が扱える対象には制約があり、たとえば自然数 ℕ は可換環にならないので、自然数の引き算に関する等式を証明しようとしても上手くいきません。ring_nf タクティクを提案されますが、ring_nf に変更すれば成功するとは限りません。
/-
info: Try this:
[apply] ring_nf
The `ring` tactic failed to close the goal. Use `ring_nf` to obtain a normal form.
-/
example {n : Nat} : n - n + n = n := by
-- `ring_nf` を提案される
ring
example {n : Nat} : n - n + n = n := by
-- 提案通りに `ring_nf` を使っても証明できない
fail_if_success solve
| ring_nf
simp
実際、ring タクティクは失敗すると常に ring_nf を提案するようなマクロとして定義されています。
section
open Lean
/-- `#expand` の入力に渡すための構文カテゴリ -/
syntax macro_stx := command <|> tactic <|> term
/-- マクロを展開するコマンド -/
elab "#expand " "(" stx:macro_stx ")" : command => do
let t : Syntax :=
match stx.raw with
| .node _ _ #[t] => t
| _ => stx.raw
match ← Elab.liftMacroM <| Macro.expandMacro? t with
| none => logInfo m!"Not a macro"
| some t => logInfo m!"{t}"
end
-- マクロ展開の中に `try_this ring_nf` が含まれる
/-
info: first
| ring1
-/
#expand (ring)
カスタマイズ
新たに型 R : Type に対して ring タクティクが利用できるようにするためには、R を CommSemiring または CommRing のインスタンスにします。
/-- 組み込みの自然数のラッパー -/
@[ext] structure MyNat : Type where
val : Nat
namespace MyNat
/- ## MyNat に掛け算と足し算を定義する -/
/-- `MyNat` に掛け算を定義 -/
instance : Mul MyNat where
mul x y := ⟨x.val * y.val⟩
/-- `MyNat` に足し算を定義 -/
instance : Add MyNat where
add x y := ⟨x.val + y.val⟩
end MyNat
example (m n : MyNat) : n * (n + m) = n * n + n * m := by
-- `ring` は `MyNat` に対しては使えない
fail_if_success solve
| ring
sorry
namespace MyNat
/- ## MyNat が半環であることを証明するための準備 -/
/-- `MyNat` として等しいことと、`val` を取って自然数として等しいことは同値 -/
@[simp]
theorem translate (m n : MyNat) : m = n ↔ m.val = n.val := by
constructor <;> intro h
· rw [h]
· ext
assumption
/-- `MyNat` の和を自然数の和に翻訳する -/
@[simp] theorem add_val (m n : MyNat) : (m + n).val = m.val + n.val := by rfl
/-- `MyNat` の積を自然数の積に翻訳する -/
@[simp] theorem mul_val (m n : MyNat) : (m * n).val = m.val * n.val := by rfl
/-- `MyNat` についての等式を自然数に翻訳して示す -/
macro "translate" : tactic => `(tactic| with_reducible
intros
simp
try ring
)
end MyNat
namespace MyNat
/- ## MyNat を AddCommMonoid のインスタンスにする -/
instance : Zero MyNat where
zero := ⟨0⟩
/-- `MyNat` のゼロを自然数のゼロに翻訳する -/
@[simp] theorem zero_val : (0 : MyNat).val = 0 := by rfl
instance : AddCommMonoid MyNat where
zero_add := by translate
add_zero := by translate
add_assoc := by translate
add_comm := by translate
nsmul := nsmulRec
end MyNat
namespace MyNat
/- ## MyNat を CommSemiring のインスタンスにする -/
instance : One MyNat where
one := ⟨1⟩
/-- `MyNat` の1を自然数の1に翻訳する -/
@[simp] theorem one_val : (1 : MyNat).val = 1 := by rfl
/-- `MyNat` は可換な半環(semiring)である -/
instance : CommSemiring MyNat where
left_distrib := by translate
right_distrib := by translate
zero_mul := by translate
mul_zero := by translate
one_mul := by translate
mul_one := by translate
mul_assoc := by translate
mul_comm := by translate
end MyNat
example (m n : MyNat) : n * (n + m) = n * n + n * m := by
-- `ring` が使えるようになった！
ring
rw
rw は rewrite（書き換え）を行うタクティクです。等式や同値関係をもとに書き換えを行います。
hab : a = b や hPQ : P ↔ Q がローカルコンテキストにあるとき、rw は以下のような動作をします。
rw [hab]でゴールの中のaをすべてbに置き換える。rw [hPQ]でゴールの中のPをすべてQに置き換える。
複数の仮定 h1, h2, ... について続けて置き換えを行いたいときは、rw [h1, h2, ...] のようにします。
variable {a b c d e f : Nat}
-- 等式による置き換えの例
example (ha : a + 0 = a) (hb : b * b = 0) (hc : c + c = 0)
: a + 0 + b * b = a + (c + c) := by
-- `a + 0` を `a` に置き換える
rw [ha]
-- 複数ルールについて書き換え
rw [hb, hc]
-- 同値関係に基づいて書き換えを行う例
example (P Q : Prop) (h : P ↔ P ∧ Q) : P → Q := by
intro (hP : P)
rw [h] at hP
-- `P ↔ P ∧ Q` で書き換えを行ったので、
-- `P` が `P ∧ Q` に置き換わった
guard_hyp hP : P ∧ Q
exact hP.right
利用可能な構文
右辺を左辺に書き換える
順番は重要で、b を a に置き換えたいときなどは rw [← hab] のように ← をつけます。
example (h : a = b) (hb : a + 3 = 0) : b + 3 = 0 := by
-- `rw [h]` だと `a` を `b` に置き換えるという意味になり、失敗する
fail_if_success rw [h]
-- `←` をつけて逆向きにすれば通る
rw [← h]
assumption
書き換え場所の指定
rw は at 構文 を受け入れます。ゴールではなく、ローカルコンテキストにある h : P を書き換えたいときには at をつけて rw [hPQ] at h とします。すべての箇所で置き換えたいときは rw [hPQ] at * とします。
また、ゴールとローカルコンテキストの仮定 h に対して同時に書き換えたいときは ⊢ 記号を使って rw [hPQ] at h ⊢ のようにします。
example (h : a + 0 = a) (_h1 : b + (a + 0) = b + a) (_h2 : a + (a + 0) = a)
: a + 0 = 0 + a := by
-- ローカルコンテキストとゴールのすべてに対して書き換えを行う
rw [h] at *
simp
example (h : a * b = c * d) (h' : e = f + 0) : a * (b * e + 0) = c * (d * f) := by
-- ゴールとローカルコンテキストの両方に対して書き換えを行う
rw [Nat.add_zero] at h' ⊢
rw [h']
-- 結合法則を使う
rw [← Nat.mul_assoc, h]
-- 結合法則を使う
ac_rfl
rw の制約
変数束縛
rw は、変数束縛の下では使うことができません。代わりに simp タクティクなどを使用してください。
example (f g : Nat → Nat) (h : ∀ a, f (a + 0) = g a) : f = g := by
ext x
-- rw は失敗する
fail_if_success rw [Nat.add_zero] at h
-- simp は成功する
simp only [Nat.add_zero] at h
exact h x
nth_rw
rw は何も設定しないとマッチした項をすべて置き換えてしまいます。
example {P Q : Prop} (h : P ↔ Q) (hq : Q) : P ∧ P ∧ P ∧ P := by
-- 単に `rw` するとすべて置き換わる
rw [h]
guard_target =ₛ Q ∧ Q ∧ Q ∧ Q
simp [hq]
このとき config を適切に渡すことで、指定した n 番目の出現だけを書き換えることができます。
example {P Q : Prop} (h : P ↔ Q) (hq : Q) : P ∧ P ∧ P ∧ P := by
rw (config := {occs := .pos [2]}) [h]
-- 2番目の出現だけが置き換わる
guard_target =ₛ P ∧ Q ∧ P ∧ P
simp [h, hq]
config を渡さなくても、nth_rw が使用できればそれによって同じことができます。
ローカル変数の展開
rw はローカル変数の展開を行うことができません。代わりに dsimp タクティクなどを使用してください。
/-- 5未満の自然数が存在する -/
example : ∃ x : Nat, x < 5 := by
let n := 2
have h : n < 5 := by
-- rw はローカル変数の展開は行わない
fail_if_success rw [n]
-- dsimp で展開できる
dsimp [n]
-- あとは 2 < 5 を示せばよいだけ
guard_target =ₛ 2 < 5
decide
exact ⟨n, h⟩
一般の同値関係の書き換えはできない
rw で書き換えることができるのは等式と論理的な同値関係だけです。一般の同値関係による書き換えはできません。
def add_equiv (c₁ c₂ : Nat) : Prop :=
∀ n : Nat, c₁ + n = c₂ + n
/-- `Nat`上の同値関係 -/
instance add_setoid : Setoid Nat where
r := add_equiv
iseqv := by
constructor
· grind [add_equiv]
· grind [add_equiv]
· intro x y z h₁ h₂ n
have := h₁ n
have := h₂ n
rw [h₁, h₂]
theorem add_equiv_trans {c₁ c₂ c₃ : Nat} (h₁ : c₁ ≈ c₂) (h₂ : c₂ ≈ c₃) : (c₁ ≈ c₃) := by
-- `rw`が成功しない
fail_if_success rw [h₁]
sorry
rewrite
rewrite というタクティクもあります。rw とよく似ていて、違いは rw が書き換え後に自動的に rfl を実行するのに対して、rewrite は行わないということです。rewrite はユーザにとっては rw の下位互換なので、あまり使うことはないかもしれません。
example (h : a = b) : a = b := by
-- `rw` を使用した場合は一発で証明が終わる
rw [h]
example (h : a = b) : a = b := by
rewrite [h]
-- ゴールを `b = b` にするところまでしかやってくれない
show b = b
rfl
says
exact? や apply? は証明を書いている過程で使用することを想定したタクティクです。Try this: という提案をクリックして採用したら、exact? や apply? は提案内容で上書きされて、最終的な証明には残りません。
では、証明のある部分が apply? などにより提案された内容であることを明示したい場合はどうしたら良いでしょうか？says タクティクはまさにその問題を解決するタクティクです。提案タクティクを残しつつ、実際には実行されないようにします。
より詳しく書くと、検索タクティク X があり、その提案内容が Try this: Y だったとき、X says とすると says は Try this: Y の代わりに Try this: X says Y という提案を infoview 上で出します。
それをクリックすると、X says の内容が X says Y で置換されます。
そして、X says Y が実行されるときには X は飛ばされます。
import Mathlib.Tactic
-- `says` のチェックを有効にする
set_option says.verify true
variable (P Q R S : Prop)
-- `exact?` に対して使用する例
example (hPQ : P → Q) (hQR : Q → R) (hRS : R → S) (hP : P) : S := by
-- `exact?` は実行されない
exact? says
exact (hRS ∘ hQR) (hPQ hP)
simp や aesop のような証明自動化系のタクティクに対して、動作を軽量化しながらも証明の読みやすさを保つという目的でも使用できます。たとえば aesop? says ... と書かれていたら、その後のブロックでどんな複雑なことが書かれていようと、単に aesop の発見した証明内容を丁寧に書いているだけだとわかるわけです。
-- 以下 `X` `Y` `Z`を集合とする
variable {X Y Z : Type}
open Function
/-- 合成 `g ∘ f` が単射なら、`f` も単射 -/
example {f : X → Y} {g : Y → Z} (hgfinj : Injective (g ∘ f)) : Injective f := by
rw [Injective]
aesop? says
intro a₁ a₂ a
apply hgfinj
simp_all only [comp_apply]
オプション
says.no_verify_in_CI : Bool : true にすると、CI 環境で X says Y の Y の部分が実際に提案されている内容と一致するかのチェックが走らなくなります。
-- CI 環境でのチェックを無効にする
set_option says.no_verify_in_CI true
says.verify : Bool : true にすると、X says Y の Y のところに、実際には提案されていないタクティクを入れたときにエラーになります。
-- チェックを無効にする
set_option says.verify false
example (h : P → Q) (p : P) : Q := by
-- 提案されない内容を渡してもエラーにならない
exact? says
try contradiction
exact h p
-- チェックを有効にする
set_option says.verify true
-- チェックを有効にするとエラーになる
/-
error: Tactic `exact?` produced `exact Nat.add_eq_left.mpr rfl`,
but was expecting it to produce ` try contradiction
exact Nat.add_eq_left.mpr rfl`!
You can reproduce this error locally using `set_option says.verify true`.
-/
example (n : Nat) : n + 0 = n := by
exact? says
try contradiction
exact Nat.add_eq_left.mpr rfl
set
set は、ローカル変数を導入するためのタクティクです。
Lean ではローカル変数の定義に let をよく使いますが、let だと「ゴールやローカルコンテキストにある命題を導入した定義に基づいて書き換えてくれない」という不満があります。たとえば let y := f x としたとき、既存の f x を使用した部分が y に書き変わってはくれませんし、y = f x という命題の証明にアクセスでないので書き換えることもままなりません。
set タクティクはこうした不満に対応します。
import Mathlib.Tactic.Set -- `set` のために必要
variable (X : Type) (f : Nat → Nat)
example (x : Nat) (h : f x = x) : f (f x) = f x := by
-- `let` を使用した場合
try
let y := f x
-- ゴールは `⊢ f (f x) = f x` のままで、
-- 導入した `y` を用いて書き換えてくれない
show f (f x) = f x
fail
set y := f x with yh
-- ゴールが書き換わる
show f y = y
-- 仮定も書き変わる
guard_hyp h : y = x
-- `y = f x` であるという事実に名前も付いている
guard_hyp yh : y = f x
rw [h] at *
apply yh.symm
show_term
show_term は、タクティクで作られた項を明示的に表示します。
タクティクは、表面的には「証明を行うためのツール」として振る舞いますが、実際には「示すべき命題に対して、その命題を型に持つような証明項を生成するプログラム」です。裏で生成されている項は普段ユーザからは隠されていますが、show_term はそれを見えるようにします。
import Lean
example (n : Nat) : n + 0 = n := by
rfl
-- `show_term` で `rfl` が生成している具体的な項を表示
/-
info: Try this:
[apply] Eq.refl (n + 0)
-/
example (n : Nat) : n + 0 = n := show_term by
rfl
by? 構文
by を by? に変えることでも、show_term を呼び出すことができます。
/-
info: Try this:
[apply] Eq.refl (n + 0)
-/
example (n : Nat) : n + 0 = n := by?
rfl
実際、by? は show_term に展開されるマクロです。
section
open Lean
/-- `#expand` の入力に渡すための構文カテゴリ -/
syntax macro_stx := command <|> tactic <|> term
/-- マクロを展開するコマンド -/
elab "#expand " "(" stx:macro_stx ")" : command => do
let t : Syntax :=
match stx.raw with
| .node _ _ #[t] => t
| _ => stx.raw
match ← Elab.liftMacroM <| Macro.expandMacro? t with
| none => logInfo m!"Not a macro"
| some t => logInfo m!"{t}"
end
/- info: show_term by rfl -/
#expand (by? rfl)
show
show はこれから示すことを宣言するタクティクです。
show は、ゴールが特定の命題に等しいかどうかチェックします。show P と書くと、ゴールの中に ⊢ P が存在しないときにエラーになり、存在すればそれをメインのゴールにします。たとえば、証明中にこれから示すべきことを明示し、コードを読みやすくする目的で使うことができます。
variable (P Q : Prop)
example (hP : P) (hQ : Q) : P ∧ Q := by
constructor
· show P
exact hP
· show Q
exact hQ
ゴールを定義上等しい命題に変形するために使用することもできます。
def factorial : Nat → Nat
| 0 => 1
| n + 1 => (n + 1) * factorial n
example : factorial 3 = 6 := by
-- 定義上等しいのでゴールを変形できる
show 3 * factorial 2 = 6
-- 定義上等しいのでゴールを変形できる
show 3 * (2 * factorial 1) = 6
rfl
show タクティクとよく似た構文を持つものに、show .. from 構文があります。
simp_all
simp_all タクティクは、simp タクティクの派生で、仮定とゴールに対してこれ以上適用できなくなるまで simp を適用します。
simp [*] at * との違い
simp [*] at * と似ていますが、simp_all は単純化された仮定を再び単純化に使うという、再帰的な挙動をします。
example (P : Nat → Bool)
(h1 : P (if 0 + 0 = 0 then 1 else 2))
(h2 : P (if P 1 then 0 else 1) ) : P 0 := by
-- `simp [*] at *` では示せない
fail_if_success solve
| simp [*] at *
-- 複数回 `simp [*] at *` を繰り返す必要がある
simp [*] at *
simp [*] at *
simp [*] at *
example (P : Nat → Bool)
(h1 : P (if 0 + 0 = 0 then 1 else 2))
(h2 : P (if P 1 then 0 else 1) ) : P 0 := by
-- 一発で終わる。
-- h1 を単純化した後で、h2 を「単純化後の h1」を使って単純化し、
-- さらにゴールを単純化するという挙動をする。
simp_all
注意点
なお、これは simp [*] at * と同じですが simp_all はローカルコンテキストにある命題を使って単純化を行おうとするため、ローカルコンテキストにある命題によってはエラーになることがあります。1
example (_h : 1 + 1 = 2) : True := by
have : 1 = 1 + 1 - 1 := by simp
-- `simp_all` では示せない
-- 仮定にある `1` を `1 + 1 - 1` に置き換えて無限ループになっているようだ
fail_if_success simp_all
example (_h : 1 + 1 = 2) : True := by
have : 1 = 1 + 1 - 1 := by simp
-- `simp [*] at *` でも示せない
fail_if_success simp [*] at *
example (_h : 1 + 1 = 2) : True := by
-- 左辺と右辺を逆にしてみると
have : 1 + 1 - 1 = 1 := by simp
-- `simp_all` で示せるようになる
simp_all
-
ここで挙げているコード例は、Lean の公式 Zulip の aesop with a “bad simp hypothesis” in the context というスレッドで Frédéric Dupuis さんが挙げたコード例を参考にしています。 ↩
simp
simp は、ターゲットを等式や同値性に基づいて自動で単純化（simplify）するタクティクです。
基本的には、A = B という形の補題を登録しておくと、A を B に自動で単純化します。左辺を右辺に書き換え、右辺を左辺に戻すことはないため、右辺は左辺よりも「単純」であることが求められます。等価性に基づいて書き換えるので rw タクティクと似ていますが、rw と異なり明示的に書き換えルールを引数として与えなくても自動で補ってくれます。
[simp] 属性を付けることにより単純化に使ってほしい命題を登録することができます。
/-- 標準の`Nat`を真似て自作した型 -/
inductive MyNat where
| zero
| succ (n : MyNat)
/-- `MyNat`上の足し算 -/
def MyNat.add (m n : MyNat) : MyNat :=
match n with
| .zero => m
| .succ n => succ (add m n)
instance : Add MyNat where
add := MyNat.add
instance : Zero MyNat where
zero := MyNat.zero
@[simp]
theorem MyNat.add_zero (n : MyNat) : n + 0 = n := by
rfl
@[simp]
theorem MyNat.zero_add (n : MyNat) : 0 + n = n := by
induction n with
| zero => rfl
| succ n ih =>
rw [show 0 + n.succ = (0 + n).succ from by rfl]
rw [ih]
example (n : MyNat) : (0 + n + 0) + 0 = n := by
-- 単に`simp`と書くだけで自動的に登録した補題によって書き換えが行われる
simp
同値性を扱う
等式 A = B の形をした補題だけでなく、同値性 A ↔ B の形をした補題も simp 補題として登録し、単純化に使用することができます。等式と同様に、A を B に単純化するのに使用されます。
/-- 何かの命題 -/
opaque Foo : Prop
@[simp]
axiom foo_iff_true : Foo ↔ True
example : Foo := by
-- `Foo` を `True` に単純化できる
simp
simp の基本的な構文
[h₁, h₂, …] で引数を渡す
既知の h : P という命題を使って単純化させたいときは、明示的に simp [h] と指定することで可能です。複数個指定することもできて、その場合はカンマ区切りで simp [h₁, h₂, …] とします。
/-- 0 っぽい何か -/
opaque zero : Nat
/-- １っぽい何か -/
opaque one : Nat
/-- `zero` に右から１を足すと `one` に等しい -/
axiom add_zero_one_eq_one : zero + 1 = one
example : zero + 1 = one := by
-- 単に`simp`としても何も起こらない
-- これは`simp`補題として登録していないから
fail_if_success simp
-- 明示的に引数として書き換えルールを与えれば証明が通る
simp [add_zero_one_eq_one]
/-- `zero` 同士を足すと `zero` に等しい -/
axiom add_zero_zero_eq_zero : zero + zero = zero
example : (zero + zero) + 1 = one := by
-- 複数の補題を指定することもできる
simp [add_zero_zero_eq_zero, add_zero_one_eq_one]
simp only
simp only [h₁, h₂, …] と書くと、登録された補題は無視して、引数として与えた補題だけを使って単純化を行います。
/-- 0 っぽい何か -/
opaque zero : Nat
/-- １っぽい何か -/
opaque one : Nat
/-- `zero` に右から１を足すと `one` に等しい -/
@[simp] axiom add_zero_one_eq_one : zero + 1 = one
/-- `zero` 同士を足すと `zero` に等しい -/
@[simp] axiom add_zero_zero_eq_zero : zero + zero = zero
example : (zero + zero) + 1 = one := by
-- 1つだけ使用して単純化を行ってみる
-- このとき `add_zero_one_eq_one` は登録済みだが無視される
simp only [add_zero_zero_eq_zero]
-- まだゴールが残っている
guard_target =ₛ zero + 1 = one
simp
at 構文
simp は at 構文 を受け入れます。simp は何も指定しなければゴールを単純化しますが、ローカルコンテキストにある h : P を単純化させたければ simp at h と指定することで可能です。ゴールと h の両方を単純化したいときは simp at h ⊢ とします。
example {n m : Nat} (h : n + 0 + 0 = m) : n = m + (0 * n) := by
simp only [Nat.add_zero, Nat.zero_mul] at h ⊢
assumption
ローカルコンテキストとゴールをまとめて全部単純化したい場合は simp at * とします。
等式・同値性以外の補題を扱う
等式や同値性以外の補題を登録した場合、等式・同値性への変換が自動的に行われたうえで登録されます。
たとえば下記の例のように、1 ≠ 0 という命題を simp 補題として登録した場合、(1 = 0) = False という定理が自動生成されそれに基づいて単純化が行われるようになります。
import Mathlib.Util.WhatsNew
/-- 0と1は等しくない -/
theorem Nat.one_neq_zero : 1 ≠ 0 := by
simp
-- `[simp]`属性を追加したことによって、`(1 = 0) = False`という命題が追加されている
/-
info: theorem Nat.one_neq_zero._simp_1 : (1 = 0) = False :=
eq_false Nat.one_neq_zero
-- Lean.Meta.simpExtension extension: 1 new entries
-/
#whats_new in attribute [simp] Nat.one_neq_zero
-- `simp`による書き換えの過程を表示する
set_option trace.Meta.Tactic.simp.rewrite true
/-
trace: [Meta.Tactic.simp.rewrite] Nat.succ_ne_self:1000:
1 = 0
==>
False
-/
example (h : 1 = 0) : False := by
simp at h
一般に等式の形をしているとは限らない命題 P : Prop に対して P という命題を simp 補題として登録すると P = True という定理が、¬ P という命題を登録すると P = False という定理がそれぞれ自動生成されて単純化に使用されます。
import Mathlib.Util.WhatsNew
/-- 偶数を表す帰納的述語 -/
inductive MyEven : Nat → Prop where
| zero : MyEven 0
| step (n : Nat) : MyEven n → MyEven (n + 2)
theorem MyEven_two : MyEven 2 := by
apply MyEven.step
apply MyEven.zero
-- `MyEven 2 = True` という書き換えルールが自動生成されている
/-
info: theorem MyEven_two._simp_1 : MyEven 2 = True :=
eq_true MyEven_two
-- Lean.Meta.simpExtension extension: 1 new entries
-/
#whats_new in attribute [simp] MyEven_two
-- `simp`による書き換えの過程を表示する
set_option trace.Meta.Tactic.simp.rewrite true
/-
trace: [Meta.Tactic.simp.rewrite] MyEven_two:1000:
MyEven 2
==>
True
-/
example : MyEven 2 := by
simp
simp 補題のループ
なお、[simp] 属性を付与した命題は「左辺を右辺に」単純化するルールとして登録されます。
左辺と右辺を間違えて登録すると、無限ループになって simp の動作が破壊されることがあります。[simp] 属性は慎重に登録してください。
section
-- 良くない simp 補題を検知するリンターを無効にする
set_option warning.simp.varHead false
-- 何もしていなければ simp で通る
example (n m : Nat) : (n + 0) * m = n * m := by simp
-- 良くない simp 補題の例
-- 「左辺を右辺に」単純化するため、かえって複雑になってしまう
-- なお local を付けているのは、この simp 補題登録の影響をセクション内に限定するため
@[local simp]
theorem bad_add_zero (n : Nat) : n = n + 0 := by rw [Nat.add_zero]
-- 今まで通った証明が通らなくなる
/-
error: Tactic `simp` failed with a nested error:
maximum recursion depth has been reached
use `set_option maxRecDepth <num>` to increase limit
use `set_option diagnostics true` to get diagnostic information
-/
example (n m : Nat) : (n + 0) * m = n * m := by simp
end
なお linter.loopingSimpArgs オプションを有効にすると、simp 引数のループを検出して警告を出すようになります。
-- ループを引き起こす `simp` の引数に対して警告を出す
set_option linter.loopingSimpArgs true in
/-
warning: Possibly looping simp theorem: `bad_add_zero`
Hint: You can disable a simp theorem from the default simp set by passing `- theoremName` to `simp`.
-/
example (n m : Nat) : (n + 0) * m = n * m := by
simp [bad_add_zero]
discharger について
simp 補題を適用するときに、補題が要求する前提条件を埋める仕組みのことを discharger と呼びます。simp のデフォルトの discharger はあまり強力ではありません。
以下の例では、0 ≤ 1 という前提条件を自動では示すことができずに simp が失敗します。1
theorem Nat.max_eq_left' {a b : Nat} (h : b ≤ a) : max a b = a := by
grind
-- dischargeの過程を表示する
set_option trace.Meta.Tactic.simp.discharge true in
/-
trace: [Meta.Tactic.simp.discharge] ✅️ Nat.max_eq_left' discharge ❌️
0 ≤ 1
-/
example : max 1 0 = 1 := by
fail_if_success
simp only [Nat.max_eq_left']
grind
これは decide タクティクで示すことができるため、(disch := ...) という構文で decide タクティクを discharger に指定すれば証明が通るようになります。
example : 0 ≤ 1 := by
-- decide で証明できる
decide
example : max 1 0 = 1 := by
simp (disch := decide) only [Nat.max_eq_left']
条件付き書き換えはできない
simp は「A = B という補題に基づいて A を B に書き換える」ということはできるのですが、「C → A = B という補題に基づいて C が成り立つときに A を B に書き換える」ということはできません。
discharger として assumption タクティクを指定すれば多少は証明が通るようになります。
/-- 整数をイメージした何か -/
opaque MyInt : Type
variable [LE MyInt] [Zero MyInt]
/-- `x ≤ 0` という前提の下では `0 ≤ x` と `x = 0` は同値 -/
@[simp]
axiom MyInt.le_zero_implies {x : MyInt} (le : x ≤ 0) : 0 ≤ x ↔ x = 0
example {x : MyInt} (le : x ≤ 0) (ge : 0 ≤ x) : x = 0 := by
-- `simp` は「前提条件を満たしたときの書き換え」ができない
fail_if_success simp at ge
-- 手動で引数を `by assumption` で与えればできる
rw [MyInt.le_zero_implies (by assumption)] at ge
assumption
example {x : MyInt} (le : x ≤ 0) (ge : 0 ≤ x) : x = 0 := by
-- discharger として `assumption` を与えれば、
-- ローカルコンテキストにある前提条件は拾ってくれるようになる
simp (disch := assumption) at ge
assumption
arith オプション
simp の設定で arith を有効にすると、算術的な単純化もできるようになります。
example (x y : Nat) : 0 < 1 + x ∧ x + y + 2 ≥ y + 1 := by
-- `simp` だけでは証明が終わらない
fail_if_success solve
| simp
-- 適当に証明する
grind
example {x y : Nat} : 0 < 1 + x ∧ x + y + 2 ≥ y + 1 := by
-- config を与えれば一発で終わる
simp +arith
関連タクティク
simpa
simpa は、simp を実行した後 assumption を実行するという一連の流れを一つのタクティクにしたものです。simpa at h 構文は存在せず、simpa using h と書くことに注意してください。
example (P : Prop) (h : P) : True → P := by
simpa
example {n m : Nat} (h : n + 0 + 0 = m) : n = m := by
simpa using h
simp?
simp は自動的に証明を行ってくれますが、何が行われたのか知りたいときもあります。simp? は単純化に何が使われたのかを明示し、simp only を用いて書き直すことができるようにしてくれます。
/-
info: Try this:
[apply] simp only [forall_const, imp_self, or_true]
-/
example (P : Prop) : (True → P) ∨ (P → P) := by
simp?
simp_all
simp_all はローカルコンテキストとゴールをこれ以上単純化できなくなるまですべて単純化します。
example {P Q : Prop} (hP : P) (hQ : Q) : P ∧ (Q ∧ (P → Q)) := by
-- simp at * は失敗する
fail_if_success simp at *
simp_all
-
このコード例は https://leanprover-community.github.io/extras/simp.html における記述を参考にしています。 ↩
sorry
証明の細部を埋める前にコンパイルが通るようにしたいとき、証明で埋めるべき箇所に sorry と書くとコンパイルが通るようになります。ただし、sorry を使用しているという旨の警告が出ます。
-- Fermat の最終定理
def FermatLastTheorem :=
∀ x y z n : Nat, n > 2 ∧ x * y * z ≠ 0 → x ^ n + y ^ n ≠ z ^ n
/- warning: declaration uses `sorry` -/
theorem flt : FermatLastTheorem :=
sorry
警告を消すオプション
sorry を使用すると通常は警告が出ますが、問題がない場合は warn.sorry オプションをオフにすることで警告を消すことができます。
set_option warn.sorry false in
-- 警告が出ない
example : True := by
sorry
補足: sorry 使用の痕跡は隠すことができる
基本的に、sorry タクティクを使用すれば sorryAx という公理が使用されて、#print axioms コマンドの出力に現れるようになります。
/- info: 'flt' depends on axioms: [sorryAx] -/
#print axioms flt
しかし、[csimp] 属性を経由することで sorryAx を隠してしまうことができます。
def one := 1
def two := 2
@[csimp] theorem one_eq_two : one = two := by
sorry
theorem false_theorem : 1 = 2 := by
rw [show 1 = one from rfl]
native_decide
/- info: 'false_theorem' depends on axioms: [false_theorem._native.native_decide.ax_1_1] -/
#print axioms false_theorem
split
split は、仮定やゴールにある if ... then ... else や match ... with ... 式を扱うのに有用なタクティクです。
if/match 式を扱う必要が生じるのは、典型的には Lean で定義したアルゴリズムや関数に関して、何か性質を証明しようとしたときです。
ゴールが ⊢ Q (if P then a else b) であったときに、split を使用すると次のように2つのサブゴールが生成されます。
- 1つはローカルコンテキストに
† : Pが追加され、ゴールが⊢ Q (a)になったもの。 - 1つはローカルコンテキストに
† : ¬ Pが追加され、ゴールが⊢ Q (b)になったもの。
split によって追加される仮定は名前がついているとは限りません。名前がついていなかった場合、case などで名前を付けることができます。
split は at 構文 に対応しており、仮定に対して用いる場合は split at h のように利用します。
-- if 式を使って関数を定義する
def myabs (x : Int) : Int :=
if x ≥ 0 then x else - x
example (x : Int) : myabs (2 * x) = 2 * myabs x := by
-- `myabs` の定義を展開する
dsimp [myabs]
-- ゴールの中に if 式があって複雑
show (if 2 * x ≥ 0 then 2 * x else -(2 * x)) = 2 * if x ≥ 0 then x else -x
-- `split` タクティクでケース分割する
split
case isTrue h =>
-- `2 * x ≥ 0` の場合
guard_hyp h: 2 * x ≥ 0
-- 左辺にあった if 式が消えた
show 2 * x = 2 * if x ≥ 0 then x else -x
replace h : x ≥ 0 := by linarith [h]
-- `simp` で if を消すことができる
simp [h]
case isFalse h =>
-- `2 * x < 0` の場合
guard_hyp h: ¬2 * x ≥ 0
-- 左辺にあった if 式が消えた
show -(2 * x) = 2 * if x ≥ 0 then x else -x
-- if 式を消すための補題を準備する
have hx : ¬ x ≥ 0 := by linarith [h]
-- `simp` で単純化
simp [hx]
if 式だけでなく match 式に対しても使うことができます。
-- match式を使って関数を定義する
def mysgn (x : Int) :=
match x with
| Int.negSucc _ => -1
| Int.ofNat 0 => 0
| _ => 1
example (x : Int) : mysgn (mysgn x) = mysgn x := by
-- mysgn x を k と置く
set k := mysgn x with h
-- h の mysgn の定義を展開する
dsimp [mysgn] at h
-- h の match の結果によって場合分け
-- すべての場合 (k = -1, 0, 1) に関して mysgn の定義に従い計算する
split at h
all_goals
rw [h]
rfl
suffices
suffices は、数学でよくある「～を示せば十分である」という推論を行うタクティクです。
ゴールが ⊢ P であるときに suffices h : Q from を実行すると、以下が実行されます。
suffices h : Q fromのブロック内で、仮定にh : Qが追加される。suffices h : Q from以降で、ゴールが⊢ Qに書き換えられる。
apply タクティクと似ていますが、apply と違って「十分条件になっていること」の証明が明らかでないときにも使うことができます。
example (P : Prop) : ¬ ¬ (P ∨ ¬ P) := by
intro h
-- `¬ P` を示せば十分である。
suffices hyp : ¬ P from by
-- 仮定に `¬ P` が追加される。
guard_hyp hyp : ¬ P
-- このとき、特に `P ∨ ¬ P` が成り立つので、示すべきことが言える。
have : P ∨ ¬ P := by simp_all
contradiction
-- 無事ゴールを `¬ P` に帰着させることができた。
-- 以下 `¬ P` を示す。
guard_target =ₛ ¬ P
intro hP
have : P ∨ ¬ P := by simp_all
contradiction
構文
suffices Q from by ... という構文では、タクティクによって証明を構成するモードになります。suffices Q from ... という構文では、証明項を直接構成するモードになります。
example (n : Nat) (h : n ≤ 0) : n = 0 := by
-- `n = 0` を示すためには、`n ≤ 0` であることを示せば十分である。
suffices hyp : n ≤ 0 from Nat.eq_zero_of_le_zero h
-- `n ≤ 0` であることを示す。
assumption
symm
symm は、等式や同値性などの対称な関係の向きを反転するタクティクです。
たとえばゴールが b = a であるとき、symm を実行するとゴールは a = b に変わります。
variable {a b c : Nat}
example (h : a = b) : b = a := by
symm
-- ゴールが反転する
guard_target =ₛ a = b
assumption
仮定を反転する
symm at h と書くと、ローカルコンテキストにある仮定 h の向きを反転できます。
example (h : a = b) (ha : a + c = 0) : b + c = 0 := by
symm at h
-- 仮定の向きが反転する
guard_hyp h : b = a
rw [h]
assumption
同値関係にも使える
symm は等式だけではなく、命題の同値性 ↔ にも使えます。
example {P Q : Prop} (h : Q ↔ P) : P ↔ Q := by
symm
-- ゴールが反転する
guard_target =ₛ Q ↔ P
assumption
example {P Q : Prop} (h : P ↔ Q) (hq : Q) : P := by
symm at h
-- 仮定の向きが反転する
guard_hyp h : Q ↔ P
rw [h] at hq
assumption
カスタマイズ
一般の二項関係に対して symm を使いたい場合は、その関係が対称であることを示す定理に [symm] 属性を付与します。
/-- 2つの自然数の差が高々1であることを表す関係 -/
def Close (x y : Nat) : Prop :=
x ≤ y + 1 ∧ y ≤ x + 1
/-- `Close` は対称な関係 -/
theorem Close.symm {x y : Nat} (h : Close x y) : Close y x := by
exact ⟨h.right, h.left⟩
example {x y : Nat} (h : Close x y) : Close y x := by
-- 登録していないと `symm` は使用できない
fail_if_success symm
exact Close.symm h
-- `Close` が対称であることを登録する
attribute [symm] Close.symm
example {x y : Nat} (h : Close x y) : Close y x := by
symm
-- `Close y x` が `Close x y` に反転する
guard_target =ₛ Close x y
assumption
tauto
tauto は、トートロジー(恒真式、tautology)であることに基づいてゴールを閉じるタクティクです。 ゴールを閉じることができなければエラーになります。
import Mathlib.Tactic.Tauto -- `tauto` を使うのに必要
variable (P Q R : Prop)
-- 含意の導入
example (h : P) : Q → P := by
tauto
-- フレーゲの3段論法
example : (P → (Q → R)) → ((P → Q) → (P → R)) := by
tauto
-- 否定と同値なら矛盾
example : (P ↔ ¬ P) → False := by
tauto
tauto が扱う対象の「トートロジー」は、命題論理の範囲で記述できるものに限ります。述語論理における恒真な式は、tauto で示せないことがあります。
example (α : Type) (S : α → Prop) : ¬(∀ x, S x) → (∃ x, ¬ S x) := by
-- `tauto` では示せない
fail_if_success tauto
aesop
example (Q : Prop) : ∀ (P : Prop), P → (Q → P) := by
-- これは量化子を含むが、`tauto` でも示すことができる。
tauto
排中律
排中律を使わずに示せる命題であっても、tauto は排中律を使って示してしまうことがあります。直観主義論理の枠内で命題を示すには、代わりに itauto タクティクを使用してください。
/-- 命題とその否定は同値ではない -/
theorem not_neg_iff {P : Prop} : ¬ (P ↔ ¬ P) := by tauto
-- 選択原理を使っているが、これは排中律を使っているため
/- info: 'not_neg_iff' depends on axioms: [propext, Classical.choice, Quot.sound] -/
#print axioms not_neg_iff
-- 実際には排中律は必要ない
theorem not_neg_iff' {P : Prop} : ¬ (P ↔ ¬ P) := by
intro h
have hnp : ¬ P := by
intro hp
have : ¬ P := by rwa [h] at hp
contradiction
have hp : P := by rwa [← h] at hnp
contradiction
/- info: 'not_neg_iff'' depends on axioms: [propext] -/
#print axioms not_neg_iff'
trans
trans は、推移律を利用して示すべきことを分割するタクティクです。
推移的な関係 ∼ に対してゴールが a ∼ c であるとき、trans b により2つのサブゴール a ∼ b と b ∼ c が生成されます。calc を使っても同じことができますが、calc を使うまでもないときに便利かもしれません。
import Batteries.Tactic.Trans
example {n m : Nat} (h1 : n ≤ 1) (h2 : 1 ≤ m) : n ≤ m := by
-- 1 を仲介して示す
trans 1
· show n ≤ 1
assumption
· show 1 ≤ m
assumption
trivial
trivial は明らかな(trivial)ことを示します。
-- True は何の仮定もなしに示せる
example : True := by trivial
-- 定義から明らかな等式
example : 1 + 1 = 2 := by trivial
-- 矛盾があるので、どんな命題でも証明できる
example (P : Prop) (h : False) : P := by trivial
舞台裏
trivial は、複数の基本的なタクティクを順に試すマクロとして実装されています。trace.Elab.step というオプションを true にすると、展開の様子を順を追って見ることができます。
/-
trace: [Elab.step] ✅️ trivial
[Elab.step] ✅️ trivial
[Elab.step] ✅️ trivial
[Elab.step] 💥️ (apply And.intro✝) <;> trivial
[Elab.step] 💥️ focus
apply And.intro✝
with_annotate_state"<;>" skip
all_goals trivial
[Elab.step] 💥️ ⏎
apply And.intro✝
with_annotate_state"<;>" skip
all_goals trivial
[Elab.step] 💥️ ⏎
apply And.intro✝
with_annotate_state"<;>" skip
all_goals trivial
[Elab.step] 💥️ apply And.intro✝
[Elab.step] 💥️ apply True.intro✝
[Elab.step] 💥️ decide
[Elab.step] ✅️ contradiction
-/
example (P : Prop) (h : False) : P := by
set_option trace.Elab.step true in
trivial
出力が長いのですが、まず apply And.intro を試し、次に apply True.intro を試し、次に decide と contradiction を試していることがわかります。
try
try は、失敗するかもしれないタクティクをエラーにすることなく実行します。try で指定されたタクティクが成功した場合は try なしの場合と変わりませんが、失敗した場合は try 実行前の状態に戻ります。
import Aesop -- `aesop` を使用するため
variable (P Q : Prop)
example : (P → Q) → (¬ Q → ¬ P) := by
-- `assumption` は通らないが、エラーにならない
try assumption
try
-- `aesop` が通り、証明が終了する
aesop
done
-- 強制的に失敗させる
fail
-- `try` 実行前の状態に戻る
show (P → Q) → ¬Q → ¬P
aesop
try?
try? は、証明を探索するための標準的なタクティクです。帰納法や場合分けなどを含む複雑な証明も見つけることができます。
namespace List
variable {α : Type}
@[grind]
def last? (as : List α) : Option α :=
match as with
| [] => none
| [a] => some a
| _ :: bs => last? bs
example (as : List α) : (reverse as).head? = as.last? := by
-- grind 単体では証明ができない
fail_if_success grind
-- try? なら証明を見つけることができる
try?
example (as : List α) : (reverse as).head? = as.last? := by
-- 証明の一例
fun_induction last? <;> grind [= last?.eq_def]
end List
unfold
unfold は、式の展開(unfolding)を行うタクティクです。定義に基づいて式を展開します。
何も指定しなければゴールを変形しようとします。ローカルコンテキストにある項 h について展開を行うには、unfold ... at h のように at を付けます。
dsimp タクティクを使っても同様のことができます。
def myFun (n : Nat) : Nat :=
n + 1
example (n : Nat) : myFun n ≥ 1 := by
-- `dsimp` でも同じことができる
try
dsimp [myFun]
show n + 1 ≥ 1
fail
-- `myFun` を定義に展開する
unfold myFun
simp
use
use タクティクは、「～を満たす x が存在する」という命題を示すために、証拠になる x を具体的に示します。
ゴールが ⊢ ∃ x, P x のとき、x : X がローカルコンテキストにあれば、use x によりゴールが ⊢ P x に変わります。同時に、P x が自明な場合は証明が終了します。
import Mathlib.Tactic.Use
import Mathlib.Tactic.Linarith
example {α : Type} (P : α → Prop) (x : α) : ∃ y, P y := by
use x
-- ゴールが `P x` に変わる
guard_target =ₛ P x
sorry
exists との違い
これだけの説明だと exists タクティクと同じに見えますが、use タクティクには exists より優れている点があります。
discharger が指定できる
use は、証拠を与えた後にゴールを閉じるために使うタクティク（discharger と呼ばれます）を指定することができます。
example (x : Rat) (h : 3 * x + 6 > 6) : ∃ (y : Rat), y > 0 := by
exists x
linarith
example (x : Rat) (h : 3 * x + 6 > 6) : ∃ (y : Rat), y > 0 := by
-- `discharger` として `linarith` を指定することができる
use (discharger := linarith) x
exists タクティクにこの構文は存在しません。
open Lean Parser in
/-- `s : String` をパースして `Syntax` の項を得る。`cat` は構文カテゴリ。-/
def parse (cat : Name) (s : String) : MetaM Syntax := do
ofExcept <| runParserCategory (← getEnv) cat s
-- `exists (discharger := linarith)` と書くとパースエラーになる
/- error: <input>:1:19: expected ')', ',' or ':' -/
#eval parse `tactic "exists (discharger := linarith) 1"
Exists 以外の型にも使用できる
exists は、ゴールの型が Exists であるという想定をしているため、たとえばフィールドの数が３以上であるような構造体に対して使うとエラーになります。
/-- 例示のための構造体。フィールドの数が `Exists` より多い -/
structure Foo where
x : Int
pos : x > 0
sq : x ^ 2 = 9
/-- `Foo` の項を具体的に与える例 -/
example : Foo := ⟨3, by simp, by simp⟩
/-
error: Insufficient number of fields for `⟨...⟩` constructor: Constructor `Foo.mk` has 3 explicit field, but only 2 were provided
-/
example : Foo := by
exists 3
しかし、use タクティクであれば対応することができます。
example : Foo := by
-- 最初のフィールドを `3` で埋めるように指示する
use 3
-- 残りのフィールドは `simp` で証明することができる
all_goals simp
example : Foo := by
-- `discharger` を指定するバージョン
use (discharger := simp) 3
with_reducible
with_reducible は、後に続くタクティクの透過度(transparency)を reducible に指定して実行します。透過度 reducible では、[reducible] 属性を持つ定義だけが展開されます。
用途
with_reducible はタクティクを定義するマクロを書く際に有用です。推移律を利用して、不等式を分割するタクティクを定義する例を示しましょう。
まず、不等式の推移律を使う証明の例を示します。
variable (a b c : Nat)
example (h₁ : a ≤ b) (h₂ : b ≤ c) : a ≤ c := by
-- b を経由して示す
apply Nat.le_trans (m := b) <;> assumption
example (h₁ : a < b) (h₂ : b < c) : a < c := by
-- b を経由して示す
apply Nat.lt_trans (m := b) <;> assumption
今からすることは、この２つの命題を１つのタクティクで証明できるようにすることです。コードを素直に共通化しようとして次のようにマクロを定義すると上手くいきません。
section
/- ## マクロによるタクティクの定義が上手くいかない例 -/
/-- 推移律を扱うタクティク -/
syntax "my_trans" term : tactic
-- `<` に対するルール
local macro_rules
| `(tactic| my_trans $e) => `(tactic| apply Nat.lt_trans (m := $e))
-- `≤` に対するルール
local macro_rules
| `(tactic| my_trans $e) => `(tactic| apply Nat.le_trans (m := $e))
example (h₁ : a ≤ b) (h₂ : b ≤ c) : a ≤ c := by
-- 成功
my_trans b <;> assumption
example (h₁ : a < b) (h₂ : b < c) : a < c := by
-- 失敗
my_trans b <;> try assumption
exact Nat.le_of_succ_le h₂
end
マクロ展開のルールとして、Lean は後に定義されたルールを先に適用するので、常に Nat.le_trans を先に適用します。ところが < は ≤ を使って定義されているため、< に対しても apply Nat.le_trans が成功してしまいます。その結果、< に対して Nat.lt_trans を使ってくれないという結果になっています。
/-- `<` は `≤` を使って定義されている -/
example (n m : Nat) : (Nat.lt n m) = (Nat.le n.succ m) := rfl
example (h₁ : a < b) (h₂ : b < c) : a < c := by
-- < に対しても Nat.le_trans が成功してしまう
apply Nat.le_trans (m := b)
· exact h₁
· exact Nat.le_of_succ_le h₂
with_reducible を使用すると、[reducible] とマークされていない定義は展開されなくなるので、この挙動を防ぐことができます。
example (h₁ : a < b) (h₂ : b < c) : a < c := by with_reducible
-- < に対して Nat.le_trans が成功しなくなった！
fail_if_success apply Nat.le_trans (m := b)
apply Nat.lt_trans (m := b) <;> assumption
section
/- ## タクティクマクロを with_reducible で定義する例 -/
-- `<` に対するルール
local macro_rules
| `(tactic| my_trans $e) => `(tactic| with_reducible apply Nat.lt_trans (m := $e))
-- `≤` に対するルール
local macro_rules
| `(tactic| my_trans $e) => `(tactic| with_reducible apply Nat.le_trans (m := $e))
example (h₁ : a ≤ b) (h₂ : b ≤ c) : a ≤ c := by
-- 成功
my_trans b <;> assumption
example (h₁ : a < b) (h₂ : b < c) : a < c := by
-- 成功
my_trans b <;> try assumption
end
wlog
wlog は、数学でよく使われる、一般性を失うことなく(without loss of generarity)何々と仮定してよいというフレーズの Lean での対応物です。
import Mathlib.Tactic -- 大雑把に import する
-- `n` と `m` は自然数
variable {n m : ℕ}
example (h : n ≠ m) : 0 < |(n - m : ℤ)| := by
-- 一般性を失うことなく `m < n` と仮定して良い
wlog hnm : m < n with H
-- `m < n` の時に成り立つのであれば、そうでないときも成り立つことを示す
case inr =>
-- `m < n` ではないので、`n < m` が成り立つ
have : m = n ∨ n < m := Nat.eq_or_lt_of_not_lt hnm
replace : n < m := by aesop
-- `m < n` の時に成り立つという仮定を利用できる
replace : 0 < |(m - n : ℤ)| := @H m n h.symm this
rw [abs_sub_comm]
assumption
-- `m < n` と仮定してよいことがわかったので、
-- `m < n` だとして証明する
apply abs_pos_of_pos
simp_all
zify
zify タクティクは、自然数 Nat についての命題を整数 Int についての命題に変換します。
import Mathlib.Tactic
example (x : Nat) (h : x ≥ 5) : 15 ≤ 3 * x := by
-- 仮定とゴールを整数の不等式に変換する
zify at h ⊢
-- 整数についての命題に変換した
guard_hyp h : x ≥ (5 : Int)
guard_target = (15 : Int) ≤ 3 * ↑x
have : (15 : Int) ≤ 3 * ↑x := calc
(15 : Int) = 3 * 5 := by rfl
_ ≤ 3 * ↑x := by linarith
assumption
構文
無名コンストラクタ
無名コンストラクタ(anonymous constructor) を使用すると、単一のコンストラクタしか持たない帰納型 T に対して、コンストラクタ名を指定せずに T 型の項を構成することができます。⟨x1, x2, ...⟩ という構文により使うことができます。
/-- 単一のコンストラクタしか持たない帰納型の例 -/
inductive Foo where
| mk (x y : Nat)
deriving DecidableEq
#guard
-- コンストラクタを使って項を作る場合
let foo₁ := Foo.mk 1 2
-- 無名コンストラクタを使って項を作る場合
let foo₂ := ⟨1, 2⟩
-- 両者は同じものを表す！
foo₁ = foo₂
一般の帰納型に対しては使用できません。
/-- 複数のコンストラクタを持つ帰納型の例 -/
inductive Sample where
| fst (foo bar : Nat)
| snd (foo bar : String)
-- 「コンストラクタが一つしかない帰納型でなければ使用できない」というエラーになる
/-
info: Invalid `⟨...⟩` notation: The expected type `Sample` has more than one constructor
Note: This notation can only be used when the expected type is an inductive type with a single constructor
-/
#check_failure (⟨"foo", "bar"⟩ : Sample)
構造体への使用
構造体は単一コンストラクタしか持たない帰納型なので、構造体に対しても無名コンストラクタ構文が使用できます。
/-- 2つのフィールドを持つ構造体 -/
structure Hoge where
foo : Nat
bar : Nat
#check (⟨1, 2⟩ : Hoge)
平坦化
コンストラクタが入れ子になっている場合でも平坦化することができます。
#guard
-- 入れ子にした場合
let x : Nat × (Int × String) := ⟨1, ⟨2, "hello"⟩⟩
-- 平坦化した場合
let y : Nat × (Int × String) := ⟨1, 2, "hello"⟩
-- 両者は同じものを表している！
x = y
上の例は構造体の同種のコンストラクタが入れ子になっている例ですが、structure コマンドで定義された型でなくても、同種のコンストラクタでもなくても、同様に平坦化することができます。
/-- Prod を真似て自作した帰納型 -/
inductive MyProd (α β : Type) where
| mk (fst : α) (snd : β)
deriving DecidableEq
-- Prod のための2項演算子
@[inherit_doc] infixr:35 " ×ₘ " => MyProd
-- 平坦化ができている！
#check (⟨1, 2, 1, 2, 1⟩ : Nat × Nat ×ₘ Nat ×ₘ Nat × Nat)
しかし、時には平坦化ができないケースもあります。
section
variable {α β : Type} (f : α → Option (α × β))
example (a : α) (h : ∃ (x : α × β), f a = some x) : True := by
-- 平坦化ができない
fail_if_success obtain ⟨a, b, hx⟩ := h
-- 代わりにネストさせると通る
obtain ⟨⟨a, b⟩, hx⟩ := h
trivial
end
リストリテラル
[x₁, x₂, .. , xₙ] は、List α の項を簡単に作るための構文です。
もしこの構文がなければ、List α の項を作るためにはコンストラクタを使用するしかないので、次のように書く必要があります。
/-- 自前で定義したリスト型 -/
inductive MyList (α : Type) where
| nil
| cons (head : α) (tail : MyList α)
deriving DecidableEq
/-- 空リスト。標準の`List`のための記法と被るのを避けている。 -/
notation:max " ⟦⟧ " => MyList.nil
/-- `MyList`に要素を追加する。標準の`List`のための記法と被るのを避けている。 -/
infixr:80 " ::: " => MyList.cons
-- 項を作るのが面倒
/- info: 1 ::: 2 ::: 3 ::: ⟦⟧ : MyList Nat -/
#check 1 ::: 2 ::: 3 ::: ⟦⟧
しかし、リストリテラル構文があるおかげで、次のように見やすく簡潔に書くことができます。
/-- 自作のリストリテラル構文。なお末尾のカンマは許可される。
なお標準の`List`のための記法と被るのを避けている。 -/
syntax "⟦" term,*,? "⟧" : term
macro_rules
| `(⟦ ⟧) => `(⟦⟧)
| `(⟦$x⟧) => `($x ::: ⟦⟧)
| `(⟦$x, $xs,*⟧) => `($x ::: (⟦$xs,*⟧))
-- 項を作るのが楽になった！
#guard ⟦1, 2, 3⟧ = 1 ::: 2 ::: 3 ::: ⟦⟧
-- 末尾のコンマは無視される
#guard ⟦1, ⟧ = 1 ::: ⟦⟧
-- 空リストもリストリテラル構文で書ける
#guard ⟦⟧ = MyList.nil (α := Unit)
部分型構文
{x : T // p x} は、部分型を表す構文です。
/- info: { x // x > 0 } : Type -/
#check { x : Int // x > 0 }
もしこの構文がなければ、Subtype を定義するには以下のように書く必要があります。
/-- 標準の `Subtype` を真似て自前で定義した型 -/
structure MySubtype {α : Type} (p : α → Prop) where
val : α
property : p val
-- 正の自然数全体を表す部分型
#check MySubtype (fun x : Nat => x > 0)
しかし、この構文があるおかげで、次のように見やすく簡潔に書くことができます。
@[inherit_doc MySubtype] syntax "my{ " ident (" : " term)? " // " term " }" : term
macro_rules
| `(my{ $x : $type // $p }) => ``(MySubtype (fun ($x:ident : $type) => $p))
| `(my{ $x // $p }) => ``(MySubtype (fun ($x:ident : _) => $p))
-- 正の自然数全体を表す部分型
#check my{ x // x > 0 }
-- 正の整数全体の型
#check my{ x : Int // x > 0 }
暗黙の引数
暗黙の引数とは、def コマンドや theorem コマンド、variable コマンドなどが受け取る構文の一つで、関数や定理の引数をユーザが明示的に与えなくても、Lean が文脈を読んで推論してくれるようになります。波括弧 {} で囲んで、{x y : A} のように書きます。
典型的な使用例
たとえば、暗黙の引数を使わなかった場合にどうなるかを見てみましょう。次の関数 List.subs は型パラメータ α : Type を受け取っていますが、第二引数 xs : List α を見れば α : Type が何であるかは分かるので、List.subs を使用する際に毎回 α を指定するのは冗長だと考えられます。
/-- 与えられたリストの部分リストを全て返す(明示的引数バージョン) -/
def List.subs_exp (α : Type) (xs : List α) : List (List α) :=
match xs with
| [] => [[]]
| x :: xs =>
let xss := subs_exp α xs
xss ++ xss.map (x :: ·)
-- 型引数 α を明示的に与えて書いた場合
#eval List.subs_exp Nat [1, 2]
-- ホールを使って推論させる場合
#eval List.subs_exp _ [1, 2]
-- 型引数を与えないと（当然ながら）エラーになってしまう
#check_failure List.subs_exp [1, 2]
引数 α を暗黙の引数として受け取るように変更すれば、Lean が α : Type の内容を推論してくれるようになり、α を省略できるようになります。
/-- 与えられたリストの部分リストを全て返す(暗黙引数バージョン) -/
def List.subs_imp {α : Type} (xs : List α) : List (List α) :=
match xs with
| [] => [[]]
| x :: xs =>
let xss := subs_imp xs
xss ++ xss.map (x :: ·)
-- 型引数を省略できるようになった
#eval List.subs_imp [1, 2]
-- 型引数を位置引数として与えると、今度はエラーになる
#check_failure List.subs_imp Nat [1, 2]
明示的引数モード
暗黙の引数を受け取るものとして定義された関数や定理に対して、@ 記号を先頭に付けると全ての暗黙の引数の自動挿入が行われなくなります。つまり、すべての引数を手動で与える必要が生じます。
-- 2 つの暗黙引数を持つ関数
def List.map' {α β : Type} (f : α → β) : List α → List β
| [] => []
| x :: xs => f x :: map' f xs
-- 普通は次のように使う
#check List.map' (fun x => x == 1) [1, 2, 3]
-- `@` 記号を付けると手動で型引数を与えないといけなくなる
#check @List.map' Nat Bool (fun x => x == 1) [1, 2, 3]
少し、というかかなり細かい注意ですが、@ を付けても「暗黙引数が明示的引数に変わる」わけではありません。その証拠に、#check コマンドの出力を見ると暗黙引数のままになっています。
/- info: id.{u} {α : Sort u} (a : α) : α -/
#check id
-- `α` のバインダーが波括弧のままになっている
/- info: @id : {α : Sort u_1} → α → α -/
#check @id
構文的な性質
Lean.Parser.Term.implicitBinder というパーサが暗黙引数の構文に対応しており、このパーサのドキュメントコメントに次のように書かれている通り、構文としては暗黙の引数に型を指定しないことも許されます。
Implicit binder, like
{x y : A}or{x y}. In regular applications, whenever all parameters before it have been specified, then a_placeholder is automatically inserted for this parameter. Implicit parameters should be able to be determined from the other arguments and the return type by unification.In
@explicit mode, implicit binders behave like explicit binders.
-- `x : α` と書いたので、`α` が何かの型であることは分かる
def myId {α} (x : α) := x
配列リテラル
#[x₁, x₂, .. , xₙ] は、Array α の項を簡単に作るための構文です。
/- info: #[1, 2, 3] : Array Nat -/
#check #[1, 2, 3]
もしこの構文がなければ、Array α の項を作るにはコンストラクタを利用するしかないので、次のように書く必要があります。
/-- 標準の Array をまねて自作した配列型 -/
structure MyArray (α : Type) where
toList : List α
abbrev List.toMyArray {α : Type} (xs : List α) : MyArray α := ⟨xs⟩
/- info: [1, 2, 3].toMyArray : MyArray Nat -/
#check List.toMyArray [1, 2, 3]
しかし、配列リテラル構文があるおかげで、次のように見やすく簡潔に書くことができます。
syntax "my#[" term,*,? "]" : term
macro_rules
| `(my#[ $elems,* ]) => `(List.toMyArray [ $elems,* ])
-- 項を作るのが楽になった！
#check (my#[1, 2, 3] : MyArray Nat)
∀
∀ 記号は基本的に、全称量化を表します。つまり述語 P : α → Prop に対して、∀ x : α, P x は「すべての x : α に対して P x が成り立つ」という意味になります。
しかし、∀ は述語以外のものに対しても実は使うことができます。
#check ∀ n : Nat, Vector Nat n
この場合何を意味するかというと、∀ a : A, B は (a : A) → B と同じ意味になります。
set_option pp.foralls false
/- info: (n : Nat) → Vector Nat n : Type -/
#check ∀ n : Nat, Vector Nat n
実際のところ両者は常に同じです。型が Prop になるときは、カリー・ハワード同型対応により「命題は型、証明はその項」なので全称量化の意味になるというだけで、型としては同じものです。型が Prop になるときだけ、見やすいので ∀ 記号を使う慣習になっています。
variable {A : Type} {B : A → Sort u}
example : ((a : A) → B a) = (∀ a : A, B a) := by rfl
左パイプ記法
左パイプ記法(left pipe notation) <| は、パイプ記号の右側の式を左側の関数の引数として渡します。
つまり f <| a と書くことで f a と同じ意味になります。
example (a : α) (f : α → β) : (f <| a) = f a := by
rfl
複数組み合わせると右側が優先して結合されます。
したがって2つ組み合わせて g <| f <| a のように書くと g (f a) と同じ意味になります。
example (a : α) (f : α → β) (g : β → γ) : (g <| f <| a) = g (f a) := by
rfl
用途
ただの関数適用として書いても左パイプ記法を使用しても順序は変わりませんが、パイプ記法を使うと括弧を省略できます。
/-- 二次元リストの和を計算して、
ログだけ出して結果を捨てる関数 -/
def sumWithLog (dlist : List (List Nat)) : IO Unit := do
let mut current := 0
for (list, i) in dlist.zipIdx do
IO.println <|
s!"{i} 番目のリスト\n" ++
s!" 合計値: {list.sum}\n" ++
s!" 長さ: {list.length}"
current := current + list.sum
/-
info:
0 番目のリスト
合計値: 6
長さ: 3
1 番目のリスト
合計値: 9
長さ: 2
2 番目のリスト
合計値: 9
長さ: 1
-/
#eval sumWithLog [[1, 2, 3], [4, 5], [9]]
補足
双対的な概念として右パイプ記法があります。
右パイプ記法
右パイプ記法(right pipe notation) |> は、パイプ記号の左側の式を右側の関数の引数として渡します。
つまり a |> f は f a と同じ意味になります。
example (a : α) (f : α → β) : (a |> f) = f a := by
rfl
複数組み合わせると左側が優先して結合されます。
したがって2つ組み合わせて x |> f |> g のように書くと、g (f x) と同じ意味になります。
example (a : α) (f : α → β) (g : β → γ) : (a |> f |> g) = g (f a) := by
rfl
用途
関数適用として書くと、先に適用する関数を後に書くことになるので順序が逆になります。 一方で右パイプ記法を使用すると、先に適用する関数を先に書くことができます。
/-- `n` 以下の奇数の自乗の和を計算する -/
def sumOfOddSquares (n : Nat) : Nat :=
List.range (n + 1)
|> List.filter (· % 2 = 1)
|> List.map (· ^ 2)
|> List.sum
#guard sumOfOddSquares 3 = 1^2 + 3^2
#guard sumOfOddSquares 10 = 1^2 + 3^2 + 5^2 + 7^2 + 9^2
補足
双対的な概念として左パイプ記法があります。
at 構文
at 構文とは、タクティク tac に対してその書き換え対象を指定する構文のことです。rw タクティクや simp タクティクなど、「書き換え」を行う多くのタクティクがこの構文を受け入れるようになっています。
利用可能な構文
at h
ローカルコンテキストにある仮定 h : P に対して at h と書くことで h に対して書き換えを行うことができます。
section
variable {a b : Nat}
example (lem : a + 0 = a) (h : a + (a + 0) = a) : a + a = a := by
-- ローカルコンテキストの `h` に対して書き換えを行う
rw [lem] at h
rw [h]
end
at h₁ h₂ ..
また、ローカルコンテキストにある複数の仮定 h₁, h₂, .. に対して書き換えを行うには空白区切りで at h₁ h₂ .. とします。
section
variable (x m n : ℕ)
example (left : (x : ℝ) < ↑m + ↑n) (right : ↑m + ↑n < (x : ℝ) + 1) : False := by
-- `left`と`right`に対して書き換えを行う
norm_cast at left right
omega
end
at h ⊢
ローカルコンテキストにある仮定 h : P とゴールに対して同時に書き換えを行うには、at h ⊢ とします。
example (x : Nat) (h : x ≥ 1) : 2 * x ≥ 2 := by
-- 自然数から有理数にキャストする
qify at h ⊢
have : (2 : ℚ) ≤ 2 * x := calc
_ = 2 * 1 := by simp
_ ≤ 2 * (x : ℚ) := by gcongr
assumption
at *
ローカルコンテキストのすべての仮定とゴールに対して書き換えを行うには、at * とします。
section
set_option linter.flexible false
variable (P : Nat → Bool)
example (h1 : P (if 0 = 0 then 1 else 2)) (h2 : P (0 * 1)) : P 0 ∧ P (1 + 0) := by
simp at *
exact ⟨h2, h1⟩
end
at 構文を受け入れるタクティクを作る
次に示すのは at 構文を受け入れるようなタクティクをマクロとして構成する例です。
/-- 自前で定義した狭義順序 -/
def Nat.mylt (m n : Nat) : Prop := (m + 1) ≤ n
/-- 単に `m < n` と書いたら上で定義した自前の順序が使われるようにする -/
instance : LT Nat where
lt m n := m.mylt n
open Lean.Parser.Tactic in
/-- `(· < ·)`を定義に展開して中身を確認するための専用自作タクティク -/
syntax (name := dsimp_lt) "dsimp_lt" (location)? : tactic
macro_rules
| `(tactic| dsimp_lt $[at $location]?) =>
`(tactic| dsimp only [(· < ·), Nat.mylt] $[at $location]?)
example : 1 < 4 := by
dsimp_lt
guard_target =ₛ 1 + 1 ≤ 4
decide
example (_h : 1 < 3) : True := by
dsimp_lt at _h
guard_hyp _h : 1 + 1 ≤ 3
trivial
by
Lean においては、命題は型で、証明はその項です。命題 P の証明を構成するとは項 h : P を構成するということです。by は、証明の構成をタクティクで行いたいときに使います。
証明項による証明とは、たとえば次のようなものです。
variable (P Q R : Prop)
-- `P → R` というのは `P` の証明を与えられたときに `R` の証明を返す関数の型
-- したがって、その証明は関数となる
example (hPQ : P → Q) (hQR : Q → R) : P → R :=
fun hP ↦ hQR (hPQ hP)
同じ命題をタクティクを使って示すと、例えば次のようになります。
-- 同じ命題をタクティクで示した例
example (hPQ : P → Q) (hQR : Q → R) : P → R := by
intro hP
exact hQR (hPQ hP)
by?
by の代わりに by? を使うとタクティクモードで構成した証明を直接構成した証明に変換してくれます。詳細は show_term のページを参照してください。
/-
info: Try this:
[apply] fun hP => hQR (hPQ hP)
-/
example (hPQ : P → Q) (hQR : Q → R) : P → R := by?
intro hP
exact hQR (hPQ hP)
構文的な性質
タクティクを使用する際には多くの場合 by を伴うので、by とタクティクの関連は深いのですが、by 自身は構文的にタクティクではありません。
open Lean Parser in
/-- `s : String` をパースして `Syntax` の項を得る。`cat` は構文カテゴリ。-/
def parse (cat : Name) (s : String) : MetaM Syntax := do
ofExcept <| runParserCategory (← getEnv) cat s
-- `by` 自身は構文的にタクティクではない
/- error: <input>:1:0: expected tactic -/
#eval parse `tactic "by"
by のパーサのドキュメントコメントに次のように書かれている通り、by の後にタクティクを続けたものは項(term)になります。
by tacconstructs a term of the expected type by running the tactic(s)tac.
-- `by` の後にタクティクを続けたものは構文的に項(term)になる
#eval parse `term "by rfl"
フィールド記法
フィールド記法(field notation) とは、大雑把に言えば T が e の型であるときに、関数適用 T.f e を e.f と書き表せるという記法のことです。あたかも f が e のフィールドであるかのように見えるのでこの名前があります。
典型的な例は、構造体 S の項 e : S に対して、構造体のフィールドのアクセサ関数 S.f の適用を e.f と書けることです。
/-- 平面 -/
structure Point (α : Type) where
x : α
y : α
-- `Point` のフィールドへのアクセサ関数
#check Point.x
#check Point.y
-- フィールド記法を使ってアクセスすることができる
#guard
let p : Point Nat := { x := 1, y := 2 }
p.x = Point.x p
ここで S は構造体である必要はなく、任意の型で構いません。すなわち任意の型 S とその項 e : S に対して、e.f は S.f (p := e) と解釈されます。ただし、ここで p は関数 S.f の型 S を持つような最初の明示的引数です。
/-- 例示のための意味のない帰納型 -/
inductive S where
| fst (n : Nat)
| snd (s : String) (n : Nat)
/-- `_x : Unit` という余計な引数を持つ関数 -/
def S.toNat (_x : Unit) (s : S) : Nat :=
match s with
| S.fst n => n
| S.snd _ n => n
#guard
let e : S := S.fst 42
-- フィールド記法が使える
e.toNat () = 42
関数型に対して
e が関数であるとき、e.f は Function.f (p := e) に翻訳されます。ただし、ここで p は関数 Function.f の、関数型を持つような最初の明示的引数です。
section
variable {α β γ : Type}
/-- 関数の単射性 -/
def Function.injective (f : α → β) : Prop := ∀ {x y}, f x = f y → x = y
example (f : α → β) (g : β → γ) : (g ∘ f).injective → f.injective := by
-- `g ∘ f` が単射だと仮定する。
intro h
-- このとき `f` は単射である。
exact show f.injective from by
-- なぜなら、仮に `f x = f y` とすると
intro x y hg
-- `(g ∘ f) x = (g ∘ f) y` が成り立っており
have : (g ∘ f) x = (g ∘ f) y := by simp [hg]
-- `g ∘ f` が単射であることから `x = y` が導かれるため。
exact h this
end
パラメータを取る型に対して
e が T ... の項であり、かつ関数 T.f が存在するとき、e.f は T.f (p := e) に翻訳されます。ただし、ここで p は関数 T.f の型 T ... を持つような最初の明示的引数です。
/-- リストの最小値をそのインデックスと共に出力する -/
def List.minIdx? {α : Type} [LE α] [DecidableLE α] (xs : List α) : Option (Nat × α) :=
loop xs 0
where
loop : List α → Nat → Option (Nat × α)
| [], _ => none
| x :: xs, i =>
match loop xs (i + 1) with
| none => some (i, x)
| some (j, y) =>
if x ≤ y then (i, x) else some (j, y)
-- フィールド記法が使用できている
#guard
let e := [3, 1, 4, 1, 5, 9, 2, 6, 5, 3, 5]
e.minIdx? = some (1, 1)
詳細な仕様
詳細な仕様は、パーサのドキュメントコメントに以下のように書かれています。
The extended field notation
e.fis roughly short forT.f ewhereTis the type ofe. More precisely,
- if
eis of a function type,e.fis translated toFunction.f (p := e)wherepis the first explicit parameter of function type- if
eis of a named typeT ...and there is a declarationT.f(possibly fromexport),e.fis translated toT.f (p := e)wherepis the first explicit parameter of typeT ...- otherwise, if
eis of a structure type, the above is repeated for every base type of the structure.The field index notation
e.i, whereiis a positive number, is short for accessing thei-th field (1-indexed) ofeif it is of a structure type.
制約
フィールド記法の制約として、フィールド記法を使用すると型強制が通らなくなります。
/-- 標準のリストのラッパー -/
structure MyList (α : Type) where
data : List α
/-- `MyList` から `List` への型強制 -/
instance {α : Type} : Coe (MyList α) (List α) where
coe l := l.data
-- 型強制がはたらくので本来 List が来るべきところに MyList が来ていても通る
#check
let l : MyList Nat := { data := [1, 2, 3] }
List.foldl (· + ·) 0 l
-- フィールド記法だと型強制がはたらかない
#check_failure
let l : MyList Nat := { data := [1, 2, 3] }
l.foldl (· + ·) 0
match .. with
match .. with は、パターンマッチ(pattern match) に使用されます。
基本的な使い方
コンストラクタによるパターンマッチ
典型的な使用場面は、帰納型 T の項は必ずその有限個のコンストラクタの項のどれかに由来するので、そのどれであるかによって場合分けをしたいときです。
def List.myHead? {α : Type} (xs : List α) : Option α :=
match xs with
| [] => none
| x :: _ => some x
#guard [1, 2, 3].myHead? = some 1
/-- 階乗関数。 -/
def Nat.fatorial (n : Nat) : Nat :=
match n with
| 0 => 1
| m + 1 => (m + 1) * fatorial m
#guard Nat.fatorial 4 = 1 * 2 * 3 * 4
パターンマッチの | に続くのはコンストラクタの像または、コンストラクタの像に展開される式である必要があります。この挙動を変更して任意の関数を使いたい場合、[match_pattern]属性の使用を検討してください。
無名コンストラクタによるパターンマッチ
match .. with 構文はある程度賢く、無名コンストラクタを展開したりすることができます。
/-- 正の自然数 -/
abbrev Pos := { x : Nat // x > 0 }
/-- 正の自然数に対する階乗関数 -/
def Pos.factorial (n : Pos) : Nat :=
match n with
| ⟨1, _⟩ => 1
| ⟨m + 2, h⟩ => (m + 2) * factorial ⟨m + 1, by omega⟩
#guard Pos.factorial ⟨4, by omega⟩ = 1 * 2 * 3 * 4
マッチ結果の証明を取得する
x : T についてパターンマッチしてコンストラクタ cons の枝に入った時、x が cons に由来するという証明を取得したいことがあります。このとき、match h : x with という構文を使用すると、h にその証明が格納されます。
def List.myTail {α : Type} (l : List α) : List α :=
match h : l with
| [] => []
| x :: xs => by
-- `l` が `x :: xs` という形をしていることの証明が取得できている
guard_hyp h : l = x :: xs
exact xs
@ パターン
部分にマッチしつつ、その全体の値を変数として保持したいとき、@ パターンと呼ばれる構文が利用できます。
/-- 自然数を１桁ごとのリストに変換する -/
def Nat.toListNat (n : Nat) : List Nat :=
match n with
| 0 => []
| m@(n + 1) =>
have : m / 10 < m := by grind
Nat.toListNat (m / 10) ++ [(m % 10)]
#guard Nat.toListNat 1234 == [1, 2, 3, 4]
panic!
panic! を使うと、その部分が実行されたときにエラーメッセージが表示されます。
/-- 0 で割るときに警告を出すような除算関数 -/
def safeDiv (x y : Nat) : Nat :=
if y = 0 then panic! "0 で割ることはできません！" else x / y
/-
info: PANIC at safeDiv LeanByExample.Syntax.Panic:8:16: 0 で割ることはできません！
---
info: 0
-/
#eval safeDiv 10 0
panic! で処理は中断しない
注意点として、panic! を使っても処理は中断しません。その部分で期待されている型の Inhabited インスタンスが使用されて、値を返します。(値を返さずに終了することが許されると、パニックするプログラムを Empty の項と見做すことができる可能性が生じて、論理的健全性に問題が生じます。)上記の例でいうと、Nat の Inhabited インスタンスが使用されて 0 が返ります。
-- エラーメッセージが出るだけで処理は中断されていない
#guard safeDiv 10 0 = 0
処理を本当に中断したい場合、たとえば IO モナドで返り値を包んだうえで、例外を throw すればよいでしょう。
/-- ゼロ除算に対して例外を投げるバージョンの割り算 -/
def divIO (x y : Nat) : IO Nat :=
if y = 0 then
throw (IO.userError "0 で割ることはできません！")
else
pure (x / y)
/- error: 0 で割ることはできません！ -/
#eval divIO 10 0
なお環境変数 LEAN_ABORT_ON_PANIC に何か値を設定すると、(たとえば 1) panic! の実行時に処理が実際に中断されるようになります。
panic! は例外を投げない
panic! は例外を投げているわけではなく、try .. catch ブロックで補足することはできません。例外ハンドリングが必要な場合は panic! を使用しない方が良いでしょう。
/-
info: PANIC at safeDiv LeanByExample.Syntax.Panic:8:16: 0 で割ることはできません！
Result: 0
-/
#eval show IO Unit from do
try
let result := safeDiv 10 0
IO.println s!"Result: {result}"
catch e =>
IO.println s!"Caught an error: {e}"
生文字列リテラル
文字列リテラルはダブルクォート " で囲って表現しますが、では " を含む文字列を書きたいときはどうすれば良いのでしょうか？エスケープシークエンスを付けて「これは文字列リテラルの開始/終了の意味ではないよ」と示すのが良くある方法ですね。
/- info: I said "Hello" to you. -/
#eval IO.println "I said \"Hello\" to you."
それが面倒あるいは困難であるとき、r#" と "# で囲むという構文が使用できます。これは 生文字列リテラル(raw string literal) と呼ばれるものです。
def json := r#"
{
"name": "Alice",
"age": 30,
"isStudent": false
}
"#
/-
info:
{
"name": "Alice",
"age": 30,
"isStudent": false
}
-/
#eval IO.println json
s!
s! は、文字列補間を行うための構文です。
def greet (name : String) : String :=
s!"Hello, {name}!"
/- info: "Hello, World!" -/
#eval greet "World"
カスタマイズ
s! 構文は組み込まれた変数に ToString を適用します。
section
-- ## test for ambiguous string
/-
info: s!: Hello, world ⏎
s!: Hello, "world"
-/
#eval
let a := "world "
dbg_trace s!"s!: Hello, {a}"
let b := "\"world\""
dbg_trace s!"s!: Hello, {b}"
return ()
end
代わりに Repr を使うように置き換えることができます。
section
open Lean TSyntax.Compat
def Lean.TSyntax.expandInterpolatedStrChunks' (chunks : Array Syntax) (mkAppend : Syntax → Syntax → MacroM Syntax) (mkElem : Syntax → MacroM Syntax) : MacroM Syntax := do
let mut i := 0
let mut result := Syntax.missing
for elem in chunks do
let elem ←
match elem.isInterpolatedStrLit? with
| none => mkElem elem
| some str => pure <| Syntax.mkStrLit str
if i == 0 then
result := elem
else
result ← mkAppend result elem
i := i+1
return result
def Lean.TSyntax.expandInterpolatedStr' (interpStr : TSyntax interpolatedStrKind) (type : Term) (toTypeFn : Term) : MacroM Term := do
let r ← expandInterpolatedStrChunks' interpStr.raw.getArgs (fun a b => `($a ++ $b)) (fun a => `($toTypeFn $a))
`(($r : $type))
end
syntax:max "d!" interpolatedStr(term) : term
macro_rules
| `(d! $interpStr) => do interpStr.expandInterpolatedStr' (← `(String)) (← `(reprStr))
section
/-
info: d!: Hello, "world "
d!: Hello, "\"world\""
-/
#eval
let a := "world "
dbg_trace d!"d!: Hello, {a}"
let b := "\"world\""
dbg_trace d!"d!: Hello, {b}"
return ()
end
show .. from
show T from e は、型 T の項 e を表す構文です。項に対して型 T を明示することができます。
-- とても単純な使用例
#check show Nat from 1
-- `#eval` コマンドに式を渡す際に、期待される型を明示するために show を用いている例
#eval show IO Unit from do
IO.println "Hello, world!"
IO.println "Goodbye, world!"
また、Lean においては命題 P : Prop は型なので、命題 P の証明を show P from ... の形で構成することができます。
example (P : Prop) (h : P) : P :=
show P from h
よく似た構文を持つものとして、show タクティクがあります。
用途
show .. from 構文を使用すると、have タクティクのように補題を用意することができますが、have と違って補題に名前がつかず、使い捨てになります。たとえば rw タクティクに渡すために一度だけ使いたい補題があるときに有用です。
variable (a b x : ℚ)
example (f : ℚ → ℕ) : f ((a + b) ^ 2) = f (a ^ 2 + 2 * a * b + b ^ 2) := by
-- `have` をつかって補題を用意しなくても、
-- `show ... from` で無名の証明を構成してそれを `rw` に渡すことができる
rw [show (a + b) ^ 2 = a ^ 2 + 2 * a * b + b ^ 2 from by ring]
また証明項のところに メタ変数(metavariable) 1を配置すると、証明を後回しにすることができます。
example (h : a * x < b) (ha : a > 0) : x < b / a := by
-- `b / a` を `r` とおく
set r := b / a with hr
-- ここで `b = a * r` というまだ示していない補題に基づいて `h` を書き換える
rw [show b = a * r from ?lem] at h
exact (Rat.mul_lt_mul_left ha).mp h
-- 本来証明項が入るべきところに `?lem` をおいたので、
-- `case lem` でフォーカスできる
case lem =>
-- `r` の定義を展開する
rw [hr]
-- 分母を払う
field_simp
-
頭に
?がついている変数のこと。 ↩
Σ
Σ は、依存ペア型(dependent pair type) を表します。α : Type u という添え字族によって添え字付けられた型の族 β : α → Type v があるとき、Σ (a : α), β a は α の要素とそれに対応する β a の要素のペアの型を表します。
たとえば、[(Nat, 1), (String, "hello"), (Bool, true)] というようなリストを考えてみます。
このリストに正しく型を付けるにはどうすればいいでしょうか？
通常の直積型では、「右の要素の型が左の要素の型に依存する」ことが許されないので、型を付けることができません。
#check_failure [(Nat, 1), (String, "hello"), (Bool, true)]
しかし、依存ペア型を使うことで解決できます。
この場合、リストの中身の型は Σ (α : Type), α になります。
これは、(α : Type) × α と同じ意味です。
example : (Σ (α : Type), α) = ((α : Type) × α) := by rfl
これを使うと、次のようにリストに型を付けることができます。
def sample : List ((α : Type) × α) :=
[⟨Nat, 1⟩, ⟨String, "hello"⟩, ⟨Bool, true⟩]
依存和型
依存ペア型は、依存和型(dependent sum type) とも呼ばれます。
これは一見すると奇妙に見えます。(a : α) × β a という表記から見ると、掛け算(×)のように見えるからです。
しかし、依存ペア型がどのような関数の 図式(diagram) の中にいるのかを考えると、（つまり周辺の関数を見ると）和との類似が見えてきます。依存型ではない、ただの和型 A ⊕ B を考えると、この型への自然な関数 inl : A → A ⊕ B と inr : B → A ⊕ B が存在し、これは単射です。
variable {A B : Type}
example : (Sum.inl : A → A ⊕ B).Injective := by
intro a1 a2 h
simp_all
example : (Sum.inr : B → A ⊕ B).Injective := by
intro b1 b2 h
simp_all
依存ペア型についても同様に、各構成要素からの自然な関数が存在します。添え字族 α : Type u と型の族 β : α → Type v があるとき、各構成要素 β a からの自然な関数 β a → (a : α) × β a が存在して、これは単射です。
/-- 依存和型への、各構成要素からの自然な関数 -/
def Sigma.inj {α : Type u} (β : α → Type v) (x : α) : β x → (a : α) × β a :=
fun b => ⟨x, b⟩
/-- 自然な関数 `Sigma.inj β x` はすべての `x : α` に対して単射 -/
example {α : Type u} (β : α → Type v) (x : α) : (Sigma.inj β x).Injective := by
intro b1 b2 h
simpa [Sigma.inj] using h
このように周辺の関数との関係を見ると、依存ペア型はペア(積)ではなくて和のように振る舞っていることがわかります。
付録
付録です。以下のような用途で使います。
- Lean の構文要素に対応しない話をする。
- 各ページに載せるには少し長すぎる具体例を紹介する。
- 用語の解説をする。
- 数学の背景知識の解説をする。
カントールの定理
カントールの定理(Cantor’s theorem)とは、集合論における基本的な定理で、どんな集合 X に対しても、そのベキ集合 P(X) の方が真に大きいと主張するものです。Lean では集合論における集合そのものは普通扱わないのですが、型の世界でも同様のことが成り立ちます。
集合の大きさ比較
X が有限集合の場合、これは明らかです。X の要素数が n だとしたら、ベキ集合 P(X) の要素数は 2^n になるからです。この定理の重要なところは、無限集合でも成り立つというところです。
その場合、無限集合の要素数を比較する必要がありますが、集合 X, Y に対して以下のように考えます。
XとYの間に全単射が存在するならば、XとYの要素数は同じである。XからYへの全射が存在しないならば、Xの要素数はYより小さい。（単射による定義と同じ）XからYへの単射が存在しないならば、Xの要素数はYより大きい。(全射による定義と同じ)
X と Y の間にどのような写像が存在するかを見て、有限集合の場合の定義を拡張するわけです。
型の世界への翻訳
Lean は集合論の代わりに型理論を用いますが、型の世界でも同様のことが成り立ちます。
定理のステートメントに登場する集合 X のことは単に型 X : Type u と読み替えれば良いです。ベキ集合をどう表現するかですが、部分集合 A ⊆ X というものを「X の項 x : X に対して、それが A に属するかどうかを表す命題 x ∈ A を対応付けるもの」と読み替えることができて、関数型 X → Prop をベキ集合だと見做すことができます。
/-- ベキ集合 -/
def Set (X : Type u) := X → Prop
全射や単射は Lean に組み込みで定義されているものがあるので、これでカントールの定理のステートメントを述べることができます。
open Function
/-- カントールの定理の全射版 -/
theorem cantor_surjective (f : X → Set X) : ¬ Surjective f := by
sorry
/-- カントールの定理の単射版 -/
theorem cantor_injective (f : Set X → X) : ¬ Injective f := by
sorry
集合の内包記法の用意
このまま証明をすることもできるのですが、このままだと記号が数学での表記と違い過ぎてわかりにくいので、記法を用意します。
まず A : Set X に対して x ∈ A と書けるようにします。
instance : Membership X (Set X) where
mem := fun A x => A x
-- テスト
#check
let A : Set Nat := fun x => x < 5
3 ∈ A
次に、{x : X ∣ P x} という集合内包表記を用意します。これは macro_rules を使用してマクロとして用意します。
/-- 述語から、それが内包によって定める部分集合を作る -/
def setOf (P : X → Prop) : Set X := P
/-- binder という構文カテゴリ。
これは変数束縛を表していて、
`{x : X | P x}` の `x : X` の部分とか
`{x ∈ X | P x}` の `x ∈ X` の部分とかを表している -/
declare_syntax_cat binder
/-- `{x : T | P x}` の `: T` の部分。
あってもなくても良いので `( )?` で囲う -/
syntax ident (" : " term)? : binder
/-- `{x ∈ T | P x}` の `∈ T` の部分。
あってもなくても良いので `( )?` で囲う -/
syntax ident (" ∈ " term)? : binder
/-- 集合の内包表記 -/
syntax "{" binder "|" term "}" : term
/-- `{x : T | P x}` と `{x ∈ T | P x}` の形の式を `setOf` の式に変換する -/
macro_rules
| `({ $var:ident | $body:term }) => `(setOf (fun $var => $body))
| `({ $var:ident : $ty:term | $body:term }) => `(setOf (fun ($var : $ty) => $body))
| `({ $var:ident ∈ $s:term | $body:term }) => `(setOf (fun $var => $var ∈ $s ∧ $body))
-- テスト
#check
let A : Set Nat := {x | x % 2 = 0}
4 ∈ A
全射版の証明
さて、それでは証明を書いていきましょう。全射版も単射版も証明は同じアイデアでできるのですが、全射版の方が素直に証明できるので全射版を証明しましょう。
open Function
/-- カントールの定理の全射版 -/
theorem cantor_surjective (f : X → Set X) : ¬ Surjective f := by
-- 仮に全射 `f : X → Set X` が存在したとする
intro surjf
-- ここで、自分自身の `f` の像に入らないような `x : X` を集めてきてそれを `T` とする
let T : Set X := {x | x ∉ f x}
-- `f` は全射だと仮定したので、`T` は `f` の像にあるはず
-- そこで `f t = T` となる `t : X` を取る
obtain ⟨t, ht⟩ := surjf T
-- `t` が `T` に入るかどうかを考える。
-- まず、`t ∈ T` だと仮定すると矛盾が得られるので `t ∉ T` がわかる
have t_nmem : ¬ (t ∈ T) := by
-- `t ∈ T` だと仮定する
intro mem
-- `T` の定義から、`t ∉ f t` であるはず
have nmem : t ∉ f t := by
dsimp [T, (· ∈ ·), setOf] at mem ⊢
assumption
-- しかし、`f t = T` であることから、これは `t ∉ T` を意味する
rw [ht] at nmem
-- これは矛盾
contradiction
-- `T = f t` であることから、これは `t ∉ f t` を意味し、
-- すなわち `t ∈ T` ということになる。
have t_mem : t ∈ T := by
rw [← ht] at t_nmem
dsimp [T, (· ∈ ·), setOf] at *
assumption
-- これは矛盾
contradiction
対角線論法
全射版カントールの定理の証明の中では、全射 f : X → Set X が存在すると仮定したときに、そこから {x | x ∉ f x} という集合を作ってくるところが核心でした。このテクニックは 対角線論法(diagonal argument) と呼ばれます。この議論を最初に考案したのは ゲオルク・カントール(Georg Cantor) であることから、カントールの対角線論法とも呼ばれます。
なんで「対角線」なのか疑問に思われたでしょうか？これは、図解してみるとわかります。
たとえば、X = {x₁, x₂, x₃, x₄, x₅} という有限集合を考えましょう。ここでどのような関数 f : X → Set X が与えられたとしても、f の像に入っていない部分集合 T : Set X を構成する具体的な手続きがあるかどうか考えてみましょう。
まず、X の部分集合は各 xᵢ を含んでいるか含んでいないかの長さ5のビット列で表すことができます。それぞれ 1 と 0 で表すことにすれば、X の部分集合はベクトルで表せます。たとえば {x₂, x₃, x₄} は [0, 1, 1, 1, 0] のように表せますね。そう考えると、各 f : X → Set X は２次元の表で表すことができます。
たとえば、常に {x₁} という１点集合を返す恒等関数 f は次の表と対応します。
それでは、何か仮に f : X → Set X という関数が与えられたとしましょう。その f を表で表したら、次のような表になっていたとします。（これは具体的に図を描かなければいけないので仮に決めただけで、本当はどんな関数でもよいです）
そうしたら、この表の対角線部分に着目します。
[1, 0, 0, 1, 1] というビット列が得られますね。これを各ビット反転させます。0 を 1 に、1 は 0 にするわけです。そうすると、[0, 1, 1, 0, 0] というビット列が得られます。これに対応する部分集合は {x₂, x₃} ですね。
そうすると、こうして得られた部分集合 T := {x₂, x₃} は f の像に入っていないことがわかります。この例では X は有限集合なので全部チェックすればわかりますが、X が無限集合であろうと何だろうと必ずそうなります。なぜかというと、どの x : X に対しても f x と T は「x が属しているかどうか」が逆になるからです。したがって T は f の表には絶対に登場しないと断言することができ、したがって f は全射ではありえないと結論付けることができます。
このようにして得られた T こそ、カントールの定理（全射版）の証明で登場した {x | x ∉ f x} そのものです。だから、対角線論法と呼ばれるわけですね。
クワイン
そのプログラムを実行した時の標準出力が自分自身と等しくなるようなコードを書くことができます。そのようなコードを クワイン（Quine） と呼ぶのですが、Lean 4 ではクワインはたとえば次のようにして作ることができます。1
def s := "\ndef main : IO Unit := do\n IO.println (\"def s := \" ++ s.quote)\n IO.println (s)"
def main : IO Unit := do
IO.println ("def s := " ++ s.quote)
IO.println (s)
-
このコード例は leanprover-community/lean4-samples に対するPR からの引用です。 ↩
じゃんけんゲーム
じゃんけんゲームを CLI で実装する例を紹介します。以下のような仕様で実装しましょう。
- ユーザはテキストで「グー」「チョキ」「パー」のいずれかを入力する。
- コンピュータはランダムに手を選ぶ（後出ししているように見えるが、実際にはランダム）
- あいこだった場合は勝負がつくまで何度でも繰り返す。
ステップ1: ユーザが入力した手を表示する
Lean でプログラムを書く際はだいたいいつもそうですが、必要なデータ型を定義するところから始めます。じゃんけんの手を表す型 Hand を定義しましょう。グー・チョキ・パーの３種類です。
/-- じゃんけんの手 -/
inductive Hand where
/-- グー -/
| gu
/-- チョキ -/
| choki
/-- パー -/
| pa
deriving BEq, Inhabited
protected def Hand.toString : Hand → String
| .gu => "グー"
| .choki => "チョキ"
| .pa => "パー"
instance : ToString Hand where
toString := Hand.toString
次に、ユーザから受け取る文字列をパースして Hand に変換する関数を用意しましょう。文字列のパースに成功するとは限りませんが、その場合は成功するまで繰り返し何度でも入力を促すことにします。
/-- ユーザからの入力を受け取る -/
def getUserInput : IO String := do
-- 入力待ちを表す記号を表示
IO.print "> "
let stdin ← IO.getStdin
let input ← stdin.getLine
let result := input.trimAscii.copy
return result
/-- 文字列を読んで Hand に変換する -/
def parseHand (input : String) : Option Hand :=
match input with
| "グー" => some Hand.gu
| "チョキ" => some Hand.choki
| "パー" => some Hand.pa
| _ => none
/-- ユーザからの入力を受け取ってパース済みの値を返す。
パースに失敗した場合は、成功するまで繰り返す -/
partial def getUserHand : IO Hand := do
let userInput ← getUserInput
let some hand := parseHand userInput |
IO.println "そんな手はないよ！もう一回！"
getUserHand
return hand
ここまで終わったら、いったんここまでのコードを使って main 関数を実装してみます。
def main : IO Unit := do
IO.println "私とじゃんけんをしよう！"
IO.println "グー、チョキ、パーのどれかを選んで！"
let yourHand ← getUserHand
IO.println s!"{yourHand}を選んだんだね！"
この段階でもしうまく行かなければ、日本語の文字が文字化けしている可能性があります。インストール方法のターミナルでの文字化けの修正方法を試してみてください。
ステップ2: コンピュータとの勝負を実装する
次にやるべきことは、コンピュータの手をランダムに選ぶことです。Lean には乱数を生成するための関数が用意されているので、それを使います。
/-- ランダムに手を選ぶ -/
def getRandomHand : IO Hand := do
let n ← IO.rand 1 3
let hand :=
match n with
| 1 => Hand.gu
| 2 => Hand.choki
| 3 => Hand.pa
| _ => unreachable!
return hand
-- ちゃんと３つの手が全部出るか確認する
#eval List.range 10 |>.mapM (fun _ => getRandomHand)
問題がなければ、勝敗判定を実装します。
/-- h1 が h2 に勝つかどうかを判定する -/
def Hand.beat (h1 h2 : Hand) : Bool :=
match h1, h2 with
| .gu, .choki => true
| .choki, .pa => true
| .pa, .gu => true
| _, _ => false
ここまで終われば、最後まで実装することができるでしょう。 あいこだった場合は、勝負がつくまで何度でも繰り返すことにします。
open Hand
def main : IO Unit := do
IO.println "私とじゃんけんをしよう！"
IO.println "グー、チョキ、パーのどれかを選んで！"
let mut finish := false
while !finish do
let yourHand ← getUserHand
let cpuHand ← getRandomHand
IO.println s!"私は{cpuHand}を出したよ！"
if beat yourHand cpuHand then
IO.println "あなたの勝ち！負けちゃったなぁ"
finish := true
else if beat cpuHand yourHand then
IO.println "私の勝ち！うれしい！"
finish := true
else
IO.println "あいこだね！もう一勝負！"
三目並べ
Lean で、CLI ゲームとして三目並べを実装してみましょう。
盤面を定義する
まずは三目並べの盤面を作ってみます。盤面がどのようなものが考えてみると、次のようなものです。
- 盤面は9マスある
- 盤面の各マスは、各プレイヤーの着手したマークが入っているか、あるいは空であるかどちらか
- 最初は全てのマスが空
盤面は 3×3 の二次元的な構造を持っているのですが、サイズが小さいので二次元配列として持つよりも一次元配列として持った方が簡単です。そこで、盤面は長さ9のベクトル(長さが固定された配列)として持つことにします。
/-- プレイヤー -/
inductive Player where
/-- 先手 -/
| x
/-- 後手 -/
| o
/-- 盤面 -/
abbrev Board := Vector (Option Player) 9
/-- 盤面の初期状態 -/
def Board.initial : Board := Vector.replicate 9 none
盤面を表示する
次に、盤面を表示できるようにしましょう。既に埋まっている部分はそのまま表示し、空の部分にはユーザが着手場所を選ぶときわかりやすいように、番号を振って表示することにします。
/-- Player を文字列として表示する。
数字の `0` と `Player.o` の区別がつきやすいようにしてある -/
instance : ToString Player where
toString := fun p =>
match p with
| .x => "×"
| .o => "●"
/-- 配列を二次元配列に変換する。
サイズが期待と異なる場合は `panic!` を呼ぶ -/
def Array.reshape (m n : Nat) (xs : Array α) : Array (Array α) :=
if xs.size ≠ m * n then
panic! s!"{decl_name%}: size mismatch"
else
Array.range m |>.map (fun i => xs.extract (n * i) (n * (i + 1)))
#guard
let actual := Array.reshape (m := 2) (n := 3) #[1, 2, 3, 4, 5, 6]
let expected := #[#[1, 2, 3], #[4, 5, 6]]
actual = expected
/-- 配列の要素の間に区切りを挿入する -/
def Array.intersperse (xs : Array α) (sep : α) : Array α :=
match xs.toList with
| [] => #[]
| x :: rest =>
rest.foldl (fun acc y => acc ++ #[sep, y]) #[x]
#guard Array.intersperse #[1, 2, 3] 0 = #[1, 0, 2, 0, 3]
/-- 盤面を表示するための補助関数 -/
def Board.toStrArray (b : Board) : Array String :=
let rawStrArray := b.toArray
|>.zipIdx
|>.map (fun (p?, idx) =>
match p? with
| none => toString idx
| some p => toString p)
let rows2D := rawStrArray.reshape (m := 3) (n := 3)
let rows1D := rows2D.map (fun row =>
let inner := String.intercalate " | " row.toList
s!"| {inner} |"
)
let boader := "+---+---+---+"
#[boader] ++ rows1D.intersperse boader ++ #[boader]
/-- 盤面を表示する関数。
IO 部分を少なくするため、補助関数を薄く包むだけにしてある -/
def Board.display (b : Board) : IO Unit := do
for str in b.toStrArray do
IO.println str
-- テスト用に、盤面を簡便に構成するための補助定義
def X : Option Player := Player.x
def O : Option Player := Player.o
def E : Option Player := none
/-
info:
+---+---+---+
| × | ● | 2 |
+---+---+---+
| 3 | × | 5 |
+---+---+---+
| ● | 7 | × |
+---+---+---+
-/
#eval
let board : Board := #v[
X, O, E,
E, X, E,
O, E, X
]
Board.display board
盤面の勝敗判定をする
次に、盤面の勝敗判定を実装してみます。勝敗は、以下の３通りのどれかになります。
- 引き分け
Xを持っているプレイヤーの勝ちOを持っているプレイヤーの勝ち
/-- ゲームの結果 -/
inductive Result where
/-- `winner` を持っているプレイヤーの勝ち -/
| win (winner : Player)
/-- 引き分け -/
| draw
/-- 勝敗判定に使われるライン -/
abbrev Line := Vector (Fin 9) 3
/-- 勝敗判定に使われるラインを全部列挙したもの -/
def allLines : Array Line :=
let row0 := #v[0, 1, 2]
let row1 := #v[3, 4, 5]
let row2 := #v[6, 7, 8]
let col0 := #v[0, 3, 6]
let col1 := #v[1, 4, 7]
let col2 := #v[2, 5, 8]
let diag1 := #v[0, 4, 8]
let diag2 := #v[2, 4, 6]
#[row0, row1, row2, col0, col1, col2, diag1, diag2]
def checkLine (line : Line) (board : Board) (P : Player → Bool) : Bool :=
line.all (fun pos =>
let player? := board[pos]
(P <$> player?).getD false
)
def Board.checkForLines (board : Board) (P : Player → Bool) : Bool :=
allLines.any (checkLine · board P)
-- Player 等の DecidableEq インスタンスを自動生成する
deriving instance DecidableEq for Player, Result
/-- 盤面の勝敗判定をする。
まだゲームが続けられる場合は `none` を返す。 -/
@[grind =]
def Board.result? (board : Board) : Option Result :=
let wins : Player → Bool :=
fun p => board.checkForLines (· = p)
let draw := board.all (·.isSome)
if wins .x then
some <| .win (Player.x)
else if wins .o then
some <| .win (Player.o)
else if draw then
some .draw
else
none
#guard
let board : Board := #v[
X, O, X,
O, X, O,
O, X, X
]
board.result? = some (Result.win Player.x)
#guard
let board : Board := #v[
X, O, E,
E, E, E,
O, E, X
]
board.result? = none
着手の実装
Option を返すバージョン
盤面のまだ着手されていない場所を選んで、着手ができるようにしましょう。着手しようとしている場所が既に着手済みの場合にどうするかという問題がありますが、とりあえず素直なのは none を返すようにすることでしょうか。
/-- 盤面上の場所 -/
abbrev Position := Fin 9
/-- 盤面上の場所 `move` にプレイヤー `p` が手を置き、新しい盤面を返す。
ただし、既に着手されている場合は `none` を返す。 -/
def Board.place? (board : Board) (move : Position) (p : Player) : Option Board :=
match board[move] with
| some _ => none
| none => some (board.set move (some p))
#guard show Bool from Id.run do
let board : Board := #v[
X, O, E,
E, E, E,
O, E, X
]
let .some actual := board.place? 2 Player.x
| return false
let expected : Board := #v[
X, O, X,
E, E, E,
O, E, X
]
actual == expected
#guard
let board : Board := #v[
X, O, E,
E, E, E,
O, E, X
]
(board.place? 1 Player.x).isNone
合法性の証明を受け取るバージョン
返り値を Option に包むのは簡便ですが、着手済みでないことが分かっている場合でも Option を剥がす処理を書かなければいけなくなります。これを回避することができるように、「着手箇所が空であることの証明」を引数に持たせるバージョンも定義しておきましょう。
/-- 合法な着手 -/
structure LegalMove (b : Board) where
/-- 盤面 `b` 上の着手箇所 -/
move : Position
/-- 着手箇所が空であることの証明 -/
proof : b[move] = none
/-- `LegalMove` の項を作るための補助関数。
`move` が具体的な数であれば、`decide` により自動的に証明が生成されて通る。 -/
def Board.legalCheck (b : Board) (move : Position) (h : b[move] = none := by decide) : LegalMove b :=
{ move := ⟨move, by simp⟩, proof := h }
/-- 合法な着手箇所が与えられたときに、そこに着手した新しい盤面を返す。-/
def Board.place (board : Board) (move : LegalMove board) (p : Player) : Board :=
board.set move.move (some p)
/-
info:
+---+---+---+
| × | ● | × |
+---+---+---+
| 3 | 4 | 5 |
+---+---+---+
| ● | 7 | × |
+---+---+---+
-/
#eval
let board : Board := #v[
X, O, E,
E, E, E,
O, E, X
]
let legalMove := board.legalCheck 2
let newBoard := board.place legalMove Player.x
Board.display newBoard
合法手の列挙
将来的に「その盤面において合法な手を全列挙する」という関数が欲しくなることが予想されるので、それも実装しておきます。
/-- 合法な着手箇所を全列挙する -/
def Board.legalMoves (b : Board) : List (LegalMove b) :=
List.finRange 9 |>.filterMap (fun pos =>
match h : b[pos] with
| none => some { move := pos, proof := h }
| some _ => none
)
#guard
let board : Board := #v[
X, O, E,
E, E, E,
O, E, X
]
board.legalMoves.map (fun legalMove => legalMove.move.val) = [2, 3, 4, 5, 7]
この関数の実装は何も見ずに行うとするとおそらく難しいでしょう。ポイントは List.finRange を使用することです。
補題の用意
後で必要になるので、合法手を全列挙する関数 legalMoves に関する補題をいくつか用意しておきます。おもに「ゲームが進行中なら、合法な手が存在する」というのが欲しい命題です。
/-- ゲームが進行中 -/
@[grind =]
def Board.inProgress (board : Board) : Bool :=
board.result? = none
theorem Board.noLegalMove_iff_allSome (board : Board) : board.legalMoves = [] ↔ board.all Option.isSome := by
unfold Board.legalMoves
simp only [
Fin.getElem_fin,
List.filterMap_eq_nil_iff,
List.mem_finRange,
forall_const,
Vector.all_eq_true
]
constructor
· intro h pos hpos
specialize h ⟨pos, hpos⟩
grind
· intro h
grind
grind_pattern Board.noLegalMove_iff_allSome => board.legalMoves, []
theorem Board.notInProgress_of_allSome (board : Board) (h : board.all Option.isSome) : ¬board.inProgress := by
unfold Board.inProgress
simp [Board.result?]
grind only [= Vector.all_eq]
grind_pattern Board.notInProgress_of_allSome => board.all Option.isSome, board.inProgress
theorem Board.legalMoveExists (board : Board) (h : board.inProgress) : board.legalMoves ≠ [] := by
intro hEmpty
have : board.all Option.isSome := by grind
grind only [usr notInProgress_of_allSome]
grind_pattern Board.legalMoveExists => board.legalMoves, board.inProgress
CPU の思考アルゴリズムの実装
次はいよいよ、CPU の思考アルゴリズムを実装します。単に「ランダムに手を選ぶ」ような CPU を実装しても良いのですが、せっかくなので賢い CPU を実装してみます。次のような方針で実装しましょう。
- 次に着手できる場所をすべてリストアップする。
- 各盤面の評価値（自分が有利なのか不利なのかを表す値）を計算して、最も評価値が高いものを選ぶ。
評価値の計算
問題は評価値の計算方法ですが、以下のような方針で計算することができます。
- 自分が勝ちの局面では
10点 - 相手が勝ちの局面では
-10点 - 引き分けの場面では
0点 - それ以外の局面では、「自分も相手も最善手を打った場合にどうなるか」を考えて決める。 具体的には、次の手で到達可能な局面をまずすべて調べる。 そして自分の手番なら評価値が最大になる手を選んで、その評価値を採用する。 相手の手番なら自分から見た評価値が最小になる手を選んで、その評価値を採用する。
- なるべく短い手順で勝利するほど、高い評価値を与えるようにする
これを素直に実装すると、相互再帰関数 になります。
/-- そのプレイヤーの対戦相手 -/
def Player.opponent : Player → Player
| .x => .o
| .o => .x
/-- 現在手番を持っているプレイヤー -/
def Board.current (b : Board) : Player :=
let xCount := b.count (some Player.x)
let oCount := b.count (some Player.o)
if xCount ≤ oCount then
Player.x
else
Player.o
/-- 盤面の複雑さの指標。
なるべく短い手順で勝利するほど、高い評価値を与えるために使用 -/
def Board.depth (b : Board) : Nat :=
b.toArray
|>.filter Option.isSome
|>.size
/-- 空であるという性質は、`map` をかましても変わらない。 -/
@[grind norm]
theorem List.map_respect_emptiness (xs : List α) (f : α → β) : xs.map f = [] ↔ xs = [] := by
simp only [← length_eq_zero_iff, length_map]
mutual
/-- この盤面で `p` が手番を持っている場合に、`p` から見た盤面の評価値 -/
partial def Board.maxScore (board : Board) (p : Player) : Int :=
match h : board.result? with
| some (Result.win winner) =>
if winner = p then 10 - board.depth else board.depth - 10
| some Result.draw => 0
| none =>
let nextMoves := board.legalMoves
let nextBoards := nextMoves.map (board.place · p)
let nextScores := nextBoards.map (fun b => Board.minScore b p)
-- `List.max` 関数は空でないリストに対してしか使えないので、
-- 空でないことを証明する必要がある。
have h : nextScores ≠ [] := by grind
nextScores.max h
/-- この盤面で `p` の対戦相手が手番を持っている場合に、`p` から見た盤面の評価値 -/
partial def Board.minScore (board : Board) (p : Player) : Int :=
match h : board.result? with
| some (Result.win winner) =>
if winner = p then 10 - board.depth else board.depth - 10
| some Result.draw => 0
| none =>
let nextMoves := board.legalMoves
let nextBoards := nextMoves.map (board.place · p.opponent)
let nextScores := nextBoards.map (fun b => Board.maxScore b p)
-- `List.min` 関数は空でないリストに対してしか使えないので、
-- 空でないことを証明する必要がある。
have h : nextScores ≠ [] := by grind
nextScores.min h
end -- mutual の終わり
/-- プレイヤー `p` から見た盤面の評価値 -/
def Board.score (board : Board) (p : Player) : Int :=
if board.current = p then
Board.maxScore board p
else
Board.minScore board p
-- `x` から見ると、既に勝っている場面
#guard
let board : Board := #v[
X, O, E,
E, X, E,
O, E, X
]
Board.score board Player.x > 0
-- `x` から見ると、あと一手で勝てる必勝局面
#guard
let board : Board := #v[
X, O, E,
E, E, E,
O, E, X
]
Board.score board Player.x > 0
-- `o` から見ると、あと一手で勝てる必勝局面
#guard
let board : Board := #v[
X, O, E,
X, O, X,
O, E, X
]
Board.score board Player.o > 0
-- `o` が手番。
-- `o` は `x` の勝ちを防ぐことができるので引き分け
#guard
let board : Board := #v[
X, X, E,
E, O, E,
E, E, E
]
Board.score board Player.x = 0
-- どちらの盤面も必勝局面だが、
-- 短い手順で勝利している方を高く評価する
#guard
let board1 : Board := #v[
O, E, E,
X, X, X,
O, E, E
]
let board2 : Board := #v[
O, X, E,
X, X, E,
O, E, E
]
board1.score .x > board2.score .x && board2.score .x > 0
手の選択の実装
評価値が手に入ったら、後はその評価値が最大になる手を選ぶだけです。実際に実装してみましょう。
ここでは、複数の候補手が同じ評価値を持つ場合は最も左上にある手を選ぶことにします。そうすると関数が決定的になってテストがやりやすいからです。
@[simp, grind =]
theorem List.mergeSort_respect_nonEmpty (xs : List α) (f : α → α → Bool) :
xs.mergeSort f = [] ↔ xs = [] := by
simp only [← length_eq_zero_iff, length_mergeSort]
/-- `board.inProgress` の証明を埋めるために使うタクティク -/
macro "check_progress" : tactic => `(tactic| first
| assumption
| cbv
)
/-- 盤面 `board` において、プレイヤー `p` の最善手を探索する -/
def Board.selectBestMove (board : Board) (p : Player) (h : board.inProgress := by check_progress) : LegalMove board :=
let nextMoves := board.legalMoves
let scoredMoves := nextMoves.map (fun move =>
let newBoard := board.place move p
let score := Board.score newBoard p
(move, score)
)
let sortedScoredMoves := scoredMoves.mergeSort (fun (pos1, score1) (pos2, score2) =>
score1 > score2 || (score1 = score2 && pos1.move.val < pos2.move.val)
)
-- `List.head` 関数は空でないリストに対してしか使えないので、空でないことを証明する必要がある。
have h : sortedScoredMoves ≠ [] := by grind
let ⟨bestMove, score⟩ := sortedScoredMoves.head h
bestMove
#guard show Bool from
let board : Board := #v[
X, O, E,
E, E, E,
O, E, X
]
let move := Board.selectBestMove board Player.x
let actual := board.place move Player.x
let expected : Board := #v[
X, O, E,
E, X, E,
O, E, X
]
actual = expected
ユーザーの入力を受け取る
ここまで対話的な要素なしで実装を勧めてきましたが、そろそろユーザーからの入力を受け取れるようにしましょう。ユーザーからの入力は文字列の形で受け取ることになるので、それをパースする処理がまず必要です。
パース時には様々なエラーが起こりえますが、Except モナドを使うとエラーメッセージを伝播させる処理を簡単に書くことができます。
/-- 文字列を `Position` としてパースする -/
def Position.parse (s : String) : Except String Position :=
let s := s.trimAscii.copy
match s.toNat? with
| none => throw s!"{s} は数字ではありません"
| some n =>
if h : n < 9 then
return ⟨n, h⟩
else
throw s!"0~8 の範囲で入力してください"
/-- 文字列を `LegalMove` としてパースする -/
def LegalMove.parse (board : Board) (s : String) : Except String (LegalMove board) := do
let s := s.trimAscii.copy
let pos ← Position.parse s
match h : board[pos] with
| none => return { move := pos, proof := h }
| some _ => throw s!"{s} は既に着手済みです"
後は、標準入力から文字列を受け取る処理を書くだけです。
/-- ユーザーから入力を受け取って合法な手を返す -/
partial def getUserInput (b : Board) : IO (LegalMove b) := do
IO.print "> " -- 入力待ちの記号を出力する
let stdin ← IO.getStdin
let input ← stdin.getLine
let move? := LegalMove.parse b input
match move? with
| Except.ok move => return move
| Except.error err =>
-- エラーだった時、即座に終了するのではなく、
-- 正しい入力が返ってくるまで何回でも繰り返す
IO.println err
getUserInput b
ゲームのループを実装する
ここまで終わると、後はゲームのループを回すだけです。
ここまで大変でしたが、CPU が強過ぎるのでユーザーが勝つことはできません。残念ですね。
instance : ToString (LegalMove b) where
toString move := toString move.move.val
def main : IO Unit := do
let mut board := Board.initial
-- ユーザーを先手とする
let mut currentPlayer := Player.x
while h : board.inProgress do
if currentPlayer = Player.x then
-- ユーザーの手番
Board.display board
let move ← getUserInput board
board := board.place move currentPlayer
else
-- CPU の手番
let move := board.selectBestMove currentPlayer
IO.println s!"CPU は {move} に着手しました。"
board := board.place move currentPlayer
-- 手番を交代する
currentPlayer := currentPlayer.opponent
-- ゲーム終了後の結果表示
IO.println "ゲーム終了！"
board.display
match board.result? with
| some (Result.win winner) =>
IO.println s!"勝者は {winner} です！"
| some Result.draw =>
IO.println "引き分けです！"
| none =>
throw <| .userError "予期せぬエラーが発生しました。"
嫉妬深い夫たちの川渡りパズル
嫉妬深い夫の問題(Jealous Husbands Problem) と呼ばれる、以下の古典的なパズルを Lean で解いてみましょう。
3 組の夫婦が川を渡らなければならないが、以下のような制約がある。
- 船が一隻あるが、一度に２人までしか乗ることができない。
- 船は、当然だが誰か漕ぐ人がいなければ動かすことができない。
- 全ての人が船を漕ぐことができる。
- どの男性も大変嫉妬深いので、川のこちら岸にいるときも、向こう岸にいるときも、船に乗っているときも、自分がいないときに自分の妻と他の男性が一緒にいることを許さない。
この制約条件のもとで全員が川を渡って向こう岸に辿り着くことはできるだろうか？
問題文を Lean で表現する
まずは問題文の状況を Lean で表現してみます。男性と女性が３人ずつ、合計で６人いるのですから次のような型を考えると良さそうです。
/-- 人間 -/
inductive Person where
/-- 男性 -/
| man (id : Fin 3)
/-- 女性 -/
| woman (id : Fin 3)
deriving Inhabited, BEq
Lean での実装がうまくいっているのか見るために、今いる登場人物全体、男性全体、女性全体といったものを表現できることを確かめておきましょう。
/-- 男性全体 -/
def men := [0, 1, 2].map Person.man
/-- 女性全体 -/
def women := [0, 1, 2].map Person.woman
/-- 登場人物全体 -/
def people := men ++ women
夫婦であるような男女ペアと、そうでない男女ペアが存在するというのも表現しなければいけません。配偶者を取得する関数を用意します。実装がシンプルになるので、同一 id を持つ男性と女性が夫婦であることにします。
/-- 配偶者を取得する -/
def Person.spouse (p : Person) : Person :=
match p with
| .man id => .woman id
| .woman id => .man id
次に、人々の状態を表す型が欲しいです。川の両岸にいま誰がいて、船はどちらに停泊していて、船に誰が乗っていて、船がこちら岸と向こう岸のどちらにいるのか、といった状態をこの型で表現したいです。
/-- 岸 -/
inductive Bank where
/-- こちら岸 -/
| here
/-- 向こう岸 -/
| there
deriving Inhabited, BEq
/-- 人のいる場所 -/
inductive Place where
/-- 岸にいる -/
| ofBank (bank : Bank)
/-- 船に乗っている -/
| boat
deriving Inhabited, BEq
/-- 人々の状態 -/
structure State where
/-- 各人がいる場所 -/
place : Person → Place
/-- 船がどちらの岸にいるか -/
boat : Bank
deriving Inhabited
これで、各時点での状態を表現することができました。初期状態とゴール状態を定義することができるか、確かめておきましょう。
/-- 初期状態。全員こちら岸にいて、船もこちら岸にある -/
def initial : State :=
{ place := fun _ => Place.ofBank .here, boat := .here }
/-- ゴール状態。全員向こう岸にいて、船も向こう岸にある -/
def final : State :=
{ place := fun _ => Place.ofBank .there, boat := .there }
状態の表示
このままだと s : State を見やすく表示する方法が存在せずデバッグに困るので、表示方法を指定しておきます。
protected def Person.toString (p : Person) : String :=
match p with
| .man id => s!"🚹{id}"
| .woman id => s!"🚺{id}"
instance : ToString Person := ⟨Person.toString⟩
protected def State.toString (s : State) : String :=
-- こちら岸にいる人
let peopleHere := people.filter (fun p => s.place p == .ofBank .here)
-- 向こう岸にいる人
let peopleThere := people.filter (fun p => s.place p == .ofBank .there)
-- 船の位置と、船に乗っている人
let peopleOnBoat := people.filter (fun p => s.place p == .boat)
let boat :=
match s.boat with
| .here => s!"__{peopleOnBoat}🚢"
| .there => s!"🚢{peopleOnBoat}__"
s!"{peopleThere}{boat}{peopleHere}"
instance : ToString State := ⟨State.toString⟩
/- info: "[]__[]🚢[🚹0, 🚹1, 🚹2, 🚺0, 🚺1, 🚺2]" -/
#eval toString initial
/- info: "[🚹0, 🚹1, 🚹2, 🚺0, 🚺1, 🚺2]🚢[]__[]" -/
#eval toString final
状態の遷移
次は、各状態から「どの状態へは１ステップで遷移できて、どの状態へはできないのか」を表現したいですね。それができれば、状態遷移のグラフが得られたことになり、そのグラフを 幅優先探索(breadth first search) すれば、初期状態からゴール状態までの最短経路が求まるからです。
まず、ある状態が問題文の条件を満たしているかどうかを判定する関数を用意しましょう。
/-- 状態が問題文の条件を満たす。
* 船には２人までしか乗っていない
* すべての女性は「自分の夫と一緒にいるか、あるいはどの男性とも一緒にいない」 -/
def State.isValid (s : State) : Bool :=
let boatCond : Bool := people
|>.filter (fun p => s.place p == .boat)
|> (List.length · ≤ 2)
let womenCond : Bool :=
women.all (fun w =>
s.place w == s.place w.spouse || -- 自分の夫と一緒にいる
men.all (fun m => s.place m != s.place w) -- どの男性とも一緒にいない
)
boatCond && womenCond
-- テスト。初期状態とゴール状態は条件を満たす
#guard initial.isValid
#guard final.isValid
以降、問題文にある条件を満たすことを単に「妥当である」ということにします。
次に、ある状態から１ステップで遷移できる妥当な状態を全列挙する関数を用意しましょう。１ステップでできることというのは、次の３通りですね。
- 船に乗っている人を１人岸に下ろす
- 岸にいる人を１人船に乗せる
- 誰かが船を漕いで対岸に移動させる
(船に２人乗せるのは、１人乗せるのを繰り返せば実現できるのでここでは１ステップと認めないことにしました)
/-- `p` さんの乗船状態をトグルして新しい状態を得る。
`p` さんが乗船済みであれば降ろし、`p` さんが岸にいるなら船に乗せる。
以下の場合は失敗して `none` を返す
* `p` さんがいる岸に船が停泊していない場合。
* 得られた状態が妥当な状態ではない場合。
-/
def State.putOff (s : State) (p : Person) : Option State :=
let candidate? : Option State :=
match s.place p with
-- p さんが船に乗っている場合
| .boat =>
let newPlace : Person → Place := fun x =>
if x == p then
-- p さんを船から降ろす
.ofBank s.boat
else
-- 他の人はそのまま
s.place x
some { s with place := newPlace }
-- p さんが岸にいる場合
| .ofBank bank =>
if bank != s.boat then
-- p さんがいる岸に、船が停まっていない場合は、乗れない
none
else
let newPlace : Person → Place := fun x =>
if x == p then
-- p さんを船に乗せる
.boat
else
-- 他の人はそのまま
s.place x
some { s with place := newPlace }
match candidate? with
| .some state =>
if state.isValid then some state else none
| .none => none
/-- 対岸を取得する -/
def Bank.toggle (b : Bank) : Bank :=
match b with
| .here => .there
| .there => .here
/-- 船を対岸に移動させる。
ただし、誰かが船に乗っていなければ失敗して `none` を返す -/
def State.boatTrip (s : State) : Option State :=
if people.any (fun p => s.place p == .boat) then
some { s with boat := s.boat.toggle }
else
none
/-- ある状態から、次に１ステップで遷移可能な妥当な状態を全列挙する。-/
def State.nextStates (s : State) : List State :=
people
|>.map (State.putOff s ·)
|> (s.boatTrip :: ·)
|>.reduceOption
幅優先探索
後は、予告したように幅優先探索を行います。
幅優先探索は、グラフを探索してあるノードから別のノードへの最短経路を求めるためによく用いられるアルゴリズムです。幅優先探索は、グラフを探索しながら「次に訪れるべきノード」を何かしらのキューに保存していくことによって実装できます。Lean では Std.Queue が標準的なキューの実装として用意されているので、それを使います。
話をできるだけ一般的にするために、ここでは Graph という型クラスを定義しておいて、それに対して幅優先探索アルゴリズムを実装します。
class Graph (α : Type u) where
/-- ノード `v` に隣接しているノードのリストを返す -/
neighbors : α → List α
variable [BEq α] [Hashable α]
open Std
/-- あるノード `s` から始めて、ノード `t` に到達するまでの幅優先探索を行う。
後で経路を復元するために、親ノードを記録した辞書を返す -/
def Graph.bfs [Graph α] (s t : α) : HashMap α α := Id.run do
-- キューを空の状態で初期化
-- このキューは「これから訪問するべきノード」を管理する
let mut q : Queue α := ∅
-- 親ノードを記録する辞書
let mut parent : HashMap α α := ∅
-- 訪問済みであるかどうか管理する集合
let mut visited : HashSet α := ∅
-- 初期ノードをキューに追加
q := q.enqueue s
visited := visited.insert s
-- キューが空になるまでループ
while !q.isEmpty do
-- キューからノードを取り出す
let some (v, q') := q.dequeue? | unreachable!
q := q'
-- 目的のノードに出会ったら探索を終了する
if v == t then
break
for u in Graph.neighbors v do
if u ∉ visited then
visited := visited.insert u
parent := parent.insert u v
q := q.enqueue u
return parent
/-- グラフの親を記録した辞書から、ノード `t` への経路を復元する -/
def constructPath (parent : HashMap α α) (t : α) : List α := Id.run do
let mut path : List α := []
let mut cur? : Option α := t
while cur?.isSome do
let some cur := cur? | unreachable!
path := cur :: path
cur? := parent[cur]?
path
/-- 幅優先探索によって、ノード `s` からノード `t` への最短パスを求める -/
def Graph.findShortestPath [Graph α] (s t : α) : List α :=
let parent := Graph.bfs s t
constructPath parent t
探索の実行
後は、State に対して幅優先探索を実行しましょう。まず、Graph のインスタンスにします。
instance : Graph State where
neighbors := State.nextStates
次に BEq のインスタンスにします。
/-- 2つの状態が等しいかどうかを判定する -/
def State.beq (s1 s2 : State) : Bool :=
s1.boat == s2.boat && people.all (fun p => s1.place p == s2.place p)
/-- `==` という記号が使えるようにする -/
instance : BEq State := ⟨State.beq⟩
経路を出力するために辞書を使う関係で、Hashable のインスタンスも必要です。
deriving instance Hashable for Bank, Place
protected def State.hash (s : State) : UInt64 :=
let places := .ofBank s.boat :: people.map s.place
Hashable.hash places
instance : Hashable State := ⟨State.hash⟩
以上の準備の下で、計算を実行することができます。やってみるとパスが見つかるので、全員が川を渡ることは可能であることがわかります。
open Std
/-
info:
[]__[]🚢[🚹0, 🚹1, 🚹2, 🚺0, 🚺1, 🚺2]
[]__[🚺0]🚢[🚹0, 🚹1, 🚹2, 🚺1, 🚺2]
[]__[🚹0, 🚺0]🚢[🚹1, 🚹2, 🚺1, 🚺2]
[]🚢[🚹0, 🚺0]__[🚹1, 🚹2, 🚺1, 🚺2]
[🚹0]🚢[🚺0]__[🚹1, 🚹2, 🚺1, 🚺2]
[🚹0]__[🚺0]🚢[🚹1, 🚹2, 🚺1, 🚺2]
[🚹0]__[🚺0, 🚺1]🚢[🚹1, 🚹2, 🚺2]
[🚹0]🚢[🚺0, 🚺1]__[🚹1, 🚹2, 🚺2]
[🚹0, 🚺0]🚢[🚺1]__[🚹1, 🚹2, 🚺2]
[🚹0, 🚺0]__[🚺1]🚢[🚹1, 🚹2, 🚺2]
[🚹0, 🚺0]__[🚹1, 🚺1]🚢[🚹2, 🚺2]
[🚹0, 🚺0]🚢[🚹1, 🚺1]__[🚹2, 🚺2]
[🚹0, 🚹1, 🚺0]🚢[🚺1]__[🚹2, 🚺2]
[🚹0, 🚹1, 🚺0]__[🚺1]🚢[🚹2, 🚺2]
[🚹0, 🚹1, 🚺0]__[🚺1, 🚺2]🚢[🚹2]
[🚹0, 🚹1, 🚺0]🚢[🚺1, 🚺2]__[🚹2]
[🚹0, 🚹1, 🚺0, 🚺1]🚢[🚺2]__[🚹2]
[🚹0, 🚹1, 🚺0, 🚺1]__[🚺2]🚢[🚹2]
[🚹0, 🚹1, 🚺0, 🚺1]__[🚹2, 🚺2]🚢[]
[🚹0, 🚹1, 🚺0, 🚺1]🚢[🚹2, 🚺2]__[]
[🚹0, 🚹1, 🚹2, 🚺0, 🚺1]🚢[🚺2]__[]
[🚹0, 🚹1, 🚹2, 🚺0, 🚺1, 🚺2]🚢[]__[]
-/
#eval show IO Unit from do
let path := Graph.findShortestPath initial final
for p in path do
IO.println p
選択ソート
実装
以下の疑似コードで表される、選択ソートというソートアルゴリズムがあります。（選択ソートと呼ばれるアルゴリズムにはバリエーションがあり、ここに挙げたものとは異なるものもあります）
- 1 番目の要素から最後尾の要素までで最も値の小さいものを探し、それを取り除いて 1 番目に置く
- 以降同様に、未ソート部分の最小要素を見つけだし、未ソート部分の先頭へ移す
- 未ソート部分が空になったら終了
これを Lean で実装すると、次のようになります。
-- ソートなので大小比較が必要
variable [LE α] [DecidableLE α]
-- リストから最小値を取り除くためには、要素が等しいかどうか判定できる必要がある
variable [DecidableEq α]
-- `List.min` で取得した最小値が実際に最小値であることを保証するのに必要
variable [Std.IsLinearPreorder α]
/-- `LE` インスタンスから `Min` インスタンスを作る -/
instance : Min α := minOfLe
grind_pattern List.le_min_iff => x ≤ _, l.min
namespace List
/-- リストの最小値を先頭に持ってくる -/
@[grind]
def minFirst (xs : List α) : List α :=
match h : xs with
| [] => []
| x :: xs =>
let μ := List.min (x :: xs) (h := by simp)
have mem : μ ∈ x :: xs := by grind
have min : ∀ y ∈ x :: xs, μ ≤ y := by grind
let rest := List.erase (x :: xs) μ
have len_eq : (μ :: rest).length = (x :: xs).length := by grind
μ :: rest
-- 簡単な動作確認
#guard minFirst [3, 1, 4, 15, 9] = [1, 3, 4, 15, 9]
@[grind =]
theorem minFirst_length (xs : List α) :
(minFirst xs).length = xs.length := by
fun_cases minFirst xs with grind
/-- 選択ソート -/
def selectionSort (xs : List α) : List α :=
let ys := minFirst xs
have : ys.length = xs.length := by grind
match hy : ys with
| [] => []
| z :: zs =>
have : zs.length < ys.length := by grind
z :: selectionSort zs
termination_by xs.length
-- 簡単な動作確認
#guard selectionSort [3, 1, 4, 15, 9] = [1, 3, 4, 9, 15]
end List
ソートであることの証明
ソートであることを証明するには、２つのことを証明する必要があります。並び替えになっていることと、昇順に並んでいることです。
並び替えであること
２つのリストが互いの順列であることは List.Perm を使って表現でき、~ という記号で表されます。
open scoped List in
example : [1, 2, 3] ~ [3, 2, 1] := by grind
証明は、grind と fun_induction ですぐに終わります。
namespace List
/-- `minFirst` は元のリストの要素を並び替えるだけ -/
theorem minFirst_perm (xs : List α) :
minFirst xs ~ xs := by
fun_cases minFirst xs with grind
grind_pattern minFirst_perm => minFirst xs, minFirst _ ~ _
/-- `selectionSort` は元のリストの要素を並び替えるだけ -/
theorem selectionSort_perm (xs : List α) :
selectionSort xs ~ xs := by
fun_induction selectionSort xs with grind
grind_pattern selectionSort_perm => selectionSort xs
end List
昇順に並んでいること
昇順に並んでいることは、List.Pairwise を使って表現できます。これも、証明は grind と fun_induction ですぐに終わります。
namespace List
@[grind ->]
theorem minFirst_spec (x : α) (xs ys : List α) (h : x :: xs = minFirst ys) :
∀ y ∈ xs, x ≤ y := by
fun_cases minFirst ys with grind
theorem selectionSort_sorted (xs : List α) :
(selectionSort xs).Pairwise (· ≤ ·) := by
fun_induction selectionSort xs with grind [List.Pairwise]
end List
天使と悪魔の論理パズル
次の古典的な論理パズルを Lean で解いてみましょう。
目の前に2本の道がある。 片方は天国へ、片方は地獄へ続く。
そこに2人の番人がいて、一方は天使で、もう一方は悪魔である。 天使は常に真実を言い、悪魔は必ず嘘をつく。 どちらが天使で、どちらが悪魔なのかは分からない。
どちらか一人に一つだけ YES / NO で答えられる質問をすることが許されている。 なお番人はすべてを知っており、質問に「わからない」と返答することはないものとする。
天国へ続く道を特定するには、どのような質問をすればよいだろうか？
問題文の状況を Lean で表現する
Lean でプログラムを書くとき往々にしてそうであるように、まずは適切なデータ型を定義するところから始めましょう。２人の番人がいて、２つの道があるという状況は次のように書けます。
/-- 番人 -/
inductive Guardian where
/-- 左の番人 -/
| left
/-- 右の番人 -/
| right
deriving BEq, Repr
/-- 道 -/
inductive Road where
/-- 左の道 -/
| left
/-- 右の道 -/
| right
deriving BEq, Repr
問題のゴールを表現するのには、これに比べると少し自由度があります。「どのような質問をすればよいか？」という問いなので、意味のある質問文をすべて含むような型 Question を定義して、その中にある適切な質問文 q : Question を探索して見つけるという風に解釈しましょう。
そこで、「この問題の問題設定において、意味のある質問とはどのようなものか」を考える必要があります。まず確定で言えることとして、以下のような質問は可能であるべきでしょう。
- 左の人は悪魔ですか？と訊く
- あなたは天使なのかと訊く
- 左の道は天国へ続く道なのかと訊く
ここで注意が必要なのは、「あなた」という言葉は、質問に答える相手によって指す番人が変わるという点です。そこで、番人を指す表現として「左の番人」「右の番人」のほかに、「あなた」「あなたではない方」を扱えるようにします。
また、p, q : Question が意味のある質問であるならば、「p または q ですか？」といった質問も意味を持つはずですね。そう考えると、質問全体の型 Question を、次のように定義できそうです。
/-- 質問文の中で番人を指す表現 -/
inductive GuardianRef where
/-- 左の番人 -/
| left
/-- 右の番人 -/
| right
/-- 質問に答える番人自身 -/
| you
/-- 質問に答える番人ではない方 -/
| other
deriving BEq, Repr
/-- 反対側の番人 -/
def Guardian.other (g : Guardian) : Guardian :=
match g with
| .left => .right
| .right => .left
inductive Question where
/-- `gr` は天使ですか？という質問 -/
| angel (gr : GuardianRef)
/-- `r` は天国へ続きますか？という質問 -/
| toHeaven (r : Road)
/-- `q` を否定した質問。
「左の人は悪魔ですか？」とか、「左の道は地獄へ続きますか？」という質問ができる -/
| not (q : Question)
/-- `q` または `p` ですかという質問 -/
| or (q p : Question)
/-- `q` かつ `p` ですかという質問 -/
| and (q p : Question)
/-- `q` と `p` は同値ですかという質問 -/
| iff (q p : Question)
deriving BEq, Repr
このようにして探索する対象の質問全体 Question が定義できたので、次は求める質問が満たすべき条件を定式化します。
問題文では「天国へ続く道を特定するにはどうすればいいか」という表現になっていますが、２人の番人のどちらが天使でどちらが悪魔なのかわからないのですから、「相手が天使であろうと悪魔であるかに関係なく、道の行く先だけを反映して答えが返ってくるような質問」であるというのが満たすべき条件だといえます。それをきちんと定式化すればよさそうです。
/-- 状態 -/
structure State where
/-- 左の人と右の人、どちらが天使なのか。残り片方が悪魔 -/
angel : Guardian
/-- 左の道と右の道、どちらが天国へ続く道なのか。残り片方が地獄行き。 -/
toHeaven : Road
/-- 質問に答える番人が決まったときに、番人を指す表現を具体的な番人に解釈する -/
def GuardianRef.eval (respond : Guardian) (gr : GuardianRef) : Guardian :=
match gr with
| .left => .left
| .right => .right
| .you => respond
| .other => respond.other
/-- `s` という状況下で、`respond` に向けた `q : Question` という質問に対する真偽。
回答ではないので、嘘は入らない -/
def truth (s : State) (respond : Guardian) (q : Question) : Bool :=
match q with
| .angel gr => s.angel == gr.eval respond
| .toHeaven r => s.toHeaven == r
| .not q => !truth s respond q
| .or q p => truth s respond q || truth s respond p
| .and q p => truth s respond q && truth s respond p
| .iff q p => truth s respond q == truth s respond p
/-- `s` という状況下で、`g : Guardian` に対して `q : Question` という質問をした時の答え。
YES か NO で返答が返ってくるが、`true` が YES に対応する。 -/
def answer (s : State) (respond : Guardian) (q : Question) : Bool :=
if s.angel == respond then
truth s respond q
else
!truth s respond q
定義がきちんとできたかどうか確かめるために少しテストをしてみます。
/-- 左の人が天使で左の道が天国行き -/
def exampleState : State := { angel := .left, toHeaven := .left }
-- 右の人（悪魔）に向かって、あなたは天使ですか？と訊いた時の返事は YES
#guard answer exampleState .right (.angel .you)
-- 左の人（天使）に向かって、あなたは天使ですか？と訊いたときの返事は YES
#guard answer exampleState .left (.angel .you)
-- 右の人（悪魔）に向かって、あなたは悪魔ですか？と訊いた時の返事は NO
#guard answer exampleState .right (.not (.angel .you)) == false
最後に、求めるべき質問の条件を定式化します。それは、相手が悪魔だろうと天使だろうと、どんな状況でも道の行く先だけに依存して返事が変わるような質問であることです。List の Monad インスタンスを用意すると楽に書けるのでここではそうします。
/-- 番人をすべて並べたリスト -/
def allGuardians : List Guardian := [.left, .right]
/-- 状態をすべて並べたリスト -/
def allStates : List State := [
{ angel := .left, toHeaven := .left },
{ angel := .left, toHeaven := .right },
{ angel := .right, toHeaven := .left },
{ angel := .right, toHeaven := .right }
]
-- `List` をモナドのインスタンスにする
instance : Monad List where
pure x := [x]
bind l f := l.flatMap f
map f l := l.map f
/-- 良い質問かどうかを判定する -/
def Question.good (q : Question) : Bool :=
let results : List Bool := do
let respond ← allGuardians
let s ← allStates
return answer s respond q == (s.toHeaven == .left)
results.foldl (· && ·) true
探索
これで「求めるべき質問」を定義することができました。あとはそのような質問を探索して見つけるだけです。
探索する対象は、質問全体の空間 Question なわけですが、この型には無限に多くの項があるので、全部探索するわけにはいきません。複雑さを測る尺度を用意して、ある程度簡単なものに限って探索することにしましょう。例えば、質問 q : Question の構造の深さを次のように定義すれば、深さが一定以下の質問は有限個になるので全探索できるようになります。
/-- 質問の深さ -/
def Question.depth (q : Question) : Nat :=
match q with
| .angel _ => 0
| .toHeaven _ => 0
| .not q => q.depth + 1
| .or q p => max q.depth p.depth + 1
| .and q p => max q.depth p.depth + 1
| .iff q p => max q.depth p.depth + 1
まず深さが小さいものから調べましょう。深さゼロの原子的な質問は有限個です。番人を指す表現が4個、道が2本なので、ここから作れる原子的質問は全部で6個しかありません。
/-- 原子的な質問をすべて並べたリスト -/
def atomicQuestions : List Question := [
.angel .left,
.angel .right,
.angel .you,
.angel .other,
.toHeaven .left,
.toHeaven .right
]
-- この中に良い質問はない
#guard atomicQuestions.filter Question.good == []
深さゼロの質問の中に良い質問はありませんでした。次は深さ１の質問を調べてみましょう。深さ１の質問は、原始的な質問に二項演算を適用したものからなっていて、全部で 6 + 6 * 6 * 3 = 114 個しかありません。これも全探索できます。
/-- 深さ１の質問文全体 -/
def depth1Questions : List Question :=
let ofNot : List Question := atomicQuestions.map Question.not
let ofBinary : List Question := do
let q1 ← atomicQuestions
let q2 ← atomicQuestions
let op ← [Question.or, Question.and, Question.iff]
return op q1 q2
ofBinary ++ ofNot
-- 114 個しかない
#guard depth1Questions.length == 114
すると早くもこの中から解が見つかります。複数の解が出ますが、対称性によって複数出ているだけであり、本質的には「あなたは天使である」と「左の道は天国へ続く」は同値ですか？という質問のバリエーションであるようです。
/-
info:
[Question.iff (Question.angel (GuardianRef.you)) (Question.toHeaven (Road.left)),
Question.iff (Question.angel (GuardianRef.other)) (Question.toHeaven (Road.right)),
Question.iff (Question.toHeaven (Road.left)) (Question.angel (GuardianRef.you)),
Question.iff (Question.toHeaven (Road.right)) (Question.angel (GuardianRef.other))]
-/
#eval depth1Questions.filter Question.good
質問している相手が天使だろうと悪魔だろうと、左の道が天国行きであれば YES、左の道が地獄行きであれば NO という返事が返ってきます。これでこのパズルは解けました。
末尾再帰
末尾再帰(tail recursion) とは、再帰呼び出しの結果を加工せずそのまま返り値として返すような再帰のことを指します。そのような再帰関数のことを、末尾再帰的(tail recursive) であると言ったりします。
たとえば以下のリストの和を計算する関数は、末尾再帰的ではありません。再帰呼び出しの結果である sum xs をそのまま返すのではなく、(x + ·) で加工してから返しているからです。
variable {α : Type} [Add α] [Zero α]
/-- 末尾再帰的ではない関数の例 -/
def sum (l : List α) : α :=
match l with
| [] => 0
| x :: xs => x + sum xs
#guard sum [1, 2, 3] = 6
逆に、以下の関数は末尾再帰的です。再帰呼び出し sum xs (acc + x) の結果をそのまま返しているからです。再帰呼び出しの前に、acc + x という計算はしていますが、これは引数に入っているだけなので関係ありません。
variable {α : Type} [Add α] [Zero α]
/-- 末尾再帰的な関数の例 -/
def sumAux (l : List α) (acc : α) : α :=
match l with
| [] => acc
| x :: xs => sumAux xs (acc + x)
def sum (l : List α) : α :=
sumAux l 0
#guard sum [1, 2, 3] = 6
末尾再帰とコンパイル時最適化
末尾再帰という概念が重要なものとされている主な理由は、末尾再帰的な関数はコンパイル時に最適化してループに変換することができるという事実にあります。
スタックオーバーフロー
まず前提として、再帰関数の計算はメモリ効率が悪く スタックオーバーフロー というエラーを引き起こす可能性が高いということを理解しておく必要があります。たとえば、以下のような関数を考えてみましょう。
/-- 階乗関数 -/
def factorial (n : Nat) : Nat :=
match n with
| 0 => 1
| n + 1 => (n + 1) * factorial n
このとき、factorial 5 の計算の過程を丁寧に書くとこうなります。
example : factorial 5 = 120 := calc
_ = 5 * factorial 4 := by rfl
_ = 5 * (4 * factorial 3) := by rfl
_ = 5 * (4 * (3 * factorial 2)) := by rfl
_ = 5 * (4 * (3 * (2 * factorial 1))) := by rfl
_ = 5 * (4 * (3 * (2 * (1 * factorial 0)))) := by rfl
_ = 5 * (4 * (3 * (2 * (1 * 1)))) := by rfl
_ = 120 := by rfl
ここで重要なのは、最後の factorial 0 の結果が返ってくるまで、外側の (5 * ·) や (3 * ·) などの計算がすべて待たされるということです。この待機中の情報はコールスタックという場所に保存されるのですが、容量には限りがあるので大きな入力を計算しようとすると溢れてエラーになります。これがスタックオーバーフローです。
再帰ではなくてループで実装した場合は、入力が大きくなってもコールスタックを食いつぶすことはないので、このことを根拠に「再帰よりループの方がメモリ効率が良い」と言われることがあります。
/-- ループで実装した階乗関数 -/
def factorialLoop (n : Nat) : Nat := Id.run do
let mut acc := 1
for i in [1:n+1] do
acc := acc * i
return acc
#guard factorialLoop 5 = 120
末尾呼び出し最適化
関数が末尾再帰的であった場合、少し様相が異なります。先ほどの階乗関数の例を使って、どのように変わるのかを見てみましょう。まず、階乗関数を末尾再帰を使って書き換えます。
def factorialAux (n acc : Nat) : Nat :=
match n with
| 0 => acc
| n + 1 => factorialAux n ((n + 1) * acc)
/-- 末尾再帰的な補助関数を使って書き換えた階乗関数 -/
def factorialTR (n : Nat) : Nat :=
factorialAux n 1
そうすると、factorialTR 5 の計算の過程は以下のようになります。
example : factorialTR 5 = 120 := calc
_ = factorialAux 5 1 := by rfl
_ = factorialAux 4 (5 * 1) := by rfl
_ = factorialAux 3 (4 * (5 * 1)) := by rfl
_ = factorialAux 2 (3 * (4 * (5 * 1))) := by rfl
_ = factorialAux 1 (2 * (3 * (4 * (5 * 1)))) := by rfl
_ = factorialAux 0 (1 * (2 * (3 * (4 * (5 * 1))))) := by rfl
_ = (1 * (2 * (3 * (4 * (5 * 1))))) := by rfl
_ = 120 := by rfl
よく見ると、引数の計算だけになっていて、再帰呼び出しの結果を待つ必要がなくなっています。したがって、コンパイル時にループに変換することができます。これが 末尾呼び出し最適化(tail call optimization) です。
末尾呼び出し最適化による高速化
Lean のコンパイラは末尾呼び出し最適化を行うため、実際に末尾再帰的な関数に書き換えることによって関数を省メモリかつ高速にすることができます。より顕著な差が出るように、ここではフィボナッチ数列を計算する関数を例にしましょう。（一度の再帰で２つの再帰呼び出しを計算するため、大きな差が出ます）
/-- n 番目のフィボナッチ数を計算する関数 -/
def fib (n : Nat) : Nat :=
match n with
| 0 => 0
| 1 => 1
| n + 2 => fib (n + 1) + fib n
#guard fib 7 = 13
def fibAux (n a b : Nat) : Nat :=
match n with
| 0 => a
| n + 1 => fibAux n b (a + b)
/-- 末尾再帰的に書き直した fib 関数 -/
def fibTR (n : Nat) : Nat := fibAux n 0 1
#guard fibTR 7 = 13
-- 計算に１秒以上かかる
#eval fib 32
-- 計算がすぐ終わる
#eval fibTR 32
「末尾再帰の形にすると高速になるのは分かったが、複雑になるから証明に使うときは嫌だなあ」という感想を持たれたでしょうか？実は Lean では「証明では実装 A を使用し、実行時は効率的な別の実装 B を使用する」ということができます。詳しくは [csimp] のページを参照してください。
末尾再帰と部分関数
末尾再帰性は、partial_fixpoint で修飾できる関数の条件にも現れます。
詳しくは partial_fixpoint のページを参照してください。
関数を末尾再帰化するテクニック
再帰関数を末尾再帰的な形に書き換えるために、さまざまなテクニックが知られています。
蓄積変数を導入する
再帰呼び出しの結果を加工する代わりに、引数を増やしてその中で計算を行うというテクニックです。このとき増やす引数のことを 蓄積変数(accumulator) と呼びます。
/-- リストを逆順にする関数の、末尾再帰的でない実装 -/
@[grind =]
def reverse (l : List α) : List α :=
match l with
| [] => []
| x :: xs => reverse xs ++ [x]
@[grind =]
def reverseAux (l : List α) (acc : List α) : List α :=
match l with
| [] => acc
| x :: xs => reverseAux xs (x :: acc)
/-- リストを逆順にする関数の、末尾再帰的な実装 -/
@[grind =]
def reverseTR (l : List α) : List α := reverseAux l []
@[simp, grind =]
theorem reverseAux_lem (l : List α) (acc : List α)
: reverseAux l acc = reverse l ++ acc := by
induction l generalizing acc with grind
/-- `reverse` と `reverseTR` は等しい -/
theorem reverse_eq_reverseTR (l : List α) : reverse l = reverseTR l := by
induction l with grind
foldl / foldr を使う
再帰パターンを抽出した高階関数として List.foldl と List.foldr がありますが、この２つは「List.foldl の方は末尾再帰的で、List.foldr の方はそうではない」という違いがあります。
しかし、Lean の標準ライブラリにおいて List.foldr は末尾再帰的な実装と [csimp] 属性を利用して置換されています。
したがって foldr 的な再帰構造を持つ関数を List.foldr を使って書き直すだけで、実行時に末尾呼び出し最適化の恩恵を受けることができます。
variable [Add α] [Zero α]
/-- 合計を求める関数 -/
def sum (l : List α) : α :=
match l with
| [] => 0
| x :: xs => x + sum xs
/-- 合計を求める関数を `foldr` で書き直したもの -/
def sumFoldr (l : List α) : α :=
List.foldr (· + ·) 0 l
theorem sum_eq_sumFoldr (l : List α) : sum l = sumFoldr l := by
delta sumFoldr sum List.foldr
rfl
継続渡しスタイルにする
「値を受け取った後に残りの計算をどう続けるか」を表す関数のことを 継続(continuation) と呼びます。 「再帰呼び出しの結果を受け取った後に何をするか」を継続として明示的に渡すという方法です。継続渡しスタイル(continuation-passing style) と呼ばれます。
def map (f : α → β) (l : List α) : List β :=
match l with
| [] => []
| x :: xs => f x :: map f xs
/-- 継続渡しスタイルに書き直すための補助関数 -/
def mapCPSAux (f : α → β) (l : List α) (k : List β → List β) : List β :=
match l with
| [] => k []
| x :: xs =>
mapCPSAux f xs (fun ys => k (f x :: ys))
/-- 継続渡しスタイルに書き直した map 関数 -/
def mapCPS (f : α → β) (l : List α) : List β :=
mapCPSAux f l id
theorem mapCPSAux_lem (f : α → β) (l : List α) (k : List β → List β)
: mapCPSAux f l k = k (map f l) := by
induction l generalizing k with
| nil => rfl
| cons x xs ih => solve_by_elim
/-- `map` と `mapCPS` は等しい -/
theorem map_eq_mapCPS (f : α → β) (l : List α) : map f l = mapCPS f l := by
delta mapCPS
simp [mapCPSAux_lem]
列挙型に対する ToString インスタンスの自動生成
やりたいことの説明
帰納型であって、すべてのコンストラクタが一切引数を持たないものを、列挙型(enumeration type) と呼びます。 たとえば、以下に示すのは列挙型になっている例です。
/-- 色 -/
inductive Color where
| red
| green
| blue
おおまかに、「有限個の候補からどれか一つを選ぶ」という情報だけを持っているのが列挙型であると言えます。
さて、列挙型に対して ToString インスタンスを定義する場合、各コンストラクタに対応する文字列を返したい場合が多いでしょう。
上記の例であれば、次のように定義するわけです。
protected def Color.toString (c : Color) : String :=
match c with
| .red => "red"
| .green => "green"
| .blue => "blue"
instance : ToString Color where
toString := Color.toString
これは決まりきったルーチンワークなので、「自動化したい」という欲求が湧いてきます。 自動化するにはどうすればいいでしょうか？
列挙型であるか判定する
方針としては、列挙型に対してだけ動作する、ToString の deriving handler を定義したいです。
deriving instance ToString for Color のように書いたら、Color の ToString インスタンスが自動生成されるようにしたいわけです。
現状では実装していないので、当然失敗します。
これが成功するようにしましょう。
/- error: No deriving handlers have been implemented for class `ToString` -/
deriving instance ToString for Color
deriving handler が内部で何をするかというと、実は手動で定義するときと同じことを自動でやっているだけです。 以下がおおまかな流れです。
- まず列挙型かどうか判定して、列挙型でなければ即終了
- 列挙型だったら
instanceコマンドを生成する - 生成したコマンドを実行して、インスタンスを作る
したがってまずやるべきことは、列挙型かどうか判定することです。
これには専用の関数が用意されており、Lean.isEnumType という関数で判定することができます。
import Lean
open Lean Meta
-- Bool は列挙型
run_meta
let actual ← isEnumType ``Bool
assert! actual
-- Nat は列挙型ではない
run_meta
let actual ← isEnumType ``Nat
assert! !actual
instance コマンドを自動生成する
次の目標は、列挙型に対して instance コマンドを自動生成することです。
以下のように実装することができます。
import Lean
open Lean Elab Command
open Parser.Term
/-- 与えられた 列挙型を表す `declName : Name` に対して、
`ToString` のインスタンスを与える `instance` コマンドを自動生成する -/
def mkToStringInstForEnum (declName : Name) : TermElabM Command := do
if !(← isEnumType declName) then
throwError "{declName} は列挙型ではありません"
let indVal ← getConstInfoInduct declName
let mut alts : Array (TSyntax ``matchAlt) := #[]
for ctorName in indVal.ctors do
let ctorInfo ← getConstInfoCtor ctorName
let ctorStr := ctorInfo.name.getString!
let alt ← `(matchAltExpr| | $(mkIdent ctorName):ident => $(quote ctorStr))
alts := alts.push alt
let typeIdent := mkIdent declName
let ToStringIdent := mkIdent `ToString
`(command|
instance : $ToStringIdent:ident $typeIdent:ident := ⟨
fun x => match x with
$alts:matchAlt*⟩)
いま定義した、instance コマンドを生成する関数を具体的な列挙型に対して実行して、得られたコマンドを確認してみましょう。
実際に、好ましい instance コマンドが生成されていることが確認できます。
inductive Direction where
| north
| south
| east
| west
/-
info: instance : ToString Direction :=
⟨fun x✝ =>
match x✝ with
| Direction.north => "north"
| Direction.south => "south"
| Direction.east => "east"
| Direction.west => "west"⟩
-/
run_cmd
let cmd ← liftTermElabM <| mkToStringInstForEnum `Direction
let fmt ← liftCoreM <| PrettyPrinter.ppCommand cmd
logInfo <| MessageData.ofFormat fmt
得られたコマンドを elabCommand 関数で実行してやることで、Direction に対する ToString インスタンスが自動生成できることも確認できます。
-- 実際にコマンドを実行して、`ToString` インスタンスを生成する
run_cmd
let cmd ← liftTermElabM <| mkToStringInstForEnum `Direction
elabCommand cmd
#guard toString Direction.north = "north"
#guard toString Direction.south = "south"
deriving handler を宣言する
ここまで終わったら、後は deriving handler を宣言するだけです。
initialize コマンドで登録することができます。
open Lean Elab Command
private def mkToStringInstForEnumHandler (declNames : Array Name) : CommandElabM Bool := do
if declNames.isEmpty then
throwError "型が指定されていません"
for declName in declNames do
let cmd ← liftTermElabM <| mkToStringInstForEnum declName
elabCommand cmd
return true
initialize
registerDerivingHandler ``ToString mkToStringInstForEnumHandler
これで、晴れて deriving ToString が列挙型に対して使えるようになりました。
initialize コマンドの効果はモジュール（ファイルのこと）を跨がないと発生しないのですが、ファイルを跨げばこういう感じで書けるようになっているはずです。
inductive Hoge where
| a
| b
| c
deriving ToString
#guard toString Hoge.a = "a"
#guard toString Hoge.c = "c"