Dimostrazione costruttiva del teorema di Rolle

Riferimento:
G.C. Barozzi: Primo Corso di Analisi Matematica
Zanichelli (Bologna), 1998, ISBN 88-08-01169-0, Laboratorio 4.5-1

Precisione di macchina

x = 1.; k = 0;
While[1.+x > 1., x = x/2; k++]; Print[x,"  ", k]

Il teorema di Rolle (in forma estesa)

L'algoritmo seguente localizza un punto di annullamento della derivata prima, secondo quanto prevede la seguente
Proposizione. Sia f : [a,b] -> R continua e derivabile (almeno nei punti interni all'intervallo [a,b]); se
f(m) ≥ f(a) e f(m) ≥ f(b), dove m := (a+b)/2 (oppure f(m) ≤ f(a) e f(m) ≤ f(b)), allora esiste c in (a,b) tale che 
f'(c) = 0.

\(rolle[f_, \ x0_, \ x1_] := 

      Module[{\ flag, \ a\  = \ N[x0], \ b\  = \ N[x1], \ m, \ p, \ q, \ 

          			fa, \ fb, \ fm, \ fp, \ fq, \ eps\  = \ 2^\((\(-50\))\), \ 
          fextr}\ \ , 
\ \ \ \ \ \ \ \ m\  = \ \((a + b)\)/2; \ 
        fa\  = \ f[a]; \ fb\  = \ f[b]; \ fm\  = \ f[m]; \ 
		
        If[\((fa\  < \ fm\  < \ fb)\) || \((fa\  > \ fm\  > \ fb)\), 
          \  (*\ ipotesi\ non\ verificate\ *) 
\ \ \ \ \ \ 
          Print["Ipotesi non verificate: f(a) = ", \ fa, \ 

            						\ \ \ \ \ \ "   f(m) = ", \ fm, \ 
            "   f(b) = ", \ fb], 
\ \ \ \ \ \ 
          \(If[fm\  >= \ fa, \ flag\  = \ 1, \ flag\  = \ \(-1\)]; 
            \)\  (*\ ipotesi\ verificate\ *) 
\ \ \ \ \ \ 
            While[b\  - \ a\  > \ eps\ *\((1\  + \ Abs[m])\), 
              \ \ \ \ \ \ \ \ \ \ \  (*\ inizio\ ciclo\ *) 
\ \ \ \ \ \ \ \ 
              p\  = \ \((3  a\  + \ b)\)/4; \ q\  = \ \((a\  + \ 3  b)\)/4; 

              \ \ \ \ \ \ \ \ fp\  = \ f[p]; \ fq\  = \ f[q]; 

              \ \ \ \ \ \ \ \ 
              fextr\  = \ 
                If[flag\  == \ 1, \ Max[fp, fq, fm], \ Min[fp, fq, fm]]; 

              \ \ \ \ \ \ \ \ 
              If[fextr\  == \ fm, \ \ \  (*\ aggiornamento\ intervallo\ *) 

                \ \ \ \ \ \ \ \ \ \ \ {\ a, b, fa, fb}\ \ \  = 
                  \ {\ p, q, fp, fq}\ \ , 
\ \ \ \ \ \ \ \ \ \ \ 
                If[fextr\  == \ fp, 

                  \ \ \ \ \ \ \ \ \ \ \ \ \ {\ m, b, fm, fb}\ \ \  = 
                    \ {\ p, m, fp, fm}\ \ , 

                  \ \ \ \ \ \ \ \ \ \ \ \ \ {\ a, m, fa, fm}\ \ \  = 
                    \ {\ m, q, fm, fq}\ \ 
\ \ \ \ \ \ \ \ \ \ \ ]

                \ \ \ \ \ \ \ \ \ ]\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \  (*\ 
                fine\ aggiornamento\ intervallo\ *) 
\ \ \ \ \ \ \ ]; 
          \ \ \ \ \ \ \ \ \ \ \ \ \ \  (*\ fine\ ciclo\ *) 
\ \ \ \ \ 
          Print["c = ", \ N[m, \ 20], \ "   f'(c) = ", \ 
            N[\(f'\)[m], \ 20]]
\ \ \ \ \ ]
          \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \  (*\ fine\ If\ *) 
\ \ \ ]\)

Esempi:

f[x_] := x^7 - x

rolle[f, 0, 1]

rolle[Sin, 0, 2.5]

g[x_] := x^3 - x + 1

rolle[g, 0, 1.2]

h[x_] :=  1 - x^2

rolle[h, -1, 1.2]