Rozwiązanie problemu podniesionego w Zad 2 na kolokwium. Znaleźc minimalne pole
wyznaczone przez rozwiazanie r. różniczkowego i oś x-ów dla pewnego przedziału pochodnej w punkcie x=0.

W pierwszej kolejności wpisujemy mozolnie zadane równanie:

n = 2

rownanie = y''[
          x] == -2 Sin[y'[x] + y[x] + Sin[x]]^n

Teraz określamy przedział w którym szukamy rozwiązania r. rózniczkowego. Jeżeli nie jest z góry określony to trzeba znaleźć zensowne wartości metodą prób i błędów. Warto wykonać obliczenia 2-stopniowo (1) dla x1=-15, x2=15; a1=-1.5, a2=1.5 (2) x1=-5, x2=5; a1=-0.5, a2=1.0 :

x1 = -15

    x2  =  15

Tu zadajemy zakres {a1,a2} w którym zmienia się pochodna w punkcie x=0. Dodatkowo podajemy z jaka dokładnością będziemy przeszukiwać podany przedział. Do czasu w którym nie bądziemy absolutnie pewni, że kod ponizej nie zawiera błędów wartość δa powinna być na tyle mała aby zakres {a1,a2} był podzielony na kilka (3-7) podprzedziałów. Później mozna zmniejszyć δa w celu rozwiązania problemu z większą dokładnością.

a1 = -1.5

    a2 = 1.5


 (*
a1 = -0.5
a2 = 
          1.0
*) 

    δa = 0.3

Instrukcja poniżej to główny punkt zadania. Instrukcja Table generuje tablicę rozwiązań równania rózniczkowego w przedziale {x1,x2}zmieniając wartość parametru a w przedziale {a1,a2} co δa. Rozwiazanie jest od razu ,,wyciagane'' z listy reguł transformacyjnych generowanych
przez NDSolve operatorem  ,, /. ''. Jako wynik otrzymujemy tablicę w której pierwsza kolumna zawiera wartość parametru a, natomiast druga funkcję (interpolującą) zmiennej ,,x'' która jest rozwiazaniem r. różniczkowego.

fTBL = 
        Table[
{
a, 
y[
                x] /. NDSolve[{rownanie, 
                    y[0] == 1, y'[0] == a}, 
                  y[x], {x, x1, 
                    x2}][[1]]
}
, {a, a1, a2, δa}];

Tu odczytujemy rozmiar tablicy rozwiazań:

num = Dimensions[fTBL][[1]]

Aby zorientować się o co chodzi, rysujemy wszystkie rozwiązania, podpisując każdy rysunek wartością parametru ,,a''. Od razu widać, że pole jest minimalne dla wartości bliskich a={0.0,0.5}. Zwykle to wystarcza aby znaleźć rozwiązanie, ale w tym wypadku ocenianie które
z pół jest najmniejsze ,,na oko'' zawiedzie gdyż pole bardzo powoli zmienia się w otoczeniu minimum.

Table[
      Plot[fTBL[[ii]][[2]], {x, x1, x2}, 
        PlotRange -> {All, {0, 5}}, 
        PlotLabel -> "a=" <> 
            ToString[fTBL[[ii]][[1]]]], {ii, 1, num}]

Dlatego musimy obiektywnie obliczyć pole za pomocą całki. Naiwne podejście polegałoby na obliczeniu punktów przecięcia wykresu z osią x, np xa i xb a następnie obliczenie całki NIntegrate[F[x], {x, xa,xb}]. Nie jest to jednak potrzebne. Wystarczy wprowadzić pod całkę funkcję
która dla F[x]<0 przyjmuje wartość zero. Obliczamy tablicę wartości pól:

area = 
      Table[{fTBL[[ii]][[1]], 
            NIntegrate[
              If[fTBL[[ii]][[2]] > 
                  0, fTBL[[ii]][[2]], 0], {x, x1, x2}]}, {ii, 1, 
            num}]  // Interpolation

Plot[area[a], {a, a1, a2}]

odp = FindMinimum[area[a], {a, 0.4, 0.05, 1.0}]

am = a  /.  odp[[2]]
Pmin  =  odp[[1]]

Jeżeli traktujemy problem poważnie to powinnismy oszacować błąd odpowiedzi. Dokładność wyznaczenia am jest nie mniejsza
niż zadany na początku krok δa:

δa
area[am + δa]
area[am - δa]
area[am]

blad  =  
      Max[area[am - δa], area[am + δa]] - area[am]

Ostateczna odpowiedź: minimum jest w punkcie:

ToString[am]  <>  "±"  <> 
      ToString[δa]

a minimalne pole:

ToString[Pmin]  <>  "±"  <> ToString[blad]

Ktoś dociekliwy zapewne zauważy, że tak naprawdę minimalne pole nie może być większe niz najmniejsza z obliczonych w tablicy wartości, więc błąd oznacza że pole może być tylko mniejsze niż podana wartość.