home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / CLM89OCT.ZIP / SOLVER.PRO < prev    next >
Encoding:
Text File  |  1989-08-29  |  2.7 KB  |  115 lines
  1. Listing 1. The secant method algorithm in pseudocode form.
  2.  
  3. To solve Left = Right:
  4.  
  5. function Dif(X) = Left - Right
  6.     where X occurs in Left and/or Right;
  7.  
  8. procedure Solve;
  9. begin
  10.     Guess1 := 1;
  11.     Guess2 := 2;
  12.     repeat
  13.         Slope := (Dif(Guess2)-Dif(Guess1))/(Guess2-Guess1);
  14.         Guess1 := Guess2;
  15.         Guess2 := Guess2 - (Dif(Guess2)/Slope)
  16.     until Guess2 is sufficiently close to Guess1;
  17.     result is Guess2
  18. end.
  19.  
  20. Listing 2. Procedures to set up the problem.
  21.  
  22. % solve(Left=Right)
  23. %
  24. % On entry, Left=Right is an arithmetic
  25. % equation containing an uninstantiated
  26. % variable.
  27. %
  28. % On exit, that variable is instantiated
  29. % to an approximate numeric solution.
  30. %
  31. % The syntax of Left and Right is the same
  32. % as for expressions for the 'is' predicate.
  33.  
  34. solve(Left=Right) :-
  35.     free_in(Left=Right,X),
  36.     !,    /* accept only one solution of free_in */
  37.     define_dif(X,Left=Right),
  38.     solve_for(X).
  39.  
  40. % free_in(Term,Variable)
  41. %
  42. % Variable occurs in Term and is uninstantiated.
  43.  
  44. free_in(X,X) :-                % An atomic term
  45.     var(X).
  46.  
  47. free_in(Term,X) :-             % A complex term
  48.     Term \== [[]],
  49.     Term =.. [_,Arg|Args],
  50.   (free_in(Arg,X) ; free_in(Args,X)).
  51.  
  52. % define_dif(X,Left=Right)
  53. %
  54. % Defines a predicate to compute Left-Right
  55. % for the specified equation, given X.
  56.  
  57. define_dif(X,Left=Right) :-
  58.     abolish(dif,2),
  59.     assert((dif(X,Dif) :- Dif is Left-Right)).
  60.  
  61. Listing 3. Procedures to implement the secant method.
  62.  
  63. % solve_for(Variable)
  64. %
  65. % Sets up arguments and calls solve_aux (below).
  66.  
  67. solve_for(Variable) :-
  68.     dif(1,Dif1),
  69.     solve_aux(Variable,1,Dif1,2,1).
  70.  
  71.  
  72. % solve_aux(Variable,Guess1,Dif1,Guess2,Iteration)
  73. %
  74. % Uses the secant method to find a value of
  75. % Variable that will make the 'dif' procedure
  76. % return a value very close to zero.
  77. %
  78. % Arguments are:
  79. % Variable  -- Will contain result.
  80. % Guess1    -- Previous estimated value.
  81. % Dif1      -- What 'dif' gave with Guess1.
  82. % Guess2    -- A better estimate.
  83. % Iteration -- Count of tries taken.
  84.  
  85.  
  86. solve_aux(cannot_solve,_,_,_,100) :-
  87.     !,
  88.     write('[Gave up at 100th iteration]'),nl,
  89.   fail.
  90.  
  91. solve_aux(Guess2,Guess1,_,Guess2,_) :-
  92.     close_enough(Guess1,Guess2),
  93.     !,
  94.     write('[Found a satisfactory solution]'),nl.
  95.  
  96. solve_aux(Variable,Guess1,Dif1,Guess2,Iteration) :-
  97.     write([Guess2]),nl,
  98.     dif(Guess2,Dif2),
  99.     Slope is (Dif2-Dif1) / (Guess2-Guess1),
  100.     Guess3 is Guess2 - (Dif2/Slope),
  101.     NewIteration is Iteration + 1,
  102.     solve_aux(Variable,Guess2,Dif2,Guess3,NewIteration).
  103.  
  104. % close_enough(X,Y)
  105. %
  106. % True if X and Y are the same number to
  107. % within a factor of 0.0001.
  108. %
  109.  
  110. close_enough(X,Y) :-
  111.     Quot is X / Y,
  112.     Quot > 0.9999,
  113.     Quot < 1.0001.
  114.  
  115.