;--------------------------------------------------------------------
; RSC-REPOSITORY                                               ART/97
;--------------------------------------------------------------------
;                  Copyright@1996 by F. Luis Neves
;
; Author(s):       FLN (F. Luis Neves)
; Revisions:       25.Fev.97 Rev: 22 Mar, 1997
;                            Rev: 24 Mar, 1997
;                            Rev:  3 Jan, 1998 (Final revisions)
;
;--------------------------------------------------------------------
;
;
; Comments: Automatic Reification Tool (SETS)
;

#include get.cam
#include ret.cam
#include set.cam

;
; Total reification: with all rules available
;
FUNC rfSTART(x:X,t:INT,n:INT)
PRE is-X(x)
STATE progn(gpSETTINGS(P(9,50,0,25,60,10,false,1,true,1,39)),
            gpSHOWSETTINGS(),rrINIT(),
            gpSTART(),rfEVAL(x,t),
            princ("> Best(",0,"): ",rfBESTVAL(),"\n> thinking..."),
            foreach(i,inseg(n),
                    rfSELECT(),gpCROSSOVER(),gpMUTATION(),rfEVAL(x,t),
                    princ(" best (",i,"): ",rfBESTVAL(),"\n> thinking...")),
;                    rfSHOWBEST(x));
;                    rfSHOWREIF(x));
                    rfSHOWRESULT(x));

;
; Partial reification: only with rules applied to finite functions
;
FUNC rfPSTART(x:X,t:INT,n:INT)
PRE is-X(x)
;STATE progn(gpSETTINGS(P(5,20,0,25,60,0,false,1,true,1,39)),
STATE progn(gpSETTINGS(P(10,50,3,50,60,1,false,2,true,2,39)),
            gpSHOWSETTINGS(),rrINIT(),
            gpPSTART({24,26,28,29,30,31,33,34,35,36,37,38,39}),rfEVAL(x,t),
            princ("> Best(",0,"): ",rfBESTVAL(),"%\n> thinking..."),
            foreach(i,inseg(n),
                    rfSELECT(),gpCROSSOVER(),gpMUTATION(),rfEVAL(x,t),
                    princ(" best (",i,"): ",rfBESTVAL(),"%\n> thinking...")),
;                    rfSHOWBEST(x));
;                    rfSHOWREIF(x));
                    rfSHOWRESULT(x));

FUNC rfPSTARTBAMS(x:X,t:INT,n:INT)
PRE is-X(x)
;STATE progn(gpSETTINGS(P(15,30,0,25,60,1,false,3,true,1,39)),
;STATE progn(gpSETTINGS(P(15,50,0,50,60,1,false,2,true,1,39)),
;STATE progn(gpSETTINGS(P(5,50,3,50,60,10,false,2,true,1,39)),
STATE progn(gpSETTINGS(P(10,50,3,50,60,1,false,2,true,2,39)),
            gpSHOWSETTINGS(),rrINIT(),
            gpPSTART({1,4,12,13,24,25,26,28,29,30,31,33,34,35,36,37,38,39}),
            rfEVAL(x,t),
            princ("> Best(",0,"): ",rfBESTVAL(),"%\n> thinking..."),
            foreach(i,inseg(n),
                    gpSELECT(),gpCROSSOVER(),gpMUTATION(),rfEVAL(x,t),
                    princ(" best (",i,"): ",rfBESTVAL(),"%\n> thinking...")),
;                    rfSHOWBEST(x));
;                   rfSHOWREIF(x));
                   rfSHOWRESULT(x));

FUNC rfPSTARTPPD(x:X,t:INT,n:INT)
PRE is-X(x)
;STATE progn(gpSETTINGS(P(25,30,0,25,60,0,false,1,true,1,39)),
;STATE progn(gpSETTINGS(P(15,50,0,25,60,1,false,2,true,1,39)),
STATE progn(gpSETTINGS(P(10,50,3,50,60,1,false,2,true,2,39)),
            gpSHOWSETTINGS(),rrINIT(),
            gpPSTART({1,4,12,13,24,25,26,28,29,30,31,33,34,35,36,37,38,39}),
            rfEVAL(x,t),
            princ("> Best(",0,"): ",rfBESTVAL(),"%\n> thinking..."),
            foreach(i,inseg(n),
                    gpSELECT(),gpCROSSOVER(),gpMUTATION(),rfEVAL(x,t),
                    princ(" best (",i,"): ",rfBESTVAL(),"%\n> thinking...")),
;                    rfSHOWBEST(x));
;                   rfSHOWREIF(x));
                   rfSHOWRESULT(x));


FUNC rfSELECT()
STATE let (p = roleta(G,rfBEST()))
      in if (card(dom(p)) < card(dom(G)))
         then G <- _fullsel_(p,G)
         else G <- p;

_fullsel_(p,s) = if (geq(card(dom(p)),card(dom(s)))) then p
                 else let (x = rchoice(dom(s)), k = choice(dom(s)-dom(p)))
                      in _fullsel_(p + [ k->s[x] ],s);

FUNC rfBEST():I->R
RETURN [ k -> G[k] | k <- dom(G) : gpSEL(k,2) == rfBESTVAL() ];

FUNC rfBESTVAL():INT
PRE not(gpEMPTY())
RETURN max-orio(0,{ gpSEL(x,2) | x <- dom(G) });

FUNC rfBESTOFALL():I->R
RETURN [ k -> G[k] | k <- dom(G)
                   : gpSEL(k,2) == rfBESTVAL() &&
                     gpSEL(k,3) == min-orio(CS(GV),{gpSEL(x,3) | x <- dom(G)})];

FUNC rfPOPRULES():INT-set
RETURN elems(CONC(< B1(G[x]) | x <- dom(G) >));

FUNC rfSHOWBEST(x:X)
RETURN let (b = rfBESTOFALL(), k = choice(dom(b)))
       in xPrint(ApplyFirstMatch(x,B1(b[k])));

FUNC rfPREPARE(s:STR)
RETURN x <- SETS2BSETS(FLATSETS(s,M)[s]);

FUNC rfSHOWREIF(x:X)
RETURN let (b = rfBEST(), k = choice(dom(b)), c = B1(b[k]))
       in if (GR(GV) == 2)
          then _showreif_(x,CONC(c))
          else _showreif_(x,c);

_showreif_(x,c) =
    if (c == <>) then ""
;   else let (h = head(c), t = tail(c), r = FirstMatchInv(x,h))
    else let (h = head(c), t = tail(c), r = FirstMatch(x,h),
              i = xAbsMatch(rrGetAbs(h),x,rrGetPat(h)),
              j = xRepMatch(rrGetRep(h),x,rrGetPat(h)))
         in if is-X(r)
            then progn(if (x != r)
                       then princ("\n> applying ",h,"... ",xString(r),
                                  "\n> abs = ",xAbs2Str(xAbsFun(i)),
                                  "\n> rep = ",xAbs2Str(xRepFun(j))),
                       _showreif_(r,t))
            else progn(princ("\n> applying ",h,"... ",xString(E(r)),
                             "\n> ... invariant: ",I(r)),
                       _showreif_(E(r),t));

FUNC rfSAVEREIF(x:X,f:STR)
RETURN let (b = rfBEST(), k = choice(dom(b)), c = B1(b[k]))
       in do(fp <- fopen("_","w"),
             if (GR(GV) == 2)
             then _savereif_(x,CONC(c))
             else _savereif_(x,c),
             sh("mv _ " ++ f));

_savereif_(x,c) =
    if (c == <>) then ""
;   else let (h = head(c), t = tail(c), r = FirstMatchInv(x,h))
    else let (h = head(c), t = tail(c), r = FirstMatch(x,h),
              i = xAbsMatch(rrGetAbs(h),x,rrGetPat(h)),
              j = xRepMatch(rrGetRep(h),x,rrGetPat(h)))
         in progn(if (x != r)
                  then do (fprint("_","a",<"\n\n> applying ",h,"... ">),
                           fprint("_","a",xString(r)),
                           fprint("_","a",<"\n\n> abs = ">),
                           fprint("_","a",xAbs2Str(xAbsFun(i))),
                           fprint("_","a",<"\n> rep = ">),
                           fprint("_","a",xAbs2Str(xRepFun(j)))),
                  _savereif_(r,t));

FUNC rfTEXREIF(x:X)
RETURN let (b = rfBEST(), k = choice(dom(b)), c = B1(b[k]))
       in do(fp <- fopen("_","w"),
             fprint("_","a",<"\\documentstyle{article}\n">),
             fprint("_","a",<"\\begin{document}\n">),
             fprint("_","a",<"\\section*{Data Reification}\n">),
             fprint("_","a",<"\\footnotesize{\n">),
             fprint("_","a",<"\n\\begin{eqnarray*}\n">),
             fprint("_","a",<" & & ">),
             fprint("_","a",SETS2TEX(xSets(x))),
             fprint("_","a",<"\\\\\n">),
             fprint("_","a",<"\\\\">),
             if (GR(GV) == 2)
             then _texreif_(x,CONC(c))
             else _texreif_(x,c),
             fprint("_","a",<"\n\\end{eqnarray*}\n">),
             fprint("_","a",<"}\n\\end{document}\n">),
             sh("mv _ _reif_.tex"));
;,fclose(fp));

_texreif_(x,c) = 
    if (c == <>) then ""
;   else let (h = head(c), t = tail(c), r = FirstMatchInv(x,h))
    else let (h = head(c), t = tail(c), r = FirstMatch(x,h),
              i = xAbsMatch(rrGetAbs(h),x,rrGetPat(h)),
              j = xRepMatch(rrGetRep(h),x,rrGetPat(h)))
         in if (x != r)
            then progn(fprint("_","a",<"\n">),
;                      fprint("_","a",SETS2TEX(xSets(x))),
                       fprint("_","a",<" & \\unlhd_{",h,"} & ">),
                       fprint("_","a",SETS2TEX(xSets(r))),
                       fprint("_","a",<"\\\\">),
                       fprint("_","a",<"\n & & > abs = ">),
                       fprint("_","a",xAbs2TeX(xAbsFun(i))),
                       fprint("_","a",<"\\\\">),
                       fprint("_","a",<"\n & & > rep = ">),
                       fprint("_","a",xAbs2TeX(xRepFun(j))),
                       fprint("_","a",<"\\\\">),
                       fprint("_","a",<"\n">),
                       fprint("_","a",<"\\\\">),
                       _texreif_(r,t))
            else _texreif_(r,t);

FUNC rfSHOWRESULT(x:X)
RETURN let (b = rfBEST(), k = choice(dom(b)), c = B1(b[k]))
;       in xString(erApplyFinalRule(ApplyFirstMatch(x,c)));
       in if (GR(GV) == 2)
          then xString(ApplyFirstMatch(x,CONC(c)))
          else xString(ApplyFirstMatch(x,c));

;
; Evaluation function (t = evaluation type)
; t = 1 => ER_MODEL
; t = 2 => ER_MODELSIZE
; t = 3 => FF_MODEL
; t = 4 => FF_MODELSIZE
; t = 5 => RSC_MODEL
; t = 6 => RSC_MODELSIZE
;
FUNC rfEVAL(x:X,t:INT)
STATE G <- rcprob(_reify_(x,t,G));

_reify_(e,t,s) = if (s == []) then []
                 else let (x = choice(dom(s)),
                           cx = gpSEL(x,1),
                           rx = if (GR(GV) == 2) then CONC(cx) else cx,
                           fx = rfEVALSETS(ApplyFirstMatch(e,rx),t),
                           sx = gpSEL(x,3))
                      in [ x -> R(cx,fx,sx,0,0) ] + _reify_(e,t,s\{x});

;
; Evaluates models in SETS (t = evaluation type)
; t = 1 => ER_MODEL
; t = 2 => ER_MODELSIZE
; t = 3 => FF_MODEL
; t = 4 => FF_MODELSIZE
; t = 5 => RSC_MODEL
; t = 6 => RSC_MODELSIZE
;
FUNC rfEVALSETS(x:X,t:INT):INT
RETURN if (t == 1 -> ER_EVAL(x),
           t == 2 -> ER_EVALSIZE(x),
           t == 3 -> FF_EVAL(x),
           t == 4 -> FF_EVALSIZE(x),
           t == 5 -> RSC_EVAL(x),
           t == 6 -> RSC_EVALSIZE(x))
;          t == 3 -> -1.*RSC_EVAL(x))
       otherwise(RSC_EVAL(x));

;
; Relational Model Evaluation function (ER_EVAL: X -> [0..10])
;
FUNC ER_EVAL(x:X):INT
RETURN erDegreeMatch(erApplyMetaMatch(x));

;
; Relational Model Evaluation function (ER_EVALSIZE: X -> [0..10])
; (size is important)
;
FUNC ER_EVALSIZE(x:X):INT
RETURN let (r = erApplyMetaMatch(x))
       in pdiv(erDegreeMatch(r),xComplex(r))./100;

;
; Relational Model Evaluation function (FF_EVAL: X -> [0..10])
;
FUNC FF_EVAL(x:X):INT
RETURN ffDegreeMatch(ffApplyMetaMatch(x));

;
; Relational Model Evaluation function (FF_EVALSIZE: X -> [0..10])
; (size is important)
;
FUNC FF_EVALSIZE(x:X):INT
RETURN let (r = ffApplyMetaMatch(x))
       in pdiv(ffDegreeMatch(r),xComplex(r))./100;

;
; Reusable Software Component Evaluation function (RSC_EVAL: X -> [0..10])
;
FUNC RSC_EVAL(x:X):INT
RETURN rscDegreeMatch(ffApplyMetaMatch(erApplyMetaMatch(x)));

;
; Reusable Software Component Evaluation function (RSC_EVAL: X -> [0..10])
; (size is important)
;
FUNC RSC_EVALSIZE(x:X):INT
RETURN let (r = ffApplyMetaMatch(erApplyMetaMatch(x)))
       in pdiv(rscDegreeMatch(r),xComplex(r))./100;

;--------------------------------------------------------------------
; Test models
;
;Doc <- O("*",O("*",'H,'F),O("^",O("+",'Title,O("+",'Section,'Paragraph)),3));
;DecTree <- O("*",'K,O("->",'K,O("*",'What,O("->",'Answer,'K))));
;DecTree4 <- O("*",'K ,O("*",O("^",2,O("*",'K,'What)),O("^",2,O("*",O("*",'K,'Answer),'K))));
;Entity <- O("*",O("->",O("+",'C,'E),'N),O("*",O("->",'C,'N),O("->",'E,O("->",O("+",'C,'E),'N))));
;Entity2 <- O("*",O("->",O("*",'C,'E),'Q),O("*",O("->",'C,O("*",'A,O("*",'C,'Q))),O("->",'E,O("*",'D,'Q))));
;;rule36 <- O("->",'A,O("*",'D,O("->",'B,'C)));