author | blanchet |
Fri, 19 Mar 2010 16:04:15 +0100 | |
changeset 35868 | 491a97039ce1 |
parent 35867 | 16279c4c7a33 |
child 35969 | c9565298df9e |
permissions | -rw-r--r-- |
32327
0971cc0b6a57
src/HOL/Tools/ATP_Manager as separate component, with (almost) everything in one place;
wenzelm
parents:
32091
diff
changeset
|
1 |
(* Title: HOL/Tools/ATP_Manager/atp_minimal.ML |
31037
ac8669134e7a
added Philipp Meyer's implementation of AtpMinimal
immler@in.tum.de
parents:
diff
changeset
|
2 |
Author: Philipp Meyer, TU Muenchen |
ac8669134e7a
added Philipp Meyer's implementation of AtpMinimal
immler@in.tum.de
parents:
diff
changeset
|
3 |
|
35867 | 4 |
Minimization of theorem list for Metis using automatic theorem provers. |
31037
ac8669134e7a
added Philipp Meyer's implementation of AtpMinimal
immler@in.tum.de
parents:
diff
changeset
|
5 |
*) |
ac8669134e7a
added Philipp Meyer's implementation of AtpMinimal
immler@in.tum.de
parents:
diff
changeset
|
6 |
|
32525 | 7 |
signature ATP_MINIMAL = |
8 |
sig |
|
35867 | 9 |
type prover = ATP_Manager.prover |
10 |
type prover_result = ATP_Manager.prover_result |
|
35866
513074557e06
move the Sledgehammer Isar commands together into one file;
blanchet
parents:
35865
diff
changeset
|
11 |
type 'a minimize_fun = ('a list -> bool) -> 'a list -> 'a list |
35867 | 12 |
|
35866
513074557e06
move the Sledgehammer Isar commands together into one file;
blanchet
parents:
35865
diff
changeset
|
13 |
val linear_minimize : 'a minimize_fun |
513074557e06
move the Sledgehammer Isar commands together into one file;
blanchet
parents:
35865
diff
changeset
|
14 |
val binary_minimize : 'a minimize_fun |
513074557e06
move the Sledgehammer Isar commands together into one file;
blanchet
parents:
35865
diff
changeset
|
15 |
val minimize_theorems : |
35867 | 16 |
(string * thm list) minimize_fun -> prover -> string -> int |
35866
513074557e06
move the Sledgehammer Isar commands together into one file;
blanchet
parents:
35865
diff
changeset
|
17 |
-> Proof.state -> (string * thm list) list |
513074557e06
move the Sledgehammer Isar commands together into one file;
blanchet
parents:
35865
diff
changeset
|
18 |
-> (string * thm list) list option * string |
513074557e06
move the Sledgehammer Isar commands together into one file;
blanchet
parents:
35865
diff
changeset
|
19 |
end; |
32525 | 20 |
|
35865 | 21 |
structure ATP_Minimal : ATP_MINIMAL = |
31037
ac8669134e7a
added Philipp Meyer's implementation of AtpMinimal
immler@in.tum.de
parents:
diff
changeset
|
22 |
struct |
ac8669134e7a
added Philipp Meyer's implementation of AtpMinimal
immler@in.tum.de
parents:
diff
changeset
|
23 |
|
35866
513074557e06
move the Sledgehammer Isar commands together into one file;
blanchet
parents:
35865
diff
changeset
|
24 |
open Sledgehammer_Fact_Preprocessor |
35867 | 25 |
open ATP_Manager |
35866
513074557e06
move the Sledgehammer Isar commands together into one file;
blanchet
parents:
35865
diff
changeset
|
26 |
|
513074557e06
move the Sledgehammer Isar commands together into one file;
blanchet
parents:
35865
diff
changeset
|
27 |
type 'a minimize_fun = ('a list -> bool) -> 'a list -> 'a list |
513074557e06
move the Sledgehammer Isar commands together into one file;
blanchet
parents:
35865
diff
changeset
|
28 |
|
513074557e06
move the Sledgehammer Isar commands together into one file;
blanchet
parents:
35865
diff
changeset
|
29 |
(* Linear minimization algorithm *) |
33492
4168294a9f96
Command atp_minimize uses the naive linear algorithm now
nipkow
parents:
33316
diff
changeset
|
30 |
|
35866
513074557e06
move the Sledgehammer Isar commands together into one file;
blanchet
parents:
35865
diff
changeset
|
31 |
fun linear_minimize p s = |
513074557e06
move the Sledgehammer Isar commands together into one file;
blanchet
parents:
35865
diff
changeset
|
32 |
let |
513074557e06
move the Sledgehammer Isar commands together into one file;
blanchet
parents:
35865
diff
changeset
|
33 |
fun aux [] needed = needed |
513074557e06
move the Sledgehammer Isar commands together into one file;
blanchet
parents:
35865
diff
changeset
|
34 |
| aux (x :: xs) needed = aux xs (needed |> not (p (xs @ needed)) ? cons x) |
513074557e06
move the Sledgehammer Isar commands together into one file;
blanchet
parents:
35865
diff
changeset
|
35 |
in aux s [] end; |
33492
4168294a9f96
Command atp_minimize uses the naive linear algorithm now
nipkow
parents:
33316
diff
changeset
|
36 |
|
35866
513074557e06
move the Sledgehammer Isar commands together into one file;
blanchet
parents:
35865
diff
changeset
|
37 |
(* Binary minimalization *) |
31037
ac8669134e7a
added Philipp Meyer's implementation of AtpMinimal
immler@in.tum.de
parents:
diff
changeset
|
38 |
|
31236 | 39 |
local |
32947
3c19b98a35cd
ATP_Manager.get_prover: canonical argument order;
wenzelm
parents:
32942
diff
changeset
|
40 |
fun isplit (l, r) [] = (l, r) |
3c19b98a35cd
ATP_Manager.get_prover: canonical argument order;
wenzelm
parents:
32942
diff
changeset
|
41 |
| isplit (l, r) [h] = (h :: l, r) |
3c19b98a35cd
ATP_Manager.get_prover: canonical argument order;
wenzelm
parents:
32942
diff
changeset
|
42 |
| isplit (l, r) (h1 :: h2 :: t) = isplit (h1 :: l, h2 :: r) t |
31236 | 43 |
in |
32947
3c19b98a35cd
ATP_Manager.get_prover: canonical argument order;
wenzelm
parents:
32942
diff
changeset
|
44 |
fun split lst = isplit ([], []) lst |
31236 | 45 |
end |
31037
ac8669134e7a
added Philipp Meyer's implementation of AtpMinimal
immler@in.tum.de
parents:
diff
changeset
|
46 |
|
31236 | 47 |
local |
35866
513074557e06
move the Sledgehammer Isar commands together into one file;
blanchet
parents:
35865
diff
changeset
|
48 |
fun min _ _ [] = raise Empty |
513074557e06
move the Sledgehammer Isar commands together into one file;
blanchet
parents:
35865
diff
changeset
|
49 |
| min _ _ [s0] = [s0] |
31236 | 50 |
| min p sup s = |
31037
ac8669134e7a
added Philipp Meyer's implementation of AtpMinimal
immler@in.tum.de
parents:
diff
changeset
|
51 |
let |
31236 | 52 |
val (l0, r0) = split s |
31037
ac8669134e7a
added Philipp Meyer's implementation of AtpMinimal
immler@in.tum.de
parents:
diff
changeset
|
53 |
in |
35866
513074557e06
move the Sledgehammer Isar commands together into one file;
blanchet
parents:
35865
diff
changeset
|
54 |
if p (sup @ l0) then |
513074557e06
move the Sledgehammer Isar commands together into one file;
blanchet
parents:
35865
diff
changeset
|
55 |
min p sup l0 |
513074557e06
move the Sledgehammer Isar commands together into one file;
blanchet
parents:
35865
diff
changeset
|
56 |
else if p (sup @ r0) then |
513074557e06
move the Sledgehammer Isar commands together into one file;
blanchet
parents:
35865
diff
changeset
|
57 |
min p sup r0 |
31037
ac8669134e7a
added Philipp Meyer's implementation of AtpMinimal
immler@in.tum.de
parents:
diff
changeset
|
58 |
else |
35866
513074557e06
move the Sledgehammer Isar commands together into one file;
blanchet
parents:
35865
diff
changeset
|
59 |
let |
513074557e06
move the Sledgehammer Isar commands together into one file;
blanchet
parents:
35865
diff
changeset
|
60 |
val l = min p (sup @ r0) l0 |
513074557e06
move the Sledgehammer Isar commands together into one file;
blanchet
parents:
35865
diff
changeset
|
61 |
val r = min p (sup @ l) r0 |
513074557e06
move the Sledgehammer Isar commands together into one file;
blanchet
parents:
35865
diff
changeset
|
62 |
in l @ r end |
31037
ac8669134e7a
added Philipp Meyer's implementation of AtpMinimal
immler@in.tum.de
parents:
diff
changeset
|
63 |
end |
31236 | 64 |
in |
65 |
(* return a minimal subset v of s that satisfies p |
|
66 |
@pre p(s) & ~p([]) & monotone(p) |
|
67 |
@post v subset s & p(v) & |
|
68 |
forall e in v. ~p(v \ e) |
|
69 |
*) |
|
35866
513074557e06
move the Sledgehammer Isar commands together into one file;
blanchet
parents:
35865
diff
changeset
|
70 |
fun binary_minimize p s = |
513074557e06
move the Sledgehammer Isar commands together into one file;
blanchet
parents:
35865
diff
changeset
|
71 |
case min p [] s of |
513074557e06
move the Sledgehammer Isar commands together into one file;
blanchet
parents:
35865
diff
changeset
|
72 |
[x] => if p [] then [] else [x] |
513074557e06
move the Sledgehammer Isar commands together into one file;
blanchet
parents:
35865
diff
changeset
|
73 |
| m => m |
31236 | 74 |
end |
75 |
||
31037
ac8669134e7a
added Philipp Meyer's implementation of AtpMinimal
immler@in.tum.de
parents:
diff
changeset
|
76 |
|
31236 | 77 |
(* failure check and producing answer *) |
78 |
||
79 |
datatype 'a prove_result = Success of 'a | Failure | Timeout | Error |
|
80 |
||
81 |
val string_of_result = |
|
82 |
fn Success _ => "Success" |
|
83 |
| Failure => "Failure" |
|
84 |
| Timeout => "Timeout" |
|
85 |
| Error => "Error" |
|
86 |
||
87 |
val failure_strings = |
|
88 |
[("SPASS beiseite: Ran out of time.", Timeout), |
|
89 |
("Timeout", Timeout), |
|
90 |
("time limit exceeded", Timeout), |
|
91 |
("# Cannot determine problem status within resource limit", Timeout), |
|
92 |
("Error", Error)] |
|
93 |
||
35867 | 94 |
fun produce_answer ({success, proof, internal_thm_names, filtered_clauses, ...} |
95 |
: prover_result) = |
|
96 |
if success then |
|
97 |
(Success (Vector.foldr (op ::) [] internal_thm_names, filtered_clauses), |
|
98 |
proof) |
|
99 |
else |
|
100 |
let |
|
101 |
val failure = failure_strings |> get_first (fn (s, t) => |
|
102 |
if String.isSubstring s proof then SOME (t, proof) else NONE) |
|
103 |
in |
|
104 |
(case failure of |
|
105 |
SOME res => res |
|
106 |
| NONE => (Failure, proof)) |
|
107 |
end |
|
31236 | 108 |
|
32936 | 109 |
|
31236 | 110 |
(* wrapper for calling external prover *) |
111 |
||
35867 | 112 |
fun sledgehammer_test_theorems prover time_limit subgoalno state filtered |
113 |
name_thms_pairs = |
|
31236 | 114 |
let |
35867 | 115 |
val _ = priority ("Testing " ^ string_of_int (length name_thms_pairs) ^ |
116 |
" theorems... ") |
|
32525 | 117 |
val name_thm_pairs = maps (fn (n, ths) => map (pair n) ths) name_thms_pairs |
35866
513074557e06
move the Sledgehammer Isar commands together into one file;
blanchet
parents:
35865
diff
changeset
|
118 |
val axclauses = cnf_rules_pairs (Proof.theory_of state) name_thm_pairs |
35592
768d17f54125
use regular Proof.goal (which is what methods usually see) and prevent sledgehammer from crashing;
wenzelm
parents:
33492
diff
changeset
|
119 |
val {context = ctxt, facts, goal} = Proof.goal state |
32941
72d48e333b77
eliminated extraneous wrapping of public records;
wenzelm
parents:
32937
diff
changeset
|
120 |
val problem = |
72d48e333b77
eliminated extraneous wrapping of public records;
wenzelm
parents:
32937
diff
changeset
|
121 |
{with_full_types = ! ATP_Manager.full_types, |
32864
a226f29d4bdc
re-organized signature of AtpWrapper structure: records instead of unnamed parameters and return values,
boehmes
parents:
32740
diff
changeset
|
122 |
subgoal = subgoalno, |
33292 | 123 |
goal = (ctxt, (facts, goal)), |
32864
a226f29d4bdc
re-organized signature of AtpWrapper structure: records instead of unnamed parameters and return values,
boehmes
parents:
32740
diff
changeset
|
124 |
axiom_clauses = SOME axclauses, |
32941
72d48e333b77
eliminated extraneous wrapping of public records;
wenzelm
parents:
32937
diff
changeset
|
125 |
filtered_clauses = filtered} |
32948 | 126 |
val (result, proof) = produce_answer (prover time_limit problem) |
32947
3c19b98a35cd
ATP_Manager.get_prover: canonical argument order;
wenzelm
parents:
32942
diff
changeset
|
127 |
val _ = priority (string_of_result result) |
35867 | 128 |
in (result, proof) end |
31236 | 129 |
|
130 |
||
131 |
(* minimalization of thms *) |
|
132 |
||
35866
513074557e06
move the Sledgehammer Isar commands together into one file;
blanchet
parents:
35865
diff
changeset
|
133 |
fun minimize_theorems gen_min prover prover_name time_limit state |
513074557e06
move the Sledgehammer Isar commands together into one file;
blanchet
parents:
35865
diff
changeset
|
134 |
name_thms_pairs = |
31236 | 135 |
let |
136 |
val _ = |
|
32947
3c19b98a35cd
ATP_Manager.get_prover: canonical argument order;
wenzelm
parents:
32942
diff
changeset
|
137 |
priority ("Minimize called with " ^ string_of_int (length name_thms_pairs) ^ |
3c19b98a35cd
ATP_Manager.get_prover: canonical argument order;
wenzelm
parents:
32942
diff
changeset
|
138 |
" theorems, prover: " ^ prover_name ^ |
3c19b98a35cd
ATP_Manager.get_prover: canonical argument order;
wenzelm
parents:
32942
diff
changeset
|
139 |
", time limit: " ^ string_of_int time_limit ^ " seconds") |
35867 | 140 |
val test_thms_fun = sledgehammer_test_theorems prover time_limit 1 state |
31752
19a5f1c8a844
use results of relevance-filter to determine additional clauses;
immler@in.tum.de
parents:
31409
diff
changeset
|
141 |
fun test_thms filtered thms = |
19a5f1c8a844
use results of relevance-filter to determine additional clauses;
immler@in.tum.de
parents:
31409
diff
changeset
|
142 |
case test_thms_fun filtered thms of (Success _, _) => true | _ => false |
31236 | 143 |
in |
144 |
(* try prove first to check result and get used theorems *) |
|
31409
d8537ba165b5
split preparing clauses and writing problemfile;
immler@in.tum.de
parents:
31236
diff
changeset
|
145 |
(case test_thms_fun NONE name_thms_pairs of |
31752
19a5f1c8a844
use results of relevance-filter to determine additional clauses;
immler@in.tum.de
parents:
31409
diff
changeset
|
146 |
(Success (used, filtered), _) => |
31236 | 147 |
let |
32947
3c19b98a35cd
ATP_Manager.get_prover: canonical argument order;
wenzelm
parents:
32942
diff
changeset
|
148 |
val ordered_used = sort_distinct string_ord used |
31236 | 149 |
val to_use = |
150 |
if length ordered_used < length name_thms_pairs then |
|
151 |
filter (fn (name1, _) => List.exists (equal name1) ordered_used) name_thms_pairs |
|
33305 | 152 |
else name_thms_pairs |
35866
513074557e06
move the Sledgehammer Isar commands together into one file;
blanchet
parents:
35865
diff
changeset
|
153 |
val min_thms = |
513074557e06
move the Sledgehammer Isar commands together into one file;
blanchet
parents:
35865
diff
changeset
|
154 |
if null to_use then [] |
33492
4168294a9f96
Command atp_minimize uses the naive linear algorithm now
nipkow
parents:
33316
diff
changeset
|
155 |
else gen_min (test_thms (SOME filtered)) to_use |
32947
3c19b98a35cd
ATP_Manager.get_prover: canonical argument order;
wenzelm
parents:
32942
diff
changeset
|
156 |
val min_names = sort_distinct string_ord (map fst min_thms) |
3c19b98a35cd
ATP_Manager.get_prover: canonical argument order;
wenzelm
parents:
32942
diff
changeset
|
157 |
val _ = priority (cat_lines |
35866
513074557e06
move the Sledgehammer Isar commands together into one file;
blanchet
parents:
35865
diff
changeset
|
158 |
["Minimal " ^ string_of_int (length min_thms) ^ " theorems"]) |
31236 | 159 |
in |
35866
513074557e06
move the Sledgehammer Isar commands together into one file;
blanchet
parents:
35865
diff
changeset
|
160 |
(SOME min_thms, "Try this command: " ^ |
31236 | 161 |
Markup.markup Markup.sendback ("apply (metis " ^ space_implode " " min_names ^ ")")) |
162 |
end |
|
163 |
| (Timeout, _) => |
|
32947
3c19b98a35cd
ATP_Manager.get_prover: canonical argument order;
wenzelm
parents:
32942
diff
changeset
|
164 |
(NONE, "Timeout: You may need to increase the time limit of " ^ |
3c19b98a35cd
ATP_Manager.get_prover: canonical argument order;
wenzelm
parents:
32942
diff
changeset
|
165 |
string_of_int time_limit ^ " seconds. Call atp_minimize [time=...] ") |
31236 | 166 |
| (Error, msg) => |
32947
3c19b98a35cd
ATP_Manager.get_prover: canonical argument order;
wenzelm
parents:
32942
diff
changeset
|
167 |
(NONE, "Error in prover: " ^ msg) |
31236 | 168 |
| (Failure, _) => |
32947
3c19b98a35cd
ATP_Manager.get_prover: canonical argument order;
wenzelm
parents:
32942
diff
changeset
|
169 |
(NONE, "Failure: No proof with the theorems supplied")) |
35865 | 170 |
handle Sledgehammer_HOL_Clause.TRIVIAL => |
35866
513074557e06
move the Sledgehammer Isar commands together into one file;
blanchet
parents:
35865
diff
changeset
|
171 |
(SOME [], "Trivial: Try this command: " ^ Markup.markup Markup.sendback "apply metis") |
32947
3c19b98a35cd
ATP_Manager.get_prover: canonical argument order;
wenzelm
parents:
32942
diff
changeset
|
172 |
| ERROR msg => (NONE, "Error: " ^ msg) |
31236 | 173 |
end |
174 |
||
35866
513074557e06
move the Sledgehammer Isar commands together into one file;
blanchet
parents:
35865
diff
changeset
|
175 |
end; |