/* -*- prolog -*-
\documentclass{article}
\title{\includegraphics[width=1.8in]{lion_roar.pdf}\\
ROR v0.1: Abduction \& Induction\\ over Soft Goals}
\usepackage{graphicx,lineno,url}
\author{Tim Menzies, CSEE, WVU\\\url{tim@menzies.us}}


\begin{document} \maketitle  
\rightlinenumbers
\begin{abstract}
ROR,
short for 
\underline{R}ambling 
\underline{O}ver 
\underline{R}equirements, uses abduction to sample
feasible requirements,
( modeled as soft goals) then induction to
find  learns policies for better obtaining requirements.
\end{abstract}
\thispagestyle{empty}
\vspace{1cm}
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; version 2
of the License.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.
 
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  
02110-1301, USA.

Download this code  from \url{http://unbox.org/wisp/trunk/ror/ror.pl}.
\clearpage
\tableofcontents
\clearpage

\section{Set up} 
\subsection{Flags}
*/
:- dynamic assume/4.
:- index(assume(1,1,0,0)).
/* 
\subsection{Operators}  
\subsubsection{Rule operators} 
*/
:- op(999, xfy, if).
:- op(2,   xfx, says).
:- op(999, xfx, since).

:- op(1,   xfx, by).
:- op(1,   xfx, of).

X of Y :- prove(X of Y).
/*
\subsubsection{Standard Logical Operators} 
*/
:- op(998, xfy, or  ).
:- op(997, xfy, and ).
:- op(996,  fy, not ).

X or  Y :- prove(X or Y).
X and Y :- prove(X and Y).
/*
\subsubsection{The ``Polling'' Operator} 
*/
:- op(998, xfy, ors ).

/*
\subsubsection{Stochastic operators} 
*/
:- op(998, xfy, ror ).
:- op(998, xfy, rors).
:- op(997, xfy, rand).

X ror  Y :- prove(X ror Y).
X rors Y :- prove(X rors Y).
X rand Y :- prove(X rand Y).
/*
\subsubsection{Other} 
*/
:- op(998, xfy, & ).

/* 
\clearpage
\section{Abduction}

Optionally, proves sub-goals in a random order (if the
random operators \{ror, rors, rand\} are used).
If not fact or rule can prove a ground goal, it is asserted as an assumption
{\em unless} it contradicts a prior assumption. 

Rules take the form\[
Author\; says \; Claim \; if \; Proof \; since \; Reason\]

$Claims$ are weighted by their $Proof$s. The default weight is one but this
can be adjusted by the $by$ keyword in the $Proofs$.
$Proofs$ take two forms:
\begin{itemize}
\item 
$Value of Object$ : a goal to be proved either via another rule or an assumption. 
Demonstrate  $Attribute of Object$ does not alter the weight of the $Claim$.
\item 
$Weight by SubClaim$ : if we can demonstrate sub-claim, then the weight of $Claim$ 
is multiplied by $Weight$.  Weights either be numeric or symbolic such as the standard
softgoal set of \{made, help, unburt, or unbroken\}. Before each run, rand selects
randomly assigned weight for these in the range \[0 = unbroken < unhurt < 1 <  help < made = 2\]
\end{itemize}
\clearpage
\subsection{Wme management} 
*/
wrap(X)  :- 
	reset,call(X),report.

reset :- 
	zap, renumber.

zap :- 
	retractall(assume(_,_,_,_)).

renumber :- 
	Hurt   is     ranf,
	Helped is 1 + ranf,
	prove(weight of unbroken,0 ),
	prove(weight of unhurt,Hurt),
	prove(weight of helped,Helped),
	prove(weight of made,2).
	 
report :- 
	forall(assume(X,Y,W,Z), 
               format('[~p] ~p = ~p *  ~p\n',[Z,X,Y,W])).
/*
\clearpage
\subsection{Proof procedure}
\subsubsection{$prove/2$}
*/
prove(X)   :- prove(X,1).
prove(X,W) :- 	
	once(prove1(X,What2Do)), 
	prove2(What2Do,W).
/*
\subsubsection{$prove1/2$: what to do}
*/
prove1(X, oops(X)) :- var(X).

prove1(X of Y, recall(W,X,X0)) :- assume(Y,X0,W,_).
prove1(X of Y, rules(Rules)) :- 
	Goal=(_ says X of Y if _ ),
	bagof(Goal,clause(Goal,true),Rules).
prove1(X of Y, assume(Y,X)).

prove1(made     by Y, recurse(t of Y)).
prove1(helped   by Y, helped by Y).
prove1(unhurt   by Y, unhurt by Y).
prove1(unbroken by Y, recurse(f of Y)).
prove1(X        by Y, oops(badModifier(X by Y))).
prove1(true,     true(1)).
prove1(X since _,recurse(X)).
prove1(not X,    not X).
prove1(X or  Y,  do(L,1,N,1)) :- x2l(  X or  Y, L,N).
prove1(X and Y,  do(L,N,1,1)) :- x2l(  X and Y, L,N).
prove1(X ors Y,  do(L,N,N,1)) :- x2l(  X ors Y, L,N).
prove1(X ror  Y, do(L,1,N,1)) :- x2rl( X ror  Y,L,N).
prove1(X rand Y, do(L,N,1,1)) :- x2rl( X rand Y,L,N).
prove1(X rors Y, do(L,N,N,1)) :- x2rl( X rors Y,L,N).
prove1(do(_ ,Pass ,_    ,W), true(W)) :- Pass =:= 0. 
prove1(do(_ ,_    ,Fail ,_), fail   ) :- Fail =:= 0.
prove1(do([],_    ,_    ,W), true(W)).
prove1(do(L ,Pass ,Fail ,W), do(L, Pass, Fail,W )).

prove1(X, oops(unknown(X))).

/*
\subsubsection{$prove2/2$: do it}
Trivial termination case:
*/
prove2(true(W0),W) :- W is W0.
/* leave the next line commented on- so fail always fails.*/
% prove2(fail,_). % so fail fails.
/* Error case. */
prove2(oops(X),_) :- error(X).
/* Try to match to old values. */
prove2(recall(W,X,X),   W).
/* Backward chain using a rule. First demonstrate that
the author has the authority to make a rule. */
prove2(rules(Rules), W) :-
	any(member(Who says X of Y if Claim,Rules)),
	prove(authority of Who,W0),
	prove(Claim,W1),
	W is W0 * W1,
	(Claim = (true since _)
         -> bassert(assume(Y,X,W,1))
         ;  bassert(assume(Y,X,W,2))).
/* Assume something */
prove2(assume(Y,X),W) :-
	(var(W) -> W=1; true),
	bassert(assume(Y,X,W,0)).
/* If we can assume $Y$, then give it weight $X$. */
prove2(X by Y ,W) :- 
	prove(t of Y or f of Y,_), % change this page
        (prove(f of Y,W0)
        -> W=W0
        ;  prove(t of Y,W0),
           prove(weight of X,  W1),
	   W is W0 * W1).

prove2(do([_ = H|T],Pass,Fail,W0),W) :-
	prove(H,W1)
	-> prove(do(T,Pass-1,Fail,  W0*W1), W)
        ;  prove(do(T,Pass  ,Fail-1,W0   ), W).
prove2(not X,1)      :-	\+ prove(X,_).
prove2(recurse(X),W) :- prove(X,W).
prove2(X)            :- error(badProve2(X)).

% XXXX todo: facts
/* 
\subsubsection{x2l/3: structure to list} 
*/

x2rl(X,L,N) :- x2l(X,L0,N), sort(L0,L).
 
x2l(X,L,N) :- x2la(X,L), length(L,N).

x2la(X,L) :- once(x2lb(X,L)).

x2lb(X,                    _) :- var(X), !, error('illegal var').
x2lb(X0 and  Y and  Z, [X|T]) :- x2lc(X0,X), x2la(Y and  Z, T).
x2lb(X0 ors  Y ors  Z, [X|T]) :- x2lc(X0,X), x2la(Y ors  Z, T).
x2lb(X0 or   Y or   Z, [X|T]) :- x2lc(X0,X), x2la(Y or   Z, T).
x2lb(X0 rand Y rand Z, [X|T]) :- x2lc(X0,X), x2la(Y rand Z, T).
x2lb(X0 rors Y rors Z, [X|T]) :- x2lc(X0,X), x2la(Y rors Z, T).
x2lb(X0 ror  Y ror  Z, [X|T]) :- x2lc(X0,X), x2la(Y ror  Z, T).
x2lb(X0 and  Y0,       [X,Y]) :- x2lc(X0,X), x2lc(Y0,Y).
x2lb(X0 ors  Y0,       [X,Y]) :- x2lc(X0,X), x2lc(Y0,Y).
x2lb(X0 or   Y0,       [X,Y]) :- x2lc(X0,X), x2lc(Y0,Y).
x2lb(X0 rand Y0,       [X,Y]) :- x2lc(X0,X), x2lc(Y0,Y).
x2lb(X0 rors Y0,       [X,Y]) :- x2lc(X0,X), x2lc(Y0,Y).
x2lb(X0 ror  Y0,       [X,Y]) :- x2lc(X0,X), x2lc(Y0,Y).
x2lb(X,                    _) :- error(notConditional(X)).

x2lc(X,R=X)   :- R is random(65535).

/* 
\clearpage
\section{Induction}
*/

/*
\section{Library}
Here are some tools that might be useful in other applications,
not just this one.
\subsection{$runix/3}
*/
runiv(Term0, Swaps,Term) :-
    Term0 =..L0,
    once(maplist(runiv1(Swaps), L0, L)),
    Term =.. L.

runiv1(_,H,H)        :- var(H).
runiv1(Swaps,Old,New):- atomic(Old), member(Old/New,Swaps).
runiv1(_,H,H)        :- atomic(H).
runiv1(Swaps,H0,H)   :- runiv(H0,Swaps,H).

/*
\subsection{$any/1$}
*/
any(X) :- 
	setof(R/X,(X,R is ranf),L),
	member(_/X,L).
 /*
\subsection{Backtrackable asserts/retracts}
\subsubsection{$bassert/1$} 
*/
bassert(X) :- asserta(X).
bassert(X) :- retract(X),fail.
/* 
\subsubsection{$retract/1$} 
*/
bretract(X) :- retract(X), bretract1(X).

bretract1(_).
bretract1(X) :- asserta(X), fail.
/*
\subsection{Printing alerts}
\subsubsection{$warning/1$}
*/
warning(X) :-
	source_location(File, Line)
        -> file_base_name(File,Base),
	   format('% ?? ~w, line ~w: ~w\n',[Base,Line,X])
        ;  format('% ??  ~w\n',[X]).
/*
\subsubsection{$abort/1$}
*/
abort(X) :- warning(X), abort.
/*
\subsubsection{$error/1$}
*/
error(X) :- warning(X), fail.
/*
\subsection{Random Distributions in Prolog}
\subsubsection{ranf/1}
Random numbers $0 \le x < 1$.
*/

:- arithmetic_function(ranf/0).
ranf(X) :- X is random(4294967295)/4294967295.
	

/*
\subsubsection{okeys_add/1}
*/
okeys_add(L0,E,L) :- 
	okeys_add(L0,+,E,L).

okeys_add([], _,El, [El]). 
okeys_add([K=V|T], Mode,K0=V0, Add) :-
    compare(Order, K, K0),
    okeys_add1(Order, Mode,K=V, T, K0=V0, Add).

okeys_add1(<, Mode,H,  T,  El, [H|Add]) :-	okeys_add(T, Mode,El, Add).
okeys_add1(=, +,  _,   T,  El, [El|T]). 
okeys_add1(>, +,  H,   T,  El, [El,H|T]).
okeys_add1(=, =,  H,   T,  E1, L) :-
	X is random(65536), 
	compare(Order,X,32768),
	okeys_add0(Order, H,T,E1,L).
okeys_add1(>, =,  H,   T,  E1, L) :-  % keeping equal size. someone has to go
	X is random(65536), 
	compare(Order,X,32768),
	okeys_add0(Order, H,T,E1,L).

okeys_add0(>, H,T, _,[H  |T]).
okeys_add0(=, H,T, _,[H  |T]).
okeys_add0(<, _,T,E1,[E1 |T]).

/*
\subsection{Acessor Generator}

Orchestrates the generation of predicates of the form
\[F(Pos,Old,New,Term_Old,Term_New)\]
which allows a programmer to swap argument number $Pos$
is $TermOld$ to $TermNew$. $Old$ stores the swapped out-argument
nd $New$ is the swapped-in argument.

Not needed is your Prolog supports $setarg/3$.
*/
addresses(F,N,    [%(portray(Term) :- print(addresses(F/N)))
                  (:- dynamic F/N)
   	          ,(goal_expansion(Term,true) :- nonvar(Key),Term)
                  |Accessors
                  ]) :-
   functor(Term,F,N),
   arg(1,Term,Key),
   bagof(Accessor,N^F^addresses1(N,F,Accessor),Accessors).

addresses1(N,F,Accessor) :-
	between(1,N,Pos),
        joinArgs(   F,N,Pos,Old,New,Term1,Term2),
	Accessor =.. [F,Pos,Old,New,Term1,Term2].

names(F,Fields,
        [%(portray(Term) :- print(names(F/N)))
	(goal_expansion(Shell,D) :- arg(1,Shell,X),   nonvar(X),clause(Shell,D))
        ,(goal_expansion(Accessor,true) :- arg(1,Accessor,X),nonvar(X),Accessor)
        ,(:- dynamic F/N)
        |Out
        ]) :-
   length(Fields,N),
   functor(Term,F,N),
   functor(Shell,F,3),
   functor(Accessor,F,5),
   bagof(Accessor,
	     N^Fields^F^names1(F,N,Fields,Accessor),
	Accessors),
   skeletons(F,Skeletons),
   append(Accessors,Skeletons,Out).

names1(F,N,Fields,Accessor) :-
	nth1(Pos,Fields,Field),
        joinArgs(F, N, Pos,Old,New,Term1,Term2),
	Accessor =.. [F,Field,Old,New,Term1,Term2].

joinArgs(F,Arity,Pos,Old,New,Term1,Term2) :-
	length(L1,Arity),
	Pos0 is Pos - 1,
	length(Before,Pos0),
	append(Before,[Old|After],L1),
	append(Before,[New|After],L2),
	Term1 =.. [F|L1],
	Term2 =.. [F|L2].

skeletons(F,All) :- bagof(One,F^skeletons1(F,One),All).
	
skeletons1(F,One) :-
	skeleton1(Head,Body),
	runiv((Head :- Body),[skeleton/F],One).

skeleton1(skeleton(A),    Body) :- clause(skeleton(A),    Body).
skeleton1(skeleton(A,C),  Body) :- clause(skeleton(A,C),  Body).
skeleton1(skeleton(A,B,C),Body) :- clause(skeleton(A,B,C),Body).

:- dynamic skeleton/5.
skeleton([],T,T).
skeleton([H|T])         --> skeleton(H), skeleton(T).
skeleton(H & Rest)      --> skeleton(H), skeleton(Rest).
skeleton(K >= V1)       --> skeleton(K,V, V), {V >= V1  }.
skeleton(K >  V1)       --> skeleton(K,V, V), {V >  V1  }.
skeleton(K =  V)        --> skeleton(K,V, V).
skeleton(K <  V1)       --> skeleton(K,V, V), {V <  V1  }.
skeleton(K =< V1)       --> skeleton(K,V, V), {V =< V1  }.
skeleton(+K)            --> skeleton(K,V0,V), {V is V0+1}.
skeleton(-K)            --> skeleton(K,V0,V), {V is V0-1}.
skeleton(K := V)        --> skeleton(K,_, V).
skeleton(K is V0)       --> skeleton(K,_, V), {V is V0  }.
skeleton(K - Old + New) --> skeleton(K,Old,New).
skeleton(pop(K,First))  --> skeleton(K - [First|Rest] + Rest).
skeleton(pop(K))        --> skeleton(K - [_    |Rest] + Rest).
skeleton(push(K,New))   --> skeleton(K - Old + [New|Old]).

skeleton(L)   :- skeleton(0 & L,_,_). 
skeleton(L,X) :- skeleton(0 & L,_,X). 

term_expansion(def(positions,F,N),L) :- addresses(F,N,L).
term_expansion(def(names,F,Fields),L) :- names(F,Fields,L).

/*
\subsection{Buffers}

\subsubsection{Top N Items}
Keeps the N best items
*/
 
def(names,top,[max,contents,n]).

top(0)           --> top(max=20 & n=0 & contents=[]).
top(insert(K,V)) --> top(contents - Old + New),{okeys_add(Old,+,K=V,New)}.
top(least(K))    --> top(contents = [K=_|_]).
top(add(K,V))    -->
	top(max=Max & n= Max & least(K0)),{K>K0},!,
	top(pop(contents) & insert(contents(K=V))).
top(add(K,V)) -->	
	top(max=Max & n=N),{N < Max},!,
	top(push(contents,K=V) & +n).
/*
\subsection{Hash Storage}
I've been round the world on Prolog working memories-
all manner of fancy schemes. In the end, simple is best.
The following stores structures of the form $Key=Value$
in a hash table that keeps 64 externaly-chained lists.
When $Key$ is accessed in the list, it is moved to the front
of the list (so frequently accessed items can be found faster).

\subsubsection{The Engine Room}
The following section should be the $only$ place
where the magic number $HasSize$ and the magic symbol $h\_$ should appear.
*/

def(positions,h_,64).

h0(K,V0,V,H0,H) :- hash_term(K,N), N1 is (N mod 64)+1, h_(N1,V0,V,H0,H).

goal_expansion(h0(A,B,C,D,E),Goals) :- 
	clause(h0(A,B,C,D,E),Goals).

hinit(H)        :- h_(1,_,_,H,_), H =.. [_|L], maplist(hinit1,L,L).
hinit1([],[]).
/*
\subection{H shell}
*/
h(L)   :- hinit(H0), h(L,H0,_).
h(L,H) :- hinit(H0), h(L,H0,H).

h([],H,H).
h([H|T])--> h(H),h(T).
h(-K) --> h0(K,L0,L),        {front(L0,K=Old,    K=New,    L), New is Old-1}.
h(+K) --> h0(K,L0,L),        {front(L0,K=Old,    K=New,    L), New is Old+1}.
h(K=V)--> h0(K,L0,L),        {front(L0,K=Tmp,    K=V,      L), V=Tmp}.
h(push(K,V)) --> h0(K,L0,L), {front(L0,K=Old,    K=[V|Old],L)}.
h(pop(K,V))  --> h0(K,L0,L), {front(L0,K=[V|New],K=New,    L)}.

/*
\subsection{$front/3$: a list-based working memory}
Accessed keys are thrown to the front of the list.
*/

front([H|T],Old, New, [New|L]) :- oneLess(Old,[H|T],L),!.
front(L    ,  _, New, [New|L]).


/*
\subsection{$oneLess/3$}
*/

oneLess(X,[X|L],L).
oneLess(X,[H|T],[H|T1]) :- oneLess(X,T,T1).
	

/* 
\clearpage
\section{Tests}
\subsection{Unit Tests} 
\subsubsection{$units/1$}
*/
units :- bagof((unit1(X) :- Body),clause(unit1(X),Body),L),
	 forall(nth1(Num,L,Todo),units1(Num,Todo)).

unit(X) :- unit1(X).
/* 
\subsubsection{$units1/1$}
*/
units1(N,(unit1(Head) :- Body)) :-
	nl,
	format('\n%%% ----| ~p : ~p ', [N,Head]),
	write('|------------------------------------------------'),
	write('\n%% code: \n'),
        portray_clause((unit1(Head) :- Body)),
        write('\n%% output: \n'),
        ignore(call(Body)).

unit1(broken(Y)) :-
	clause(unit1(Y),Z), Y \= broken(_), \+Z, print(broken(Y)).

unit1(hstore) :- h([name=tim,age=23,+age,+age,age=A]),print(A).

unit1(hpush) :- h([name=tim,age=23,+age,+age,hobbies=[],
                   push(hobbies,reading),
		   push(hobbies,running),
		   push(hobbies,eating),
		   pop( hobbies, X),
		   hobbies=H
	          ]),
		   write(X/H).

unit1(add_keys) :-
	L0 = [10=a,20=b,30=c,40=d,50=e,60=f],
	okeys_add(L0,=,35=kk,L),
	print(L),nl.

unit1(some) :-
	bagof(add(X,a),I^(between(1,10,I),X is random(10000000)),L),
	some(max := 2 & L,S),
	print(S).
	
unit1(any) :-
	retractall(anyTest(_)),
	forall(member(X,[a,b,c,d,e]),assert(anyTest(X))),
	forall(any(anyTest(Z)),print(Z)),
	nl,
	forall(any(clause(anyTest(Z),_)),print(Z)),
	nl.

unit1(bassert) :-
	retractall(a(_)),
	assert(a(1)),
	ignore((bassert(a(2)),fail)),
	listing(a).
unit1(bassert) :-
	retractall(a(_)),
	assert(a(4)),
 	ignore((bretract(a(4)),fail)),
	listing(a).

unit1(l2r) :-
	forall(member(X,[apple, banana,choko,durian,eggplant]),
               format('~p\n',[X])). 

unit1(ror) :-
	forall(any(member(X,[apple, banana,choko,durian,eggplant])),
               format('~p\n',[X])). 

unit1(x2l(and)) :- x2l(a and b and c,L,N), print(N=L),nl.
unit1(x2l(or))  :- x2l(a or b or c,L,N), print(N=L),nl.
unit1(x2l(ors)) :- x2l(a ors b ors c,L,N), print(N=L),nl.
unit1(x2l(ror)) :- x2rl(a ror b ror c,L,N), print(N=L),nl.
unit1(x2l(rors)):- x2rl(a rors b rors c,L,N), print(N=L),nl.
unit1(x2l(rand)):- x2rl(a rand b rand c,L,N), print(N=L),nl.
unit1(x2l(mix)):- x2rl(a rand not b rand (c and d),L,N), print(N=L),nl.

unit1(reset) :-
	reset,
	report.
unit1(assume) :-
	wrap((
	  loved of millions,
	  prove(loved of millions,W),
	  print(w(W)),nl
        )).
unit1(tf) :-
	wrap(truth of god  ror false of god).
unit1(dt) :-
	wrap((
	  love of taxes,
	  fear  of death rors loathe of taxes
	)).
unit1(by) :-
	wrap((
  	  prove(t of angels),
	  prove(helped by angels,W),
	  print(W),nl
	)).
unit1(andby) :-
	wrap((
	  f of devils,
	  prove(unhurt by devils and helped by angels,W),
	  print(W),nl
        )).

/* 
\subsection{System Tests}
\subsubsection{$systems/1$}
*/
systems :- 
	bagof((system1(X) :- Body),clause(system1(X),Body),L),
	forall(nth1(Num,L,Todo),system1(Num,Todo)).

system(X) :- system1(X).
/* 
\subsubsection{$system1/1$}
*/
system1(N,(system1(Head) :- Body)) :-
	nl,
	format('\n%%% ----| ~p : ~p ', [N,Head]),
	write('|------------------------------------------------'),
	write('\n%% code: \n'),
        portray_clause((system1(Head) :- Body)),
        write('\n%% output: \n'),
        ignore(call(Body)).

system1(broken(Y)) :-
	clause(system1(Y),Z), Y \= broken(_), \+ Z.

system1(rule1)  :- wrap(([data/rule1], prove(success of browser,_))).
system1(rule2)  :- wrap(([data/rule2], prove(success of browser,_))).
system1(rule3)  :- wrap(([data/rule3], prove(success of browser,_))).
system1(rule3a) :- wrap(([data/rule3], prove(great of speed    ,_))).
system1(rule4)  :- wrap(([data/rule4], prove(fast of performance,_))).
system1(rule4a) :- wrap(([data/rule4], prove(great of speed,_    ))).
system1(rule5)  :- wrap(([data/rule5], prove(success of browser,_))).
%end