home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
lifeos2.zip
/
LIFE-1.02
/
EXAMPLES
/
~GAUSS.LF
next >
Wrap
Text File
|
1996-06-04
|
16KB
|
479 lines
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% %
% GAUSS V. 1.1 % (pre-alpha version, kind of)
% %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Author: Christophe Bonnet
% (c) Copyright 1992 Digital Equipment Corporation
% All Rights Reserved
%%%%%%%%%%%%%%%%%%%%%%%%%
% How to use the solver ?
%
% First,needless to say, load it. You'll then have to start the solver.
% In the most current case, at the moment when you start the solver, you
% want to give hime immediately some equations to resolve. Here is the
% way to do it :
% starter([equation1,equation2...],Channel)?
%
% The "Channel" must be an uninstantiated variable. It will play the
% role of a constraint queue, the mandatory passage for sending new
% equations to the solver.
% The equations are of any of the form described below, in the
% normalization module. But don't bother to look through all the code,
% here is the authorized formulae :
% => All formulaes contructed with LIFE variables, numbers, and the
% "+", "*", "-" and "~" symbols. The three formers have their
% natural syntax (i.e. binary, infix, left-associative and the
% such) and meaning. Note that they can't be used as unary
% operators, although it's a very common usage. The "~" sign is
% a representation of the unary minus.
% => Two such expressions, each on one side of an equal sign.
%
% Note : The formers are supposed to be equal to zero. The latters
% behave in the obvious way.
%
% At this point, the reader/user may be puzzled by the fact that a
% linear equation solver accepts any type of polynomial equations as
% input. To be honest, the program behave in the following way :
% - Even if your equation doesn't look linear, it will try to expand,
% reduce and simplify it, in case all high degree terms could be
% eliminated.
% - If, after all its try, the normalizer can't turn your work into sum
% of couples (I mean product) number/variable, it will fail, with a
% polite note saying that your entry wasn't linear.
%
% I all has worked fine, the solver will treat your equations, and then
% you'll be back to the usual LIFE environement, with strange values
% assigned to your previously free variables. Note that (and, I know,
% that's a pity) these values will be the only output of the solver.
%
% - The "Channel" variable : You don't have to worry about is value. It
% should be something like q(@~). The tlda, as any experimented life
% user will know, means that a function has residuate on this variable.
% Don't worry : It is our solver itself, quietly waiting for you to
% give him more equations.
% - On the opposite, the values of the variables that has occured in
% your equation is of great interest : There you'll find the value, in
% the mathematical sense, of your variable. The psi-term that is
% associated with each variable looks like the following :
%
% X : vr(3,val=>[5*Y,-2*Z,765],wlist=>[])
%
% The sort "vr" for "variable" is just here on programming purpose, as
% is the identifier (the first field, with value 3 in our exemple).
% The attribute wlist won't give you very interesting hints either,
% unless you worry about the conception of th program. The more
% significant field is, for the user, the "val" field. If the variable
% has a definite numeric value (deduced from the equation system), it
% will be stored here, in a one element list ([42], for exemple). Else,
% it will provide you with a linear function of other variables, which
% is, in our former example, f(Y,Z)= 5Y - 2Z + 765. This function will
% automatically be replaced by a more precise one, or eventually a
% numeric value, when you'll give further information to the solver.
%%% feeding the best
%
% The "Channel" variable will allow you to give additional equations,
% that will be solved in the context defined by previous equations (i.e,
% the partial or definitive values your variables have now). You could
% do that "by hand", of course, by directly modifying the content of the
% channel variable, but we won't encourage such a practice. We've made
% for you two cute functions which theoretically do this job properly.
% Their syntax is :
%
% feeder(equation,Channel)?
% fast_feeder([eq1,eq2,...],Channel)?
% They work exactly the same way, except that feeder wwill handle a
% single equation while fast_feeder take a list of equation. Use
% whichever you want.
% By the way, you're perfectly free to put new variables in the
% equations. The counter "varcount" will assure them to have different Id.
%
% What else to say ? Well, I think I've told the main points, on the
% user point of view I mean. So... enjoy !
% Christophe.
%
% PS : I hope you won't mind my spelling. Don't worry, I won't run for
% Vice-Presidency of the USA :-)
% By the way, It's quit as bad in my own language. But with a syntax much
% less fantaisist...
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%
% changes from 1.0 to 1.1 :
%
% - use of genint for numbering the variables.
% - variables now have a "name" field, which is not used now, but will be..
module("gauss") ?
public( starter,feeder,fast_feeder,vr,~) ?
collector_starter(Q:q(@)) :- @=constraint_collector(Q).
collector_starter(Q) :- failure_handler(Q).
constraint_collector(Q:q([E|S]))-> Cont |
solve_constraint(E),
Q <- q(S),
Cont = constraint_collector(Q).
failure_handler(@) :- nl, write("=} I'm sorry, but I'm dying !"),nl,fail.
solve_constraint(gauss(L)) :- solve_eq(L).
non_strict(feeder,fast_feeder,starter)?
feeder(Eq,Q) :-
Cstr=gauss(normalize_and_test(Eq)),
Q=q([Cstr|@]).
fast_feeder([],@).
fast_feeder([E|Tl],Q) :- feeder(E,Q), fast_feeder(Tl,Q).
starter(EqList,Queue) :-
Queue :== @,
collector_starter(Queue),
fast_feeder(EqList,Queue).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% NORMALIZING ARBITRARY POLYNOMIAL FORMS
% Before to give the equations to the solver, we want to normalize them,
% that is, in our case, translating them to an ordered sum of
% coefficient*variable products. The somewhat obuscated form of the code below
% is due to the fact that we want to give the user the freedom of writing ugly
% things. By "ugly things", I mean any arithmetic expression that we can write
% using *,- and + (and ~, who is just a convenient symbol for the unary minus
% --- overloading of the minus sign bring us a pretty heap of trouble...).
% It's clear that such expressions won't always be linear, but our politic is
% to accept any polynomial expression as an input, and throw them away if the
% normalization module haven't found that they really were nonlinear.
% examples of correct expressions (due to Peter Van Roy), who appeared to
% be linear after a trip through our normalizer :
% (X+1)*(X-1)-X*X
% X*Y+45*(Y+W+3*(W+Q+23))-Y*X
% (X*X+Y*Y)-(X+Y)*(Y+X)+X*Y*(1+1)
% (A+B+C+D+E+F+G)*(1+2+3+4+3+Z)-Z*(G+F+E+D+C+B+A)
% note that expression without equal sign are treated as if there were an "= 0"
% just behind them.
%%%%%%%%%%%%%%%%%%%%%%%%%
% The normalize function
op(500,fx,~)?
non_strict(normalize,norm_first_pass,norm_dist,kill_zeroes,non_zero_term)?
normalize(E)-> Expr |
norm_first_pass(E,F),
G= norm_dist(F),!,
kill_zeroes(G,Expr).
kill_zeroes([],[0]).
kill_zeroes([A:real],[A]).
kill_zeroes([A*V|Tl1],[A*V|Tl2]) :-
non_zero_term(A),!,
kill_zeroes(Tl1,Tl2).
kill_zeroes([@|Tl1],Tl2) :- kill_zeroes(Tl1,Tl2).
non_zero_term(0) :- !,fail.
non_zero_term(real) :- !.
non_zero_term(A*vr) :- non_zero_term(A).
% normalize_and_test check if th expression (I mean, the equation)
% is of degre 1, i.e that, after simplification, there is no variables
% product left in it.
normalize_and_test(E)-> Expr |
norm_first_pass(E,F),
G= norm_dist(F),
kill_zeroes(G,Expr),!,
deg_check(Expr).
non_strict(deg_check) ?
deg_check([real]) :- !.
deg_check([real*vr|Tail]) :- !,deg_check(Tail).
deg_check(@) :- write("=} Your equation is definitely non linear. We can't do
anything for you..."),!,fail.
%%%%%%%%%%%%
% This first part of the normalizer will create the adequate data structures
% for any free variable she will meet, and suppress the minus (unary and
% binary) signs. It will also multiply a lot of variables by one, thus ensuring
% that we have no variable in our expression that aren't the left factor of a
% product.
%dynamic(varcount)?
%varcount -> 0.
%nvar -> vr(X,val=>none,wlist=>[])|X=varcount+1,setq(varcount,X).
nvar -> vr(Id:genint,name=>strcon("_",int2str(Id)),val=>none,wlist=>[]).
named_nvar(N:string) -> vr(Id:genint,name=>N,val=>none,wlist=>[]).
norm_first_pass(X,1*X) :-
X :== @,!,
X=nvar.
norm_first_pass(V:vr,1*V) :- !.
norm_first_pass(A:real,A) :- !.
norm_first_pass( ~X , Z*X2) :-
!,Z= -1,
norm_first_pass(X,X2).
norm_first_pass(X=Y,X2+Z*Y2) :-
!,
Z= -1,
norm_first_pass(X,X2),
norm_first_pass(Y,Y2).
norm_first_pass(X+Y,X2+Y2) :-
!,norm_first_pass(X,X2),
norm_first_pass(Y,Y2).
norm_first_pass(X*Y,X2*Y2) :-
!,norm_first_pass(X,X2),
norm_first_pass(Y,Y2).
norm_first_pass(X-Y,X2+Z*Y2) :-
!,Z= -1,
norm_first_pass(X,X2),
norm_first_pass(Y,Y2).
%%%%%%%%%%%%%%%%%%%%%%%%
% this part (who have been entirely rewritten since the original version of
% this program -- they are now mainly written in a functionnal way) deal with
% embedded sums and products. The order of the term being vital for the solver,
% our "philosophy" (may Socrates pardon me this offense...) has been to
% create and modify the data structure (i.e. mainly lists that represent
% equations) such that they always stay sorted.
norm_dist(A:real) -> [A].
norm_dist(T:(real*vr)) -> [T].
norm_dist(T1*T2) -> merge_lists(mult_list_list(norm_dist(T1),norm_dist(T2))).
norm_dist(T1+T2) -> special_merge(norm_dist(T1),norm_dist(T2)).
non_strict(varless)?
varless(vr(X),vr(Y)) -> X<Y.
varless(@*vr(X),B) -> varless(vr(X),B).
varless(A,@*vr(Y)) -> varless(A,vr(Y)).
varless(@,real) -> true.
varless(@,@) -> false.
non_strict(termless_pred) ?
termless_pred(real,real,false).
termless_pred(@,real,true).
termless_pred(real,@,false).
termless_pred(T1*V,T2*V,B) :- termless_pred(T1,T2,B).
termless_pred(@*vr(X),@*vr(Y),B) :- B = X < Y.
termless(T1,T2) -> B | termless_pred(T1,T2,B).
non_strict(mult_term_var) ?
mult_term_var(V:vr,A:real) -> `(A*V).
mult_term_var(V1:vr,A*V2) -> cond(varless(V1,V2),`(A*V2*V1),
`(T*V2)) |
T=mult_term_var(V1,A).
non_strict(mult_term_real) ?
mult_term_real(A:real,B:real) -> A*B.
mult_term_real(A,T*V) -> `(T2*V) | T2=mult_term_real(A,T).
non_strict(mult_list) ?
mult_list(A:real,L) -> mult_list_real(A,L).
mult_list(V:vr,L) -> mult_list_var(V,L).
mult_list(A*V:vr,L) -> T |
F = mult_list_var(V,L),
T = mult_list(A,F).
non_strict(mult_list_real) ?
mult_list_real(@,[]) -> [].
mult_list_real(A,[B:real|Tl]) -> [A*B | mult_list_real(A,Tl)].
mult_list_real(A,[V:vr|Tl]) -> [`(A*V) | mult_list_real(A,Tl)].
mult_list_real(A,[T*V|Tl]) -> [`(X*V) | mult_list_real(A,Tl)] |
X = mult_term_real(A,T).
mult_list_var(@,[]) -> [].
mult_list_var(V,L:[A|Tl]) -> cond(varless(A,V),
[mult_term_var(V,A)| mult_list_var(V,Tl)],
[`(A*V)| mult_list_var(V,Tl)]).
mult_list_list([],@)-> [].
mult_list_list([X|Tl], Liste) -> [mult_list(X,Liste)|
mult_list_list(Tl,Liste)].
special_merge([],L) -> L.
special_merge(L,[]) -> L.
special_merge(L1:[A|Tl1],L2:[B|Tl2]) ->
cond(termless(A,B),
[A|special_merge(Tl1,L2)],
(cond(termless(B,A),
[B|special_merge(L1,Tl2)],
[add_terms(A,B)|special_merge(Tl1,Tl2)]))).
%| write(termless(A,B)," | ",termless(B,A)," ",A," + ",B),nl)).
non_strict(add_terms)?
add_terms(A:real,B:real) -> A+B.
add_terms(A*V:vr,B*V) -> `(T*V) | T=add_terms(A,B).
merge_lists([]) -> [].
merge_lists([X|Tl]) -> special_merge(X,merge_lists(Tl)).
non_strict(solve_eq,mult_eq,div_eq,do_subst,wake_up)?
solve_eq([0]) :- !. %succes
solve_eq([real]) :- !,fail. %failure
solve_eq([A*X:vr(val=>none)|L]) :- !,inst_var(X,L,A). %"pivot"
solve_eq([A*vr(val=>V)|L]) :- ML=mult_eq(V,A), %substit
slist_merge(ML,L,NL),
solve_eq(NL).
div_eq([A:real],B) -> [-A/B].
div_eq([A*X|Tl],B) -> [`(Z*X)|div_eq(Tl,B)] | Z= -A/B.
mult_eq([A:real],B) -> [A*B].
mult_eq([A*X|Tl],B) -> [`(Z*X)|mult_eq(Tl,B)] | Z=A*B.
inst_var(X:vr(val=>V,wlist=>W),Eq,A) :-
do_subst(Eq,NewEq),
V <- div_eq(NewEq,A),
I= -1,
wake_up(W,[I*X|V]),
update_vars(X,V),
W <- [].
do_subst(X:[real],X) :- !.
do_subst([T:(A*vr(val=>none))|L],[T|NL]) :-
!,do_subst(L,NL).
do_subst([T:(A*vr(val=>V))|Tl],NV) :-
ML=mult_eq(V,A),
slist_merge(ML,Tl,NL),
do_subst(NL,NV).
wake_up([],@) :- !.
wake_up([gauss_wup(lhs_var=>X,coef=>A)|WL],Val) :-
% nl,write(X),nl,write(WL),nl,
recompute(X,A,Val),
wake_up(WL,Val).
recompute(X:vr(Id,name=>N,val=>Oldval),Coef,Sval) :-
ML=mult_eq(Sval,Coef),
merge_and_clean(Oldval,ML,Newval,Upd,X),
update_vars(X,Upd),
X <- vr(Id,name=>N,val=>Newval,wlist=>[]).
non_strict(update_vars)?
update_vars(@,[]) :- !.
update_vars(@,[real]) :- !.
update_vars(X,[A*Y:vr(Id,name=>N,wlist=>WL)|Tl]) :-
Y <- vr(Id,name=>N,
val => none,
wlist => [gauss_wup(lhs_var=>X, coef=>root_sort(A)) | WL]),
update_vars(X,Tl).
non_strict(slist_merge,merge_and_clean)?
slist_merge([],L,L) :- !.
slist_merge(L,[],L) :- !.
slist_merge([A:real],[B:real],[C]) :- !,C=A+B.
slist_merge([A|L1],L2:[B|@],[A|L3]) :-
varless(A,B), !,
slist_merge(L1,L2,L3).
slist_merge(L1:[A|@],[B|L2],[B|L3]) :-
varless(B,A),!,
slist_merge(L1,L2,L3).
slist_merge([(A:real)*(V:vr(Id))|L1],[(B:real)*vr(Id)|L2],Z) :-
C= A+B,
Z=cond(null(C),L3,[`(C*V)|L3]),
slist_merge(L1,L2,L3).
merge_and_clean([],L,L,L,@) :- !.
merge_and_clean(L,[],L,[],@) :- !.
merge_and_clean([A:real],[B:real],[C],[],@) :- !,C=A+B.
merge_and_clean([A|L1],L2:[B|@],[A|L3],Upd,Lhs) :-
varless(A,B), !,
merge_and_clean(L1,L2,L3,Upd,Lhs).
merge_and_clean(L1:[A|@],[B|L2],[B|L3],[B|Upd],Lhs) :-
varless(B,A),!,
merge_and_clean(L1,L2,L3,Upd,Lhs).
merge_and_clean([(A:real)*(V:vr(Id))|L1],
[(B:real)*vr(Id,wlist=>WL)|L2],L3,Upd,Lhs) :-
A+B=0,!,
clean_wlist(WL,Lhs),
merge_and_clean(L1,L2,L3,Upd,Lhs).
merge_and_clean([(A:real)*(V:vr(Id))|L1],
[(B:real)*vr(Id,wlist=>WL)|L2],[T|L3],[T|Upd],Lhs) :-
C= A+B,
T=`(C*V),
clean_wlist(WL,Lhs),
merge_and_clean(L1,L2,L3,Upd,Lhs).
null(0)->true.
null -> false.
% les deux premiers arguments de s_merge sont les slists a combiner,
% le troisieme est le resultat, le 4eme la liste des sous_listes du resultat
% dont le premier element vient de la premiere liste. En d'autres termes, c'est
% la liste des cellules de listes que l'on a creees.
s_merge([A|L1],L2:[B|@],L3:[A|L2],[L3|PtL]) :-
varless(A,B), !,
s_merge2(L1,L3,PtL).
s_merge(L1,L2,L2,PtL) :- s_merge2(L1,[@|L2],PtL).
s_merge2([],@,[]) :- !.
s_merge2(L,[@|X:[]],L) :- !,X <- L.
s_merge2([A:real],[@,B:real],[]) :- !,B <- A+B.
s_merge2([A|L1],LP:[U|L2:[B|@]],[L3|PtL]) :-
varless(A,B), !,
LP <- [U|L3:[A|L2]],
s_merge2(L1,L3,PtL).
non_strict(s_merge2)?
s_merge2(L1:[A|@],[@|L2:[B|@]],PtL) :-
varless(B,A), !,
s_merge2(L1,L2,PtL).
s_merge2([(A:real)*vr(Id,wlist=>WL)|L1],LP:[@|L2:[(B:real)*vr(Id)|@]],PtL) :-
A+B = 0, !,
clean_wlist(WL,L2),
del(L2),
s_merge2(L1,LP,PtL).
s_merge2([(A:real)*vr(Id)|L1],[@|L2:[(B:real)*vr(Id)|@]],PtL) :-
B <- A+B,
s_merge2(L1,L2,PtL).
clean_wlist([],@).
clean_wlist(WL:[gauss_wup(lhs_var=>V)|Tail],V) :- !,WL <- Tail,
clean_wlist(WL,V).
clean_wlist([@|WL],V) :- clean_wlist(WL,V).