Humor matemático

Existen 10 tipos de personas,
las que saben binarios y las que no.

Resultado curioso con la constante de Euler

 Descargar como Notebook

La constante de Euler aparece de muchas y variadas formas en el cálculo. Pero la siguiente es una que no tengo la explicación del por qué aparece.

Consideramos números aleatorios entre 0 y 1, nos interesa el número necesario para que la suma supere a uno. 

Por ejemplo, consideremos seis números aleatorios entre 0 y 1,

tabla = Table[RandomReal[], {6}]

{0.331578, 0.229754, 0.580864, 0.346653, 0.90035, 0.917802}

La suma acumulada de los tres primeros ya supera la unidad, entonces nos quedamos con el número 3,

Accumulate[tabla]

{0.331578, 0.561332, 1.1422, 1.48885, 2.3892, 3.307}

Esto lo podemos conseguir así :

s = 0; n = 0; int = {};

While[s < 1, s = s + RandomReal[]; n++; AppendTo[int, n]]; Last[int]

Lo sorprendente es que sí realizamos el anterior proceso un gran número de veces y promediamos la cantidad de números necesarios para alcanzar la unidad, el resultado tiende a la Constante de Euler.

Forma 1

Realizando el proceso 100000 veces .

prom = {};

Do[s = 0; n = 0; int = {};

 While[s < 1, s = s + RandomReal[]; n++; AppendTo[int, n]];

 AppendTo[prom, Last[int]], {i, 100000}]

Mean[prom] // N

2.71592

Forma 2

Este código nos da la posibilidad de graficar los promedios.

prom = {}; num = 0;

Do[s = 0; n = 0; int = {};

 While[s < 1, s = s + RandomReal[]; n++; AppendTo[int, n]]; 

 num = num + Last[int];

 AppendTo[prom, num/i], {i, 200000}]

N[Last[prom], 10]

2.716675000

Graficando la aproximación

Show[ListPlot[prom], Plot[E, {x, 0, Length[prom]}, PlotStyle -> Red], 

 PlotRange -> {2.6, 2.8}, AxesOrigin -> {0, 2.6}]

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

Definición de Caos por Edward Lorentz

 Cuando el presente determina el futuro,

pero una aproximación del presente no aproxima el futuro.

Pelota rebotando sobre una Parábola

 Descargar como Notebook

Se deja caer una pelota sobre una parábola bajo la acción únicamente de la fuerza de gravedad, su trayectoria genera la envolvente lineal de una nueva parábola.

Primero se resuelve la Ecuación Diferencial de forma numérica.

Clear["Global`*"]

g = 9.81;

tmax = 15;

rebote = ReflectionTransform[{1, 2 x[t]}][{-x'[t], -y'[t]}];

solucion[x0_, y0_] := 

  NDSolveValue[{y''[t] == -g, x''[t] == 0, x'[0] == 0, y'[0] == 0, 

    x[0] == x0, y[0] == y0, 

    WhenEvent[

     y[t] == x[t]^2, {x'[t], y'[t]} -> Evaluate[rebote]]}, {x, y}, {t,

     0, tmax}];

Se elige el valor inicial desde el cual se deja caer la pelota.

{xf1, yf1} = solucion[0.402, 1.];(*Cambiar el punto inicial*)

graf3 = Plot[x^2, {x, -1, 1}, PlotStyle -> Red, 

   PlotRange -> {{-1, 1}, {-0.1, 1.2}}];

Manipulate[

 max = Max[

   Transpose[

     Select[Table[{xf1[n], yf1[n]}, {n, 0, 15, 0.001}], 

      Abs[#[[1]]] < 0.001 &]][[2]]]; 

 p[a_] := Fit[{{0, max}, {xf1[0], yf1[0]}, {-xf1[0], yf1[0]}}, {1, x, 

     x^2}, x] /. {x -> a}; 

 Show[graf3, 

  If[ttt == tmax, ParametricPlot[{xf1[t], yf1[t]}, {t, 0, ttt}], 

   graf3], If[pp, Plot[p[a], {a, -1, 1}, PlotStyle -> Green], graf3], 

  Graphics[{PointSize[0.03], Blue, Point[{xf1[ttt], yf1[ttt]}]}], 

  Ticks -> None, Background -> Black], {{ttt, 0.00001, "Inicio"}, 

  0.00001, tmax, Trigger, 

  DefaultDuration -> 15}, {{pp, False, "Parábola Interna"}, {False, 

   True}}]

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

Frase Célebre de Jacob Bronowski

 Es importante que los estudiantes 

traigan cierta desnuda irreverencia a sus estudios;

no están aquí para rendir culto al conocimiento 

sino para ponerlo en tela de juicio.

Jacob Bronowski

Distancia Media de dos puntos sobre la Circunferencia Unitaria

 Descargar como Notebook

Determinar la media (el promedio) de las distancias de dos puntos que se encuentran sobre la circunferencia de radio uno. 

f[t_] := {Cos[t], Sin[t]}

Graphics[{Circle[], 

  Table[{Hue[Cos[i]], 

    Line[{f[RandomReal[2 Pi]], f[RandomReal[2 Pi]]}]}, {i, 100}]}]

Considerando los puntos en coordenadas polares son de radio 1 y únicamente quedan determinados por su ángulo.

La distancia entre los puntos (Cos(t1),Sen(t1)) y (Cos(t2),Sen(t2)) es:

Simplify[Sqrt[(Cos[t1] - Cos[t2])^2 + (Sin[t1] - Sin[t2])^2]]

TrigReduce[%]

Como, t1 y t2 toman valores entre 0 y 2Pi, por la fórmula del valor medio tenemos:

4/π

Comprobándolo por medio de una simulación:

Para 100 líneas:

ss = 0; pro = {}; nn = 100; Do[t1 = RandomReal[2 Pi]; 

 t2 = RandomReal[2 Pi];

 ss = ss + Sqrt[2 - 2 Cos[t1 - t2]]; AppendTo[pro, ss/i], {i, nn}];

Show[Plot[4/Pi, {x, 0, nn}, PlotStyle -> Red, PlotRange -> {0, 1.5}, 

  PlotLabels -> "Expressions"], ListPlot[pro]]

Para 1000 líneas :

Para 100000 líneas :

Que se corresponde con los resultados teóricos.

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

Frase Célebre de Jacques Ozaman

 La mayor parte de los amantes de las matemáticas 

se sienten atraídos por ellas debido a la sensibilidad de su belleza 

y a las maravillas que producen; 

se deleitan con sus admirables fenómenos; 

desean conocer aquello que les causa tanta admiración 

y llevar a cabo esas cosas de las que no se habían dado cuenta hasta entonces, 

y, finalmente, gustan de sorprender a los demás del mismo modo que lo fueron ellos en su momento.

Jacques Ozaman

Solido de Revolución : Método de Arandelas

 Descargar como Notebook

Se genera el sólido que se forma al hacer rotar la región comprendida entre y = x, y =(x^2) con respecto al eje y, junto con el plano transversal perpendicular al eje de rotación.

gra1 = RevolutionPlot3D[{{x}, {x^2}}, {x, 0, 1}, 

   AxesOrigin -> {0, 0, 0}, AxesLabel -> {"X", "Y", "Z"}, 

   PlotStyle -> Opacity[0.5], Mesh -> 2, 

   PlotRange -> {{-1, 1}, {-1, 1}, {-1, 2}}];

Manipulate[

 Row[{Show[gra1, 

    ContourPlot3D[z == a, {x, -1, 1}, {y, -1, 1}, {z, -1, 2}, 

     ContourStyle -> Opacity[0.8], Mesh -> 2], 

    ImageSize -> {300, 300}], 

   Graphics[{{LightBlue, Disk[{0, 0}, Sqrt[a]]}, {White, 

      Disk[{0, 0}, a]}, {Red, 

      Text[If[0.2 < a < 1, "r = Sqrt[y]", ""], 

       Sqrt[a]/2 {0.5, 0.7}], Dashed, 

      If[a < 1, 

       Line[{{0, 0}, Sqrt[a] {Cos[Pi/6], Sin[Pi/6]}}]]}, {Blue, 

      Text[If[0.3 < a < 1, "r = y", ""], Sqrt[a]/2 {-0.5, 0.7}], 

      Dashed, If[a < 1, Line[{{0, 0}, a {-Cos[Pi/6], Sin[Pi/6]}}]]}}, 

    PlotRange -> 1.5, Axes -> True, ImageSize -> {300, 300}]}], {{a, 

   0.5, "Plano Transversal"}, 0, 2}]

Figura Arriba

Su volumen es:

Pi Integrate[(Sqrt[y])^2 - (y)^2, {y, 0, 1}]

Pi/6

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

Frase Célebre de William Paul Thurston

 Hay una satisfacción genuina al hacer matemáticas,

al aprender maneras de pensar que explican, organizan y simplifican.

Uno puede sentirla al descubrir nuevas matemáticas, 

al redescubrir 'viejas' matemáticas, 

al aprender una manera de pensar de una persona o de un texto, 

o al encontrar una nueva forma de explicar o de ver una estructura matemática conocida.

William Paul Thurston

Movimiento de una bola bajo la acción de la gravedad

 Descargar como Notebook

Se simula el movimiento de una bola que es lanzada desde una altura h, con una velocidad horizontal y sobre la cual únicamente  actúa la gravedad.

Rebotando en el piso

g = 9.81;

tmax = 10;

rebote = ReflectionTransform[{1, 0}][{-x'[t], -y'[t]}];

Manipulate[

 solucion[x0_, y0_] := 

  NDSolveValue[{y''[t] == -g, x''[t] == 0, x'[0] == v0, y'[0] == 0, 

    x[0] == x0, y[0] == y0, 

    WhenEvent[y[t] == 0, {x'[t], y'[t]} -> Evaluate[rebote]]}, {x, 

    y}, {t, 0, tmax}];

 {xf1, yf1} = solucion[-0.9, h];

 Show[If[Trayectoria, ParametricPlot[{xf1[t], yf1[t]}, {t, 0, ttt}], 

   ParametricPlot[{0, 0}, {t, 0, 1}]], 

  Graphics[{{Thickness[0.1], Red, 

     Line[{{-1, -0.1}, {1, -0.1}}]}, {PointSize[0.03], Blue, 

     Point[{xf1[ttt], yf1[ttt]}]}}], Axes -> False, 

  Background -> Black, 

  PlotRange -> {{-1, 1}, {-0.1, 1.5}}], {{v0, 0.3, 

   "Velocidad Inicial Horizontal"}, 0, 1}, {{h, 0.8, "Altura"}, 0.2, 

  1}, {{ttt, 0.00001, "Acción"}, 0.00001, tmax, Trigger, 

  DefaultDuration -> 15}, {Trayectoria, {False, True}}]

Rebotando en una escalera

Ahora la bola es lanzada en una escalera.

g = 9.81;

tmax = 40;

rebote = ReflectionTransform[{1, 0}][{-x'[t], -y'[t]}];

graf1 = Plot[Floor[-x], {x, -10, 10}, PlotStyle -> Red, 

   PlotRange -> 10];

Manipulate[

 solucion[x0_, y0_] := 

  NDSolveValue[{y''[t] == -g, x''[t] == 0, x'[0] == v0, y'[0] == 0, 

    x[0] == x0, y[0] == y0, 

    WhenEvent[

     y[t] == Floor[-x[t]], {x'[t], y'[t]} -> Evaluate[rebote]]}, {x, 

    y}, {t, 0, tmax}];

 {xf1, yf1} = solucion[-5., h];

 Show[graf1, 

  If[Trayectoria, ParametricPlot[{xf1[t], yf1[t]}, {t, 0, ttt}], 

   graf1], Graphics[{{PointSize[0.03], Blue, 

     Point[{xf1[ttt], yf1[ttt]}]}}], Ticks -> None, Axes -> False, 

  Background -> Black], {{v0, 0.3, "Velocidad Inicial Horizontal"}, 0,

   1}, {{h, 9, "Altura"}, 5, 10}, {{ttt, 0.00001, "Acción"}, 0.00001, 

  tmax, Trigger, DefaultDuration -> 20}, {Trayectoria, {False, True}}]

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

Frase Célebre de J. J. Silvester

¿No se puede describir la Música como 
la Matemática de las emociones,
y la Matemática como la Música de la Razón?

J. J. Silvester

Teorema Fundamental del Cálculo

 Descargar como Notebook

Función área bajo la curva

Dada la función f(t)=t, definimos la función que calcula el área bajo la curva entre 0 y x:

s[x_] := Integrate[t, {t, 0, x}]

Manipulate[

 Row[{Show[

    Plot[t, {t, 0, 10}, PlotLabel -> Row[{"s(", x, ") = ", s[x]}], 

     ImageSize -> Small], Plot[t, {t, 0, x}, Filling -> Axis]], 

   Plot[s[a], {a, 0, x}, PlotRange -> {{0, 10}, {0, 50}}, 

    ImageSize -> Small, PlotLabel -> "s(x)"]}], {x, 0.0001, 9}]

Visualización de la relación entre el área bajo la curva y la pendiente de la recta tangente

f1[x_] := x^2

g1[x_] := 2 x

f2[x_] := Sin[x]

g2[x_] := Cos[x]

Manipulate[f = Switch[g, g1, f1, g2, f2]; 

 s[x_] := N[Integrate[g[t], {t, 0, x}], 2]; 

 Row[{Show[

    Plot[g[t], {t, -1.5, 10}, 

     PlotLabel -> 

      Row[{"Area Sombreada = ", Text[Style[N[s[x], 2], Green]]}], 

     ImageSize -> 300], Plot[g[t], {t, 0, x}, Filling -> 0], 

    Graphics[{{Red, Dashed, 

       Line[{{x, 0}, {x, g[x]}, {0, g[x]}}]}, {Red, 

       Text[g[x], {-0.5, g[x]}]}}]], 

   Show[Plot[f[t], {t, -1.5, 10}, ImageSize -> 300, 

     PlotLabel -> 

      Row[{"Pendiente de la recta tangente = ", 

        Text[Style[f'[x], Red]]}]], 

    Plot[f'[x] (t - x) + f[x], {t, -1, 10}], 

    Graphics[{{Green, Dashed, 

       Line[{{x, 0}, {x, f[x]}, {0, f[x]}}]}, {Green, 

       Text[N[f[x], 2], {-0.8, f[x]}]}}]]}], {x, 0.5, 

  9}, {{g, g1, 

   "Función"}, {g1 -> "2x y x²", 

   g2 -> "Cos(x) y Sen(x)"}}, ContentSize -> {700, 260}]

Integral vs. Derivada

La altura de la primera es la pendiente de la recta tangente de la segunda, y la altura de la segunda es el área bajo la curva acumulada de la primera.

Así, vemos que: Pendiente de la recta tangente y Area bajo la curva, son problemas relacionados.

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

Frase Célebre de Stephen Wolfram

 ¿Podría ser que en algún lugar 

del universo computacional, 

podríamos encontrar 

nuestro universo físico?

Stephen Wolfram

Cinco años y cien mil visitas

 Descargar como Notebook

Estas cifras son un excelente momento para agradecer a las personas que me han impulsado con sus colaboraciones, comentarios y visitas: MUCHAS GRACIAS.

f[n_, p_] := {Cos[n Pi/p], Sin[n Pi/p]}

a = 8;

Manipulate[

 Graphics[{If[t < 1, 

    Table[{Text[Style["5 años", RGBColor[t, Sin[n], Cos[t]]], 

       a t f[n, 10]], {RGBColor[t, Sin[n], Cos[t]], 

       Point[a p f[n, 10]]}}, {p, 0, t, 0.1}, {n, 1, 9}]], 

   If[2 > t >= 

     1, {Table[

      Text[Style[Column[{"100 000", "  visitas"}], 5 t, 

        RGBColor[t, Sin[n], Cos[n]]], a  f[n, 10]], {n, 1, 9}], 

     Table[{Orange, 

       Point[a (2 - t) f[n, 

           10] + (t - 1) (a  f[n, 10] + f[m, 5])]}, {m, 1, 10}, {n, 1,

        9}]}], If[3 > t > 2, 

    Table[Text[

      Style[Column[{"100 000", "  visitas"}], 5 t, 

       RGBColor[t, Sin[n], Cos[n]]], 

      a  f[n, 10] (3 - t) + (t - 2) {0, 5}], {n, 1, 9}]], 

   If[t >= 3, 

    Text[Style[Column[{"100 000", "  visitas"}], t^2 + t + 3, 

      Orange], (t - 2) {0, 5}]], 

   If[t >= 3.2, 

    Text[Style["5 años", 2 Exp[(t - 2)^2], Blue], {0, 5}]]}, 

  PlotRange -> {{-10, 10}, {-1, 12}}, Axes -> False, 

  Background -> Black], {t, 0, 4, Trigger, DefaultDuration -> 15}]

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

Frase Célebre de Miguel de Guzmán

 La matemática es, sobre todo, saber hacer, 

es una ciencia en la que el método 

claramente predomina sobre el contenido.

Miguel de Guzmán 

Teorema del Sándwich y Límites Trigonométricos

 Descargar como Notebook

Ejemplo

Calcular:

Plot[{x^2 Sin[50/x], x^2, -x^2}, {x, -5, 5}, PlotRange -> 20, 

 PlotLegends -> "Expressions"]

Tenemos que :

y sabemos que :

Limit[-x^2, x -> 0]

0

Limit[x^2, x -> 0]

0

por tanto,

Comprobación :

Limit[x^2 Sin[50/x], x -> 0]

0

Sabemos que :

Graphics[{{LightBlue, Disk[]}, {Orange, 

   Disk[{0, 0}, 1, {-Pi/4, Pi/4}]}, {Red, Text["R", {0.4, 0.5}], 

   Text["R", {0.4, -0.5}], Text["O", {-0.05, 0}], 

   Circle[{0, 0}, 0.1, {-Pi/4, Pi/4}], 

   Text["\[Theta]", {0.15, 0}]}, {Green, Thick, 

   Circle[{0, 0}, 1, {-Pi/4, Pi/4}]}, 

  Text["S = R\[CenterDot]\[Theta],  con \[Theta] en radianes", {1.6, 

    0}]}]

y también, en un circulo unitario tenemos:

Manipulate[

 Graphics[{Circle[], 

   Circle[{0, 0}, 0.1, {0, a}], {Line[{{0, 0}, {1, Tan[a]}}]}, {Green,

     Thick, Circle[{0, 0}, 1, {0, a}]}, {Red, Thick, 

    Line[{{Cos[a], 0}, {Cos[a], Sin[a]}}], 

    Line[{{1, 0}, {1, Tan[a]}}]}, {Text[

     "Sen(θ)", {0.89 Cos[a], 0.5 Sin[a]}], 

    Text["Tan(θ)", {1.12, 0.5 Tan[a]}], 

    Text["θ", {Cos[a/2], Sin[a/2]}], 

    Text["θ", 0.13 {Cos[a/2], Sin[a/2]}]}}, 

  Axes -> True], {{a, Pi/4, "θ"}, Pi/4, 0}]

de donde,

Así,

y como,

Limit[Cos[θ], θ -> 0]

1

Por el Teorema del Sándwich se tiene que:

Plot[Sin[θ]/θ, {θ, -1, 1}]

Quiet@TableForm[Table[{x, Sin[x]/x}, {x, -0.05, 0.05, 0.01}], 

  TableHeadings -> {None, {"x", "f(x)"}}]

El ángulo θ medido en sexagesimales

En Mathematica las funciones trigonométricas por primera opción, es decir cuando no se indica lo contrario, se calculan en radianes. Para calcular en sexagesimales se debe agregar dentro de la función Degree que es la constante que convierte de sexagesimales a radianes.

Sin[90] // N

0.893997

Sin[90 Degree]

1

Plot[Sin[θ Degree]/θ, {θ, -1, 1}]

Quiet@TableForm[Table[{x, Sin[x]/x Degree}, {x, -0.05, 0.05, 0.01}], 

  TableHeadings -> {None, {"x", "f(x)"}}]

Vemos que :

que corresponde a π/180,

N[Pi/180]

0.0174533

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

Frase Célebre de René Descartes

Cada problema que resolví 
se convirtió en una regla que sirvió
para resolver otros problemas.

René Descartes

Á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

Frase Célebre de Lex Schrijver

 Las matemáticas son como el oxigeno.

Si existe, no lo notas.

Si no existiera, no puedes vivir sin él.

Lex Schrijver

Traductor de Números

 Descargar como Notebook

Colaboración del Profesor Nicolás Marciales

Dado un número entero entre cero y cien, se escribe su traducción en diferentes idiomas: inglés, francés, español, alemán, italiano y portugués. En el comando TextTranslation[  ], se incorporan extensiones de Google o de Microsoft.

Manipulate[

 TextTranslation[IntegerName[a], idioma], {{a, 0, "Number"}, 0, 100, 

  1, Appearance -> "Open"}, {{idioma, "English", "Language"}, { 

   "English", "French", "Spanish", "German", "Italian", 

   "Portuguese"}}]

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

Frase Célebre de Albert Einstein

 La experiencia más bella que podemos tener es sentir el misterio.

Es el origen de todo el arte y toda la ciencia auténtica.

Albert Einstein

Cálculo de Límites

 Descargar como Notebook

Con el siguiente código puede determinar la clase de límite de un cociente al reemplazar directamente.

CD[f_, x_, a_] := 

 Module[{num, den}, num = Numerator[f]; den = Denominator[f]; 

  Column[{num /. x -> a, "-", den /. x -> a}]]

Ejemplo 1

Calcular:

Al reemplazar directamente

CD[(x^2 - 4)/(x - 2), x, 2]

Simplificando

Simplify[(x^2 - 4)/(x - 2)]

2 + x

y reemplazando nuevamente,

% /. x -> 2

4

Calculándolo por medio del comando Limit

Limit[(x^2 - 4)/(x - 2), x -> 2]

4

Show[Plot[(x^2 - 4)/(x - 2), {x, 0, 4}], 

 Graphics[{Red, Dashed, Line[{{2, 0}, {2, 4}, {0, 4}}]}]]

Ejemplo 2

Calcular:

Al reemplazar directamente

CD[(x^2 - 4)/(x^2 - 4 x + 4), x, 2]

Simplificando

Simplify[(x^2 - 4)/(x^2 - 4 x + 4)]

(2 + x)/(-2 + x)

Analizando que tipo de límite se obtiene :

CD[(2 + x)/(-2 + x), x, 2]

y reemplazando nuevamente,

% /. x -> 2

ComplexInfinity

Calculándolo por medio del comando Limit

Limit[(x^2 - 4)/(x^2 - 4 x + 4), x -> 2]

Indeterminate

Plot[(x^2 - 4)/(x^2 - 4 x + 4), {x, 0, 4}]

Límites Laterales

Ejemplo 3

Calcular:

Límite cuando nos acercamos a 2 por la izquierda :

Limit[(x^2 - 4)/(x - 2), x -> 2, Direction -> 1]

4

Límite por la derecha :

Limit[(x^2 - 4)/(x - 2), x -> 2, Direction -> -1]

4

Ejemplo 4

Calcular:

Por la izquierda :

Limit[(x^2 - 4)/(x^2 - 4 x + 4), x -> 2, Direction -> 1]

-∞

Por la derecha :

Limit[(x^2 - 4)/(x^2 - 4 x + 4), x -> 2, Direction -> -1]

∞

Plot[(x^2 - 4)/(x^2 - 4 x + 4), {x, 1, 3}]

Ejemplo 5

Calcular:

Definiendo por medio del comando Piecewise[ ]:

f[x_] := Piecewise[{{x, 0 < x < 2}, {x^2, 2 <= x < 4}}, None]

Plot[f[x], {x, 0, 4}]

Límite por la izquierda :

Limit[f[x], x -> 2, Direction -> 1]

2

Límite por la derecha :

Limit[f[x], x -> 2, Direction -> -1]

4

Límite total :

Limit[f[x], x -> 2]

Indeterminate

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

Frase Célebre de Joseph Fourier

 Un profundo estudio de la naturaleza

es la fuente más fértil de descubrimientos matemáticos.

Joseph Fourier

Sombreado de una Región Polar

 Descargar como Notebook

El comando Filling  que se utiliza para el sombreado de regiones planas no sé si es posible utilizarlo para regiones polares, no he encontrado como hacerlo, entonces busque otra forma para hacerlo.

Sombreado de un pétalo de la rosa de cuatro pétalos r = Cos[2 t]

Construcción de un pétalo,

PolarPlot[Cos[2 t], {t, -Pi/4, Pi/4}, PlotStyle -> Directive[Pink], 

 Axes -> False]

sombreado del pétalo,

PolarPlot[Cos[2 t], {t, -Pi/4, Pi/4}, PlotStyle -> Directive[Pink], 

  Axes -> False] /. Line -> Polygon

junto a la rosa,

Show[PolarPlot[Cos[2 t], {t, -Pi/4, Pi/4}, 

   PlotStyle -> Directive[Pink], Axes -> False] /. Line -> Polygon, 

 PolarPlot[Cos[2 t], {t, 0, 2 Pi}]]

Sombreado de un pétalo de la rosa de tres pétalos r = Cos[3 t]

Show[PolarPlot[Cos[3 t], {t, -Pi/6, Pi/6}, 

   PlotStyle -> Directive[Pink], Axes -> False] /. Line -> Polygon, 

 PolarPlot[Cos[3 t], {t, 0, 2 Pi}]]

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