Aquí veremos cómo realizar una figura como ésta con Mathematica. En primer lugar vamos a definir las funciones:
Maximo[f_, a_, b_] := Apply[Max,
Map[f, Table[a + i/10 (b - a), {i, 0, 10}]]]
Minimo[f_, a_, b_] := Apply[Min,
Map[f, Table[a + i/10 (b - a), {i, 0, 10}]]]
Para cierta función $f$ definida sobre el intervalo $[a,b]$, estas funciones
calculan los máximos $M_1, M_2, \dots, M_n$ y mínimos $m_1, m_2, \cdots, m_n$
en los intervalos $[x_0, x_1], [x_1, x_2], \dots, [x_{n-1},x_n]$ resultantes
de dividir el intervalo $[a,b]$ en $n$ partes iguales.
A continuación definimos la función:
CrearGrafico[f_, a_, b_, n_] := Module[{plot, a1},
plot = Plot[f[x], {x, a, b}, PlotStyle -> {Thick, Red}];
xs = Table[a + i/n (b - a), {i, 0, n}];
Ms = Table[Maximo[f, xs[[i]], xs[[i + 1]]], {i, 1, n}];
ms = Table[Minimo[f, xs[[i]], xs[[i + 1]]], {i, 1, n}];
M = Apply[Max, Ms];
m = Apply[Min, ms];
instr = Join[
{RGBColor[1, 1, 0.6]},
Table[Rectangle[{xs[[i]],0}, {xs[[i+1]], Ms[[i]]}], {i,1,n}],
{Yellow},
Table[Rectangle[{xs[[i]],0}, {xs[[i+1]], ms[[i]]}], {i,1,n}],
{Black},
Table[
Line[{{xs[[i]], ms[[i]]}, {xs[[i+1]], ms[[i]]}}], {i,1,n}],
Table[
Line[{{xs[[i]], Ms[[i]]}, {xs[[i+1]], Ms[[i]]}}], {i,1,n}],
Table[Line[{{xs[[i]], Min[0, ms[[i]], ms[[i - 1]]]},
{xs[[i]], Max[Ms[[i]], Ms[[i - 1]]]}}], {i, 2, n}],
{Line[{{b, 0}, {b, Ms[[n]]}}]}
];
Show[{Graphics[instr], plot},
AspectRatio -> Automatic, Axes -> True,
PlotRange -> {{a, b}, {m, M}}]
]
Esta función crea la figura para una función $f$ en un intervalo $[a,b]$ en el que se han hecho $n$ divisiones. Podemos hacer interactivo el gráfico (permitiendo al usuario manipular el valor de $n$) definiendo
CrearGrafico[f_, a_, b_] := Manipulate[
CrearGrafico[f, a, b, n], {n, 5, 40, 1}]
y ahora, para representar $f(x)=1-x^2$ en $[0,1]$ podemos introducir
CrearGrafico[1 - #^2 &, 0, 1]
No hay comentarios:
Publicar un comentario