Category : Files from Magazines
Archive   : BYTE1087.ZIP
Filename : MINIPRES.LST

 
Output of file : MINIPRES.LST contained in archive : BYTE1087.ZIP


/* Program 22.1 A program for solving equations

solve_equation(Equation,Unknown,Solution) :-
Solution is a solution to the equation Equation
in the unknown Unknown.
*/
:- op(40,xfx,\).
:- op(50,xfx,^).

solve_equation(A*B=0,X,Solution) :-
!,
factorize(A*B,X,Factors\[]),
remove_duplicates(Factors,Factors1),
solve_factors(Factors1,X,Solution).

solve_equation(Equation,X,Solution) :-
single_occurrence(X,Equation),
!,
position(X,Equation,[Side|Position]),
maneuver_sides(Side,Equation,Equation1),
isolate(Position,Equation1,Solution).

solve_equation(Lhs=Rhs,X,Solution) :-
is_polynomial(Lhs,X),
is_polynomial(Rhs,X),
!,
polynomial_normal_form(Lhs-Rhs,X,PolyForm),
solve_polynomial_equation(PolyForm,X,Solution).

solve_equation(Equation,X,Solution) :-
offenders(Equation,X,Offenders),
multiple(Offenders),
homogenize(Equation,X,Offenders,Equation1,X1),
solve_equation(Equation1,X1,Solution1),
solve_equation(Solution1,X,Solution).

/* Program 22.1b Supporting code for the factorization method

factorize(Product,Term,Factors) :-
Factors is a difference-list of factors of Product
containing Term.
*/

factorize(A*B,X,Factors\Rest) :-
!,factorize(A,X,Factors\Factors1),
factorize(B,X,Factors1\Rest).
factorize(C,X,[C|Factors]\Factors) :-
subterm(X,C), !.
factorize(C,X,Factors\Factors).

/* solve_factors(Factors,Unknown,Solution) :-
Solution is a solution of the equation Factor=0 in
the Unknown for some Factor in the list of Factors.
*/

solve_factors([Factor|Factors],X,Solution) :-
solve_equation(Factor=0,X,Solution).
solve_factors([Factor|Factors],X,Solution) :-
solve_factors(Factors,X,Solution).

/* Program 22.1c Supporting code for the Isolation method */

single_occurrence(Subterm,Term) :-
occurrence(Subterm,Term,1).

maneuver_sides(1,Lhs = Rhs,Lhs = Rhs) :- !.
maneuver_sides(2,Lhs = Rhs,Rhs = Lhs) :- !.

isolate([N|Position],Equation,IsolatedEquation) :-
isolax(N,Equation,Equation1),
isolate(Position,Equation1,IsolatedEquation).
isolate([],Equation,Equation).

/* Axioms for Isolation */

isolax(1,-Lhs = Rhs,Lhs = -Rhs). % Unary minus

isolax(1,Term1+Term2 = Rhs,Term1 = Rhs-Term2). % Addition
isolax(2,Term1+Term2 = Rhs,Term2 = Rhs-Term1). % Addition

isolax(1,Term1-Term2 = Rhs,Term1 = Rhs+Term2). % Subtraction
isolax(2,Term1-Term2 = Rhs,Term2 = Term1-Rhs). % Subtraction

isolax(1,Term1*Term2 = Rhs,Term1 = Rhs/Term2) :- % Multiplication
Term2 \= 0.
isolax(2,Term1*Term2 = Rhs,Term2 = Rhs/Term1) :- % Multiplication
Term1 \= 0.

isolax(1,Term1/Term2 = Rhs,Term1 = Rhs*Term2) :- % Division
Term2 \= 0.
isolax(2,Term1/Term2 = Rhs,Term2 = Term1/Rhs) :- % Division
Rhs \= 0.

isolax(1,Term1^Term2 = Rhs,Term1 = Rhs^(-Term2)). % Exponentiation $$$ ^
isolax(2,Term1^Term2 = Rhs,Term2 = log(base(Term1),Rhs)). % Exponentiation

isolax(1,sin(U) = V,U = arcsin(V)). % Sine
isolax(1,sin(U) = V,U = 180 - arcsin(V)). % Sine
isolax(1,cos(U) = V,U = arccos(V)). % Cosine
isolax(1,cos(U) = V,U = -arccos(V)). % Cosine

/* Program 22.1d Support code for Polynomial methods */

is_polynomial(X,X) :- !.
is_polynomial(Term,X) :-
constant(Term),!.
is_polynomial(Term1+Term2,X) :-
!,is_polynomial(Term1,X),
is_polynomial(Term2,X).
is_polynomial(Term1-Term2,X) :-
!,is_polynomial(Term1,X),
is_polynomial(Term2,X).
is_polynomial(Term1*Term2,X) :-
!,is_polynomial(Term1,X),
is_polynomial(Term2,X).
is_polynomial(Term1/Term2,X) :-
!,is_polynomial(Term1,X),
constant(Term2).
is_polynomial(Term^N,X) :-
!,natural_number(N),is_polynomial(Term,X).

natural_number(N) :- integer(N),N > 0,!.
/* polynomial_normal_form(Expression,Term,PolyNormalForm) :-
PolyNormalForm is the polynomial normal form of the
Expression, which is a polynomial in Term.
*/

polynomial_normal_form(Polynomial,X,NormalForm) :-
polynomial_form(Polynomial,X,PolyForm),
remove_zero_terms(PolyForm,NormalForm), !.

polynomial_form(X,X,[(1,1)]).
polynomial_form(X^N,X,[(1,N)]).
polynomial_form(Term1+Term2,X,PolyForm) :-
polynomial_form(Term1,X,PolyForm1),
polynomial_form(Term2,X,PolyForm2),
add_polynomials(PolyForm1,PolyForm2,PolyForm).
polynomial_form(Term1-Term2,X,PolyForm) :-
polynomial_form(Term1,X,PolyForm1),
polynomial_form(Term2,X,PolyForm2),
subtract_polynomials(PolyForm1,PolyForm2,PolyForm).
polynomial_form(Term1*Term2,X,PolyForm) :-
polynomial_form(Term1,X,PolyForm1),
polynomial_form(Term2,X,PolyForm2),
multiply_polynomials(PolyForm1,PolyForm2,PolyForm).
polynomial_form(Term^N,X,PolyForm) :- !,
polynomial_form(Term,X,PolyForm1),
binomial(PolyForm1,N,PolyForm).
polynomial_form(Term,X,[(Term,0)]) :-
free_of(X,Term), !.

remove_zero_terms([(0,N)|Poly],Poly1) :-
!, remove_zero_terms(Poly,Poly1).
remove_zero_terms([(C,N)|Poly],[(C,N)|Poly1]) :-
C \= 0, !, remove_zero_terms(Poly,Poly1).
remove_zero_terms([],[]).

/* Polynomial manipulation routines */

/* add_polynomials(Poly1,Poly2,Poly) :-
Poly is the sum of Poly1 and Poly2, where
Poly1, Poly2 and Poly are all in polynomial form.
*/

add_polynomials([],Poly,Poly) :- !.
add_polynomials(Poly,[],Poly) :- !.
add_polynomials([(Ai,Ni)|Poly1],[(Aj,Nj)|Poly2],[(Ai,Ni)|Poly]) :-
Ni > Nj, !, add_polynomials(Poly1,[(Aj,Nj)|Poly2],Poly).
add_polynomials([(Ai,Ni)|Poly1],[(Aj,Nj)|Poly2],[(A,Ni)|Poly]) :-
Ni =:= Nj, !, A is Ai+Aj, add_polynomials(Poly1,Poly2,Poly).
add_polynomials([(Ai,Ni)|Poly1],[(Aj,Nj)|Poly2],[(Aj,Nj)|Poly]) :-
Ni < Nj, !, add_polynomials([(Ai,Ni)|Poly1],Poly2,Poly).

/* subtract_polynomials(Poly1,Poly2,Poly) :-
Poly is the difference of Poly1 and Poly2, where
Poly1, Poly2 and Poly are all in polynomial form.
*/

subtract_polynomials(Poly1,Poly2,Poly) :-
multiply_single(Poly2,(-1,0),Poly3),
add_polynomials(Poly1,Poly3,Poly), !.

/* multiply_single(Poly1,Monomial,Poly) :-
Poly is the product of Poly1 and Monomial, where
Poly1, and Poly are in polynomial form, and Monomial
has the form (C,N) denoting the monomial C*X^N.
*/

multiply_single([(C1,N1)|Poly1],(C,N),[(C2,N2)|Poly]) :-
C2 is C1*C, N2 is N1+N, multiply_single(Poly1,(C,N),Poly).
multiply_single([],Factor,[]).

/* multiply_polynomials(Poly1,Poly2,Poly) :-
Poly is the product of Poly1 and Poly2, where
Poly1, Poly2 and Poly are all in polynomial form.
*/

multiply_polynomials([(C,N)|Poly1],Poly2,Poly) :-
multiply_single(Poly2,(C,N),Poly3),
multiply_polynomials(Poly1,Poly2,Poly4),
add_polynomials(Poly3,Poly4,Poly).
multiply_polynomials([],P,[]).

binomial(Poly,1,Poly).

/* solve_polynomial_equation(Equation,Unknown,Solution) :-
Solution is a solution to the polynomial Equation
in the unknown Unknown.
*/

solve_polynomial_equation(PolyEquation,X,X = -B/A) :-
linear(PolyEquation), !,
pad(PolyEquation,[(A,1),(B,0)]).
solve_polynomial_equation(PolyEquation,X,Solution) :-
quadratic(PolyEquation), !,
pad(PolyEquation,[(A,2),(B,1),(C,0)]),
discriminant(A,B,C,Discriminant),
root(X,A,B,C,Discriminant,Solution).

discriminant(A,B,C,D) :- D is B*B - 4*A*C.

root(X,A,B,C,0,X= -B/(2*A)).
root(X,A,B,C,D,X= (-B+sqrt(D))/(2*A)) :- D > 0.
root(X,A,B,C,D,X= (-B-sqrt(D))/(2*A)) :- D > 0.

pad([(C,N)|Poly],[(C,N)|Poly1]) :-
!, pad(Poly,Poly1).
pad(Poly,[(0,N)|Poly1]) :-
pad(Poly,Poly1).
pad([],[]).

linear([(Coeff,1)|Poly]). quadratic([(Coeff,2)|Poly]).

/* Program 22.1d Supporting code for Homogenization */

/* offenders(Equation,Unknown,Offenders)
Offenders is the set of offenders of the equation in the Unknown */

offenders(Equation,X,Offenders) :-
parse(Equation,X,Offenders1\[]),
remove_duplicates(Offenders1,Offenders).

/* homogenize(
*/

homogenize(Equation,X,Offenders,Equation1,X1) :-
reduced_term(X,Offenders,Type,X1),
rewrite(Offenders,Type,X1,Substitutions),
substitute(Equation,Substitutions,Equation1).

reduced_term(X,Offenders,Type,X1) :-
classify(Offenders,X,Type),
candidate(Type,Offenders,X,X1).

/* Heuristics for exponential equations */

classify(Offenders,X,exponential) :-
exponential_offenders(Offenders,X).

exponential_offenders([A^B|Offs],X) :-
free_of(X,A), subterm(X,B), exponential_offenders(Offs,X).
exponential_offenders([],X).

candidate(exponential,Offenders,X,A^X) :-
base(Offenders,A), polynomial_exponents(Offenders,X).

base([A^B|Offs],A) :- base(Offs,A).
base([],A).

polynomial_exponents([A^B|Offs],X) :-
is_polynomial(B,X), polynomial_exponents(Offs,X).
polynomial_exponents([],X).

/* Parsing the equation and making substitutions */

/* parse(Expression,Term,Offenders)
Expression is traversed to produce the set of Offenders in Term,
that is the non-algebraic subterms of Expression containing Term */

parse(A+B,X,L1\L2) :-
!, parse(A,X,L1\L3), parse(B,X,L3\L2).
parse(A*B,X,L1\L2) :-
!, parse(A,X,L1\L3), parse(B,X,L3\L2).
parse(A-B,X,L1\L2) :-
!, parse(A,X,L1\L3), parse(B,X,L3\L2).
parse(A=B,X,L1\L2) :-
!, parse(A,X,L1\L3), parse(B,X,L3\L2).
parse(A^B,X,L) :-
integer(B), !, parse(A,X,L).
parse(A,X,L\L) :-
free_of(X,A), !.
parse(A,X,[A|L]\L) :-
subterm(X,A), !.

/* substitute(Equation,Substitutions,Equation1) :-
Equation1 is the result of applying the list of
Substitutions to Equation.
*/
substitute(A+B,Subs,NewA+NewB) :-
!, substitute(A,Subs,NewA), substitute(B,Subs,NewB).
substitute(A*B,Subs,NewA*NewB) :-
!, substitute(A,Subs,NewA), substitute(B,Subs,NewB).
substitute(A-B,Subs,NewA-NewB) :-
!, substitute(A,Subs,NewA), substitute(B,Subs,NewB).

substitute(A=B,Subs,NewA=NewB) :-
!, substitute(A,Subs,NewA), substitute(B,Subs,NewB).
substitute(A^B,Subs,NewA^B) :-
integer(B), !, substitute(A,Subs,NewA).
substitute(A,Subs,B) :-
member(A=B,Subs), !.
substitute(A,Subs,A).

/* Finding homogenization rewrite rules */

rewrite([Off|Offs],Type,X1,[Off=Term|Rewrites]) :-
homog_axiom(Type,Off,X1,Term),
rewrite(Offs,Type,X1,Rewrites).
rewrite([],Type,X,[]).


/* Homogenization axioms */

homog_axiom(exponential,A^(N*X),A^X,(A^X)^N).
homog_axiom(exponential,A^(-X),A^X,1/(A^X)).
homog_axiom(exponential,A^(X+B),A^X,A^B*A^X).

/* Utilities */

subterm(Term,Term).
subterm(Sub,Term) :-
compound(Term), functor(Term,F,N), subterm(N,Sub,Term).

subterm(N,Sub,Term) :-
arg(N,Term,Arg), subterm(Sub,Arg).
subterm(N,Sub,Term) :-
N > 0,
N1 is N - 1,
subterm(N1,Sub,Term).

position(Term,Term,[]) :- !.
position(Sub,Term,Path) :-
compound(Term), functor(Term,F,N), position(N,Sub,Term,Path), !.

position(N,Sub,Term,[N|Path]) :-
arg(N,Term,Arg), position(Sub,Arg,Path).
position(N,Sub,Term,Path) :-
N > 1, N1 is N-1, position(N1,Sub,Term,Path).


free_of(Subterm,Term) :-
occurrence(Subterm,Term,N), !, N=0.

single_occurrence(Subterm,Term) :-
occurrence(Subterm,Term,N), !, N=1.

occurrence(Term,Term,1) :- !.
occurrence(Sub,Term,N) :-
compound(Term), !, functor(Term,F,M), occurrence(M,Sub,Term,0,N).
occurrence(Sub,Term,0).

occurrence(M,Sub,Term,N1,N2) :-
M > 0, !, arg(M,Term,Arg), occurrence(Sub,Arg,N), N3 is N+N1,
M1 is M-1, occurrence(M1,Sub,Term,N3,N2).
occurrence(0,Sub,Term,N,N).

multiple([X1,X2|Xs]).
remove_duplicates([],[]).
remove_duplicates([X|Xs],[X|Ys]) :-
remove_duplicates(Xs,Ys).
remove_duplicates([X|Xs],Ys) :-
member(X,Xs),
remove_duplicates(Xs,Ys).
compound(Term) :- functor(Term,F,N),N > 0,!.

% Program 22.2 /* Testing and data */
test_press(X,Y) :- equation(X,E,U), solve_equation(E,U,Y).

equation(1,x^2-3*x+2=0,x).

equation(2,cos(x)*(1-2*sin(x))=0,x).

equation(3,2^(2*x) - 5*2^(x+1) + 16 = 0,x).



Sent 1 files OK

File Area #1: FROMBYTE\
Programs from the latest issue of BYTE
A)rea-Change L)ocate F)iles T)ype G)oodbye
U)pload D)ownload S)tatistics M)ain-Menu

File: A L F T G U D S M or ? for help: (

  3 Responses to “Category : Files from Magazines
Archive   : BYTE1087.ZIP
Filename : MINIPRES.LST

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/