1
$\begingroup$

I wrote a code for bisection method root approximation. However, I wanted to know the value of the root every iteration. I tried using the Union function to save each iterated value in a set but it saves the numbers in increasing order.

I am reading on NestWhileList but I am new to Mathematica and I still do not understand it much. Is there a way to use it?

f[x_] := x - E^(-1.2*x);
a = 0.5; b = 1;(*a<b*)
c = 0;
\[Epsilon] = 0.001; (*error*)
iter = 0; 
cList = {};


If[f[a]*f[b] > 0, 
 Print["Conditions of Bisection Method are not met. Disregard \
solution below."], "See solution below"]

While[Abs[b - a]/2 > \[Epsilon],
  
  c = (a + b)/2;
  iter = iter + 1; (*number of iterations*)
  cList = cList \[Union] {c};
  
  f[a];(*left-hand side*)
  f[b];(*right-hand side*)
  f[c];(*mid-point*)
  
  If[f[a]*f[c] < 0, b = c, a = c];
  ];

N[c] (*root*)
iter(*number of iterations*)
cList (*iterated roots*)
$\endgroup$
4
  • 1
    $\begingroup$ what is f ?? not defined anywhere. You say If[f[a]*f[b] > 0 but there is no f to be seen before that. $\endgroup$
    – Nasser
    Commented Oct 7, 2023 at 9:47
  • $\begingroup$ if you want to save things while running in a loop, and you do not know before hand how large the number of items you want to save is, then the standard way is to use Sow and Reap but can't show you how, since your code does not run and missing definitions. $\endgroup$
    – Nasser
    Commented Oct 7, 2023 at 9:57
  • $\begingroup$ @Nasser thanks for your response. I have included a sample function f for this problem $\endgroup$
    – Mule
    Commented Oct 7, 2023 at 10:45
  • $\begingroup$ You can change cList = cList \[Union] {c}; to cList = Append[cList, c]; $\endgroup$
    – MelaGo
    Commented Oct 8, 2023 at 3:35

3 Answers 3

1
$\begingroup$

I assume you want to collect the values of c in cList?

Just replace your loop with

cList=First@Last@Reap@While[Abs[b-a]/2>ϵ,
      c=(a+b)/2;
      iter=iter+1;(*number of iterations*)
      Sow[c];
      If[f[a]*f[c]<0,b=c,a=c]
];

Mathematica graphics

Lookup help on Sow and Reap

Btw, iter=iter+1 can be written as iter++ in Mathematica.

$\endgroup$
1
  • $\begingroup$ This is it! Thank you very much for your help and advices :) $\endgroup$
    – Mule
    Commented Oct 7, 2023 at 12:25
0
$\begingroup$

Your function and test:

f = x |-> x - E^(-1.2*x);  (* head is Function *)
test[{a_Real, b_Real}] := Abs[b - a]/2 > 0.001

Your iterative step, used with NestWhileList (as requested):

step[f_Function, {a_Real, b_Real}] /; a < b :=
 With[{c = (a + b)/2.}, If[f[a]*f[c] < 0, {a, c}, {c, b}]]
Mean /@ Most@NestWhileList[step[f, #] &, {0.5, 1.}, test]

A closely related alternative, using Sow:

sowStep[f_Function, {a_Real, b_Real}] /; a < b :=
 With[{c = (a + b)/2.}, Sow[c]; If[f[a]*f[c] < 0, {a, c}, {c, b}]]
First@Last@Reap@NestWhile[sowStep[f, #] &, {0.5, 1.}, test]

The latter has a bit less computational redundancy, although that really does not matter here.

$\endgroup$
0
$\begingroup$

Using NestWhileList

bm[f_, {a_, b_}] := 
 With[{c = (a + b)/2}, If[f[a] f[c] < 0, {a, c}, {c, b}]]
w[f_, a_, b_, e_] := 
 Mean /@ NestWhileList[bm[f, ##] &, {a, b}, 
   Abs[#[[2]] - #[[1]]]/2 > e &]

Examples

1.

f[x_] := x - E^(-1.2*x);
rt = x /. FindRoot[f[x], {x, 1}]
ans = w[f, 0.5, 1, 0.0001];
ListPlot[ans, GridLines -> {None, {rt}}]

enter image description here

  1. functions $x^2-2$, $\sin (x)$, $\cos (x)$

     ListPlot[w[#^2 - 2 &, 0., 3, 0.0001], GridLines -> {None, {Sqrt[2]}}]
     ListPlot[w[Sin, 2, 4, 0.0001], GridLines -> {None, {Pi}}]
     ListPlot[w[Cos, 1, 2, 0.0001], GridLines -> {None, {Pi/2}}]
    

enter image description here

enter image description here

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.