Entrada destacada

Corazón generado desde una Matriz

martes, 22 de septiembre de 2020

martes, 15 de septiembre de 2020

Juego del Caos - Triángulo de Sierpinski



El matemático Británico Michael Barnsley en 1988 dio a conocer el siguiente proceso. Se parte de tres puntos en una hoja P, Q y R no colineales, no sobre la misma recta, (que llamaremos vértices) y otro punto X (que llamaremos punto de partida), se considera un dado que tiene tres resultados igualmente posibles: P, Q y R. Si el resultado es P nos dirigimos desde X hasta P pero nos quedamos a mitad de camino y allí marcamos punto, si es Q del punto que acabamos de marcar inmediatamente nos dirigimos a Q y también nos quedamos a mitad de camino y allí marcamos punto, y si es R dirigiéndonos a R desde el último punto marcamos a mitad de camino, y así sucesivamente. El resultado que se obtiene al realizar un número considerable de veces este proceso es sorprendente, es el Triángulo de Sierpinski.

A diferencia de otras publicaciones ya realizadas donde se mencionaba este procedimiento, vamos a realizar el procedimiento paso a paso. Primero lanzando el dado y dibujando el punto correspondiente, volviendo a lanzar el dado y así permitiendo realizar el proceso punto a punto, pero también se da la posibilidad de realizarlo de cien en cien puntos.

En Mathematica

lista = {}; n = 1; aa = "P";
Manipulate[If[n == 1, AppendTo[lista, s]]; vertices = {p, q, r}; 
 siguiente[punto_] := (vertices[[cc]] + punto)/2; 
 ran := RandomChoice[{0.33, 0.33, 0.34} -> {1, 2, 3}, 1][[1]];
 sig[punto_] := (vertices[[ran]] + punto)/2; 
 Show[Graphics[{Text["P", p + {0.1, 0.1}], Text["Q", q + {0.1, 0.1}], 
    Text["R", r + {0.1, 0.1}]}, PlotRange -> 2], 
  ListPlot[lista, PlotStyle -> {Red, PointSize[0.005]}]], 
 Text["Dado"], 
 Button[Dynamic[aa], cc = ran; 
  aa = Switch[cc, 1, "P", 2, "Q", 3, "R"]], 
 Text["Generación de Puntos"], Text["Uno por Uno"], 
 Button["Acción", n++; 
  AppendTo[lista, Nest[siguiente, Last[lista], 1]]; n++], 
 Text["Cien en Cien"], 
 Button["Continua", pp = NestList[sig, p, 100]; 
  lista = Join[lista, pp]], {{p, {1, 1}}, Locator}, {{q, {-1, 1}}, 
  Locator}, {{r, {-1, -1}}, Locator}, {{s, {2, 2}}, Locator, 
  Appearance -> "X"}]

Primeros pasos, se lanza el dado y luego se genera la acción


Algunos pasos más



Generando puntos de cien en cien




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


martes, 8 de septiembre de 2020

Frase Célebre de Isaac Asimov

El aspecto más triste de la vida actual
es que la ciencia gana en conocimiento
más rápidamente que la sociedad en sabiduría.

Isaac Asimov

martes, 1 de septiembre de 2020

Integración Tabular



Las integrales que son de la forma : Un polinomio por una función que sea integrable tantas veces como el grado del polinomio, se pueden resolver aplicando reiteradamente el método de Integración por Partes eligiendo al polinomio como la función a derivar, esto se denomina Integración Tabular.

En el siguiente código definimos la función con tres argumentos: ParT[polinomio,función,variable] para realizar el método de integración tabular:

flecha[p_, q_] := {Red, Opacity[0.5], Arrowheads[{{0, 0}, {.05, 1}}], 
  Arrow[{p, q}]}
ParT[po_, fu_, var_] := 
 Module[{n, pp, pol, fun}, 
  If[PolynomialQ[po, 
    var], {pol, fun} = {po, fu}, {pol, fun} = {fu, po}]; 
  n = Exponent[pol, var] + 1; int[func_] := Integrate[func, var]; 
  pp = NestList[int, fun, n];
  Column[{Graphics[{Table[
       flecha[{3, 0.5 - k}, {5, -0.5 - k}], {k, n}], 
      Table[Text[D[pol, {var, k}], {2, -0.5 - k}], {k, 0, n}], 
      Table[Text[pp[[k]], {6, 0.5 - k}], {k, n + 1}], {Text[
        "Polinomio a Derivar", {2, 0.5}], 
       Text["Función a Integrar", {6, 0.5}]}, 
      Table[Line[{{4 i, 1}, {4 i, -(n + 1)}}], {i, 0, 2}], 
      Table[Line[{{0, 1 - i}, {8, 1 - i}}], {i, 0, n + 2}], 
      Table[Text[
        Style[If[OddQ[k], "-", "+"], Large, 
         Green], {3.8, -0.6 - k}], {k, 0, n - 1}]}, 
     PlotRange -> {{0, 8.1}, {-(n + 2), 1}}, ImageSize -> Medium], 
    "de donde:", "",
    Row[{Defer[TraditionalForm[\[Integral]po fu \[DifferentialD]var]],
       " = ", 
      Row@Table[
        Row[{Style[Text[If[OddQ[k], "-", "+"]], Green], "(", 
          D[pol, {var, k}], ")", "(", pp[[k + 2]], ")"}], {k, 0, 
         n - 1}]}]
    , "", "Simplificando:", "", 
    Row[{Defer@TraditionalForm[\[Integral]po fu \[DifferentialD]var], 
      " = ", Integrate[pol fun, x]}]}]]

Ejemplo

Calcular  \[Integral](x^8+x^3)Sen(x)\[DifferentialD]x

Operamos:

ParT[x^8 + x^3, Sin[x], x]




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

martes, 25 de agosto de 2020

Frase Célebre de Claudi Alsina

La matemática rigurosa se hace con la mente,
la matemática hermosa se enseña con el corazón.

Claudi Alsina

martes, 18 de agosto de 2020

Función Lineal


Pendiente


Muestra que la pendiente de una recta es independiente de la elección de los puntos sobre la recta que se tomen.

a = 1; c = 3;
Manipulate[p = m (c - a); q = (c - a); 
 Show[Plot[m x + b, {x, -5, 5}, PlotRange -> {{-5, 5}, {-5, 5}}, 
   GridLines -> All, AspectRatio -> 1, 
   PlotLabel -> 
    Row[{"m =∆y/∆x = ", Defer[ Dynamic[p] /Dynamic[q]], 
      " = ", m }]], 
  Graphics[{Locator[Dynamic[{a, m a + b}]], 
    Locator[Dynamic[{c, m c + b}]], Point[{0, b}], Red, 
    Text[Row[{"b =", b}], {-0.7, b}], Dashed, 
    Line[{{a, m a + b}, {c, m a + b}, {c, m c + b}}], Blue, 
    Text[Row[{"y = ", p}], {c + 0.5, 
      m (c - a)/2 + m a + b}], 
    Text[Row[{"x = ", q}], {(c - a)/2 + a, 
      m a + b - 0.5}]}]], {{m, 1, "Pendiente: m"}, -3, 3, 
  Appearance -> "Open"}, {{b, 0, "Y-Intercepto: b"}, -3, 3}]



Forma pendiente (m) con y - Intercepto (b).


Ecuación de la recta en su forma pendiente (m) e intercepto con el eje y (b).

Manipulate[
 Show[Plot[m x + b, {x, -5, 5}, PlotRange -> {{-5, 5}, {-5, 5}}, 
   GridLines -> All, AspectRatio -> 1, 
   PlotLabel -> Row[{"y = ", TraditionalForm[m x + b] }]], 
  Graphics[{Point[{0, b}], Red, Text[Row[{"b =", b}], {-0.7, b}], 
    Dashed, Line[{{0, b}, {1, b}, {1, m + b}}], 
    Text[Row[{"m=", m}], {1.65, b + m/2}], 
    Text["1", {0.5, b - Sign[m] 0.25}]}]], {{m, 1, 
   "Pendiente: m"}, -3, 3, 0.5}, {{b, 0, "Y-Intercepto: b"}, -3, 3, 
  0.5}]


Forma pendiente (m) y un punto de la recta(x₀,y₀)


La ecuación general de la recta dada la pendiente (m) y un punto de la recta (x₀,y₀) es:

y - y₀ = m (x - x₀)



o, de forma equivalente :

m=(y-y₀)/(x-x₀)


Manipulate[b = -m p[[1]] + p[[2]]; 
 Show[Plot[m (x - p[[1]]) + p[[2]], {x, -5, 5}, 
   PlotRange -> {{-5, 5}, {-5, 5}}, GridLines -> All, 
   AspectRatio -> 1, 
   PlotLabel -> 
    Column[{Row[{"m = ", Defer[ Dynamic[m] /Dynamic[1]], " = ", m}], 
      Row[{"y  = ", 
        TraditionalForm[Expand[m (x - p[[1]]) + p[[2]]]] }]}]], 
  Graphics[{Red, Dashed, 
    Line[{{0, b}, {p[[1]], b}, {p[[1]], m p[[1]] + b}}], 
    Text[m p[[1]], {p[[1]] + 0.5, 0.5 m p[[1]] + b}], 
    Text[p[[1]], {0.5 p[[1]], b - Sign[m] 0.25}]}]], {{m, 1, 
   "Pendiente: m"}, -3, 3, 0.5}, {{p, {1, 1}}, Locator}]


La pendiente se puede interpretar como en cambio en y cuando en x el cambio es de una unidad.




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