test/Tools/isac/Minisubpbl/150-add-given.sml
author Walther Neuper <wneuper@ist.tugraz.at>
Thu, 22 Dec 2016 11:36:20 +0100
changeset 59279 255c853ea2f0
parent 52070 77138c64f4f6
child 59426 c7b52bf9c8ae
permissions -rw-r--r--
renamed Ctree.ptree --> Ctree.ctree
neuper@41986
     1
(* Title:  150-add-given.sml
neuper@41986
     2
   Author: Walther Neuper 1105
neuper@41986
     3
   (c) copyright due to lincense terms.
neuper@41986
     4
*)
neuper@41986
     5
neuper@41986
     6
val fmz = ["equality (x+1=(2::real))", "solveFor x","solutions L"];
neuper@41986
     7
val (dI',pI',mI') =
neuper@41986
     8
  ("Test", ["sqroot-test","univariate","equation","test"],
neuper@41986
     9
   ["Test","squ-equ-test-subpbl1"]);
neuper@41986
    10
val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))]; (*nxt = ("Model_Problem"*)
neuper@52070
    11
(*for resuming after stepping into code*)
neuper@52070
    12
val (p''',f''',nxt''',pt''') = (p,f,nxt,pt);
neuper@52070
    13
wneuper@59279
    14
"~~~~~ fun me, args:"; val (((_,tac):tac'_), (p:pos'), (_:NEW), (pt:ctree)) = (nxt, p, [], pt);
neuper@52070
    15
    val (pt, p) = 
neuper@52070
    16
	    case locatetac tac (pt,p) of
neuper@52070
    17
		    ("ok", (_, _, ptp)) => ptp;
neuper@52070
    18
(*  val (_, ts) =
neuper@52070
    19
	    (case step p ((pt, e_pos'),[]) of
neuper@52070
    20
		    ("ok", (ts as (tac,_,_)::_, _, _)) => ("",ts))
neuper@52070
    21
ERROR: ts = [(Tac "appl_add: syntax error in 'equality (<markup> + <markup> = <markup>)'", ...*)
neuper@52070
    22
"~~~~~ fun step, args:"; val (((ip as (_,p_)):pos'), ((ptp as (pt,p), tacis):calcstate)) =
neuper@52070
    23
  (p, ((pt, e_pos'),[]));
neuper@52070
    24
 val pIopt = get_pblID (pt,ip);
neuper@52070
    25
ip = ([],Res); (* = false*)
neuper@52070
    26
tacis; (* = []*)
neuper@52070
    27
pIopt; (* = SOME ["sqroot-test", "univariate", "equation", "test"]*)
neuper@52070
    28
member op = [Pbl,Met] p_ andalso is_none (get_obj g_env pt (fst p)); (* = true*)
neuper@52070
    29
neuper@52070
    30
(* nxt_specify_ (pt, ip)
neuper@52070
    31
ERROR:  = ([(Tac "appl_add: syntax error in 'equality (<markup> + <markup> = <markup>)'",...*)
neuper@52070
    32
"~~~~~ fun nxt_specify_, args:"; val (ptp as (pt, pos as (p,p_))) = (pt, ip);
neuper@52070
    33
val pblobj as (PblObj{meth,origin=origin as (oris,(dI',pI',mI'),_),
neuper@52070
    34
			  probl,spec=(dI,pI,mI), ...}) = get_obj I pt p;
neuper@52070
    35
just_created_ pblobj (*by Subproblem*) andalso origin <> e_origin; (* = false*)
neuper@52070
    36
        val cpI = if pI = e_pblID then pI' else pI;
neuper@52070
    37
		    val cmI = if mI = e_metID then mI' else mI;
neuper@52070
    38
		    val {ppc, prls, where_, ...} = get_pbt cpI;
neuper@52070
    39
		    val pre = check_preconds "thy 100820" prls where_ probl;
neuper@52070
    40
		    val pb = foldl and_ (true, map fst pre);
neuper@52070
    41
neuper@52070
    42
(*    val (_,tac) = nxt_spec p_ pb oris (dI',pI',mI') (probl, meth) 
neuper@52070
    43
			    (ppc, (#ppc o get_met) cmI) (dI, pI, mI);
neuper@52070
    44
ERROR: val tac = Add_Given "equality (<markup> + <markup> = <markup>)"*)
neuper@52070
    45
"~~~~~ fun nxt_spec, args:"; val (Pbl, preok, (oris : ori list), ((dI', pI', mI') : spec),
neuper@52070
    46
  ((pbl : itm list), (met : itm list)), (pbt, mpc), ((dI, pI, mI) : spec)) = 
neuper@52070
    47
  (p_, pb, oris, (dI',pI',mI'), (probl, meth), 
neuper@52070
    48
			    (ppc, (#ppc o get_met) cmI), (dI, pI, mI));
neuper@52070
    49
neuper@52070
    50
dI' = e_domID andalso dI = e_domID; (* = false*)
neuper@52070
    51
pI' = e_pblID andalso pI = e_pblID; (* = false*)
neuper@52070
    52
find_first (is_error o #5) (pbl:itm list); (* = NONE*)
neuper@52070
    53
neuper@52070
    54
(* nxt_add (assoc_thy (if dI = e_domID then dI' else dI)) oris pbt pbl; 
neuper@52070
    55
= SOME ("#Given", "equality (<markup> + <markup> = <markup>)") *)
neuper@52070
    56
"~~~~~ fun nxt_add, args:"; val (thy, oris, pbt, itms) =
neuper@52070
    57
  ((assoc_thy (if dI = e_domID then dI' else dI)), oris, pbt, pbl);
neuper@52070
    58
local infix mem;
neuper@52070
    59
fun x mem [] = false
neuper@52070
    60
  | x mem (y :: ys) = x = y orelse x mem ys;
neuper@52070
    61
in 
neuper@52070
    62
    fun testr_vt v ori = (curry (op mem) v) (#2 (ori:ori))
neuper@52070
    63
      andalso (#3 ori) <>"#undef";
neuper@52070
    64
    fun testi_vt v itm = (curry (op mem) v) (#2 (itm:itm));
neuper@52070
    65
    fun test_id ids r = curry (op mem) (#1 (r:ori)) ids;
neuper@52070
    66
    fun test_subset (itm:itm) ((_,_,_,d,ts):ori) = 
neuper@52070
    67
	(d_in (#5 itm)) = d andalso subset op = (ts_in (#5 itm), ts);
neuper@52070
    68
    fun false_and_not_Sup((i,v,false,f,Sup _):itm) = false
neuper@52070
    69
      | false_and_not_Sup (i,v,false,f, _) = true
neuper@52070
    70
      | false_and_not_Sup  _ = false;
neuper@52070
    71
end
neuper@52070
    72
    val v = if itms = [] then 1 else max_vt itms;
neuper@52070
    73
    val vors = if v = 0 then oris else filter (testr_vt v) oris;(*oris..vat*)
neuper@52070
    74
    val vits = if v = 0 then itms (*because of dsc without dat*)
neuper@52070
    75
	       else filter (testi_vt v) itms;                   (*itms..vat*)
neuper@52070
    76
    val icl = filter false_and_not_Sup vits; (* incomplete *)
neuper@52070
    77
icl = []; (* = false*)
neuper@52070
    78
val SOME ori = find_first (test_subset (hd icl)) vors;
neuper@52070
    79
neuper@52070
    80
(* SOME (geti_ct thy ori (hd icl))
neuper@52070
    81
ERROR: SOME (geti_ct thy ori (hd icl))*)
neuper@52070
    82
"~~~~~ fun geti_ct, args:"; val (thy, ((_, _, _, d, ts) : ori), ((_, _, _, fd, itm_) : itm)) =
neuper@52070
    83
  (thy, ori, (hd icl));
neuper@52070
    84
"~~~~~ to  return val:"; val xxx = 
neuper@52070
    85
  ( fd, 
neuper@52070
    86
    ((term_to_string''' thy) o comp_dts) (d, subtract op = (ts_in itm_) ts) : cterm'
neuper@52070
    87
  );
neuper@52070
    88
if xxx = ("#Given", "equality (x + 1 = 2)") then () else error "";
neuper@52070
    89
neuper@52070
    90
(* resuming after stepping into code*)
neuper@52070
    91
val (p,f,nxt,pt) = (p''',f''',nxt''',pt''');
neuper@52070
    92
neuper@41986
    93
val (p,_,f,nxt,_,pt) = me nxt p [] pt; (*nxt = (_,Add_Given "equality (x + 1 = 2)*)
neuper@41986
    94
val (p,_,f,nxt,_,pt) = me nxt p [1] pt; (*nxt = (_,Add_Given "solveFor x"*)
neuper@41986
    95
case nxt of (_, Add_Given "solveFor x") => ()
neuper@41986
    96
| _ => error "minisubpbl: Add_Given is broken in root-problem";