Áreas de regiones con polinomio de cuarto orden

 Descargar como Notebook

Dado un polinomio de cuarto orden con dos puntos de inflexión (donde cambia la concavidad). Se construye la recta que pasa por los dos puntos de inflexión, así se forman tres regiones limitadas por el polinomio y la recta y se tiene que la suma de las regiones a izquierda y derecha suman lo mismo que el área de la región de en medio.

Manipulate[m = mm[[1]]; n = mm[[2]]; p = pp[[1]]; q = pp[[2]]; 

 recta[x_] := (n - q)/(m - p) (x - m) + n; {a, b} = {c1, c2} /. 

   NSolve[{ m^4 - 2 (m + p) m^3 + 6 m p m^2 + c1 m + c2 == n, 

      p^4 - 2 (m + p) p^3 + 6 m p p^2 + c1 p + c2 == q}, {c1, c2}][[

    1]]; f[x_] := x^4 - 2 (m + p) x^3 + 6 m p x^2 + a x + b; 

 cortes = Sort[x /. NSolve[recta[x] == f[x], x]]; 

 If[Length[cortes] == 4, aa = First@cortes; bb = Last@cortes, 

  aa = First@cortes - 0.01; bb = Last@cortes + 0.01]; 

 area1 = NIntegrate[recta[x] - f[x], {x, aa, m}]; 

 area2 = NIntegrate[f[x] - recta[x], {x, m, p}]; 

 area3 = NIntegrate[recta[x] - f[x], {x, p, bb}]; 

 Grid[{{Show[

     Plot[{f[x], recta[x]}, {x, -15, 15}, PlotRange -> 100, 

      PlotLabel -> Row[{"f(x) = ", f[x]}]], 

     Plot[{f[x], recta[x]}, {x, aa, bb}, PlotRange -> 100, 

      Filling -> {1 -> {{2}, {Yellow, Green}}}], 

     Graphics[{Red, 

       Text["A1", {(aa + m)/2, (f[(aa + m)/2] + recta[(aa + m)/2])/

          2}], Text[

        "A2", {(p + m)/2, (f[(p + m)/2] + recta[(p + m)/2])/2}], 

       Text[

        "A3", {(bb + p)/2, (f[(bb + p)/2] + recta[(bb + p)/2])/2}]}], 

     ImageSize -> Medium], 

    Column[{Row[{"A1 = ", area1, 

        " Unid^2"}], 

      Row[{"A2 = ", area2, 

        " Unid^2"}], 

      Row[{"A3 = ", area3, 

        " Unid^2"}], 

      Row[{Text["   A1   +   A3   =   A2", Background -> LightRed]}], 

      Row[{area1, "+", area3, " = ", 

        area2}]}]}}], {mm, {-4, -10}, {-1, 10}, 

  Locator}, {pp, {1, -10}, {4, 10}, Locator}, 

 ContentSize -> {600, 300}]

Para aprender más sobre Mathematica ingrese aquí sitio de aprendizaje de Wolfram o en mi website ustamathematica.wixsite.com/basicas