EJEMPLOS DE PROGRAMACIÓN

- La estructura básica de la programación es el uso del comando Module. Es dentro de este contexto donde definimos tanto las variables locales como los distintos pasos que se han de ejecutar para la obtención de un resultado. La sintaxis es :

Module[{x, y, ...}, expr] specifies that occurrences of the
   symbols x, y, ... in expr should be treated as local.
   Module[{x = x0, ...}, expr] defines initial values for x,
   ....

En " expr " escribimos las líneas de programación, separadas por punto y coma (;).

- Cuando se quiere establecer una condición para un proceso de selección, es recomendable el uso de funciones puras. Por ejemplo, si de una lista  L nos interesa contar el número de ocurrencias en un intervalo (a,b), escribimos Select[L,(a<#<b)&].

Select[{1,2,3,4,5,6,7,8,9},(3<=#<=7)&]

     {3, 4, 5, 6, 7}

- Otros comandos importantes que hay que recordar son: While, Do, If (uso del incremento i++), And y AppendTo.

Ejercicio 1: Escribir un programa que represente gráficamente los determinantes de M matrices cuadradas de dimensión NxN, que toman valores aleatorios en el intervalo [0,1]. Dibujar el número de ocurrencias de los valores de los determinantes en subintervalos de longitud 0.1 (variando entre
-1 y 1).

Ejercicio 2: Escribir un programa que deforme de manera continua la gráfica de una función (definida en un intervalo) en la gráfica de otra (en otro intervalo, posiblemente distinto).

Ejercicio 3: Representar la envolvente convexa de una colección de puntos en el plano.

Solución Ejercicio 1: El primer Do define la lista de los determinantes y el segundo cuenta las ocurrencias en intervalos de longitud 0.1.

GrafDet[M_,N_]:=Module[
    {lista1,lista2},
    lista1={};
    lista2={};
    
    Do[AppendTo[lista1,
                Det[Table[Random[],{N},{N}]]],
                {M}]; 
        
    Do[AppendTo[lista2,{k,Length[Select[lista1,
            (k<#<k+.1)&]]}],{k,-1,.9,.1}];    
            
    ListPlot[lista1,PlotJoined->True,PlotRange->All]
    
    ListPlot[lista2,PlotRange->All,PlotJoined->True]
    
    ]

GrafDet[100,10]

Solución Ejercicio 2: En la siguiente definición, f y g son las funciones a deformar, definidas respectivamente en los intervalos (a,b) y (c,d), n es el número de gráficas que utilizaremos para la animación y l es la resolución. En la versión Deforma2, dibujamos todas las gráficas juntas.

Deforma[f_,g_,{a_,b_,c_,d_},{n_,l_}]:=
        Module[
        {Listat,Listaf,Listag,Listaf2,Listag2,m,M,A,B},
        A=Min[a,c];
        B=Max[b,d];
        Listaf=N[Table[{a+(b-a) j/l,
            f/.x->a+(b-a) j/l},{j,0,l}]];
        Listag=N[Table[{c+(d-c) j/l,
            g/.x->c+(d-c) j/l},{j,0,l}]];
        Listaf2=Table[Listaf[[j,2]],{j,1,l+1}];
        Listag2=Table[Listag[[j,2]],{j,1,l+1}];
        m=Min[Listaf2,Listag2];
        M=Max[Listaf2,Listag2];
        Do[Listat=Listaf+t(Listag-Listaf)/n;
            ListPlot[Listat,PlotRange->{{A,B},{m,M}},
            PlotJoined->True,AspectRatio->Automatic],
            {t,0,n}]]

Deforma2[f_,g_,{a_,b_,c_,d_},{n_,l_}]:=
        Module[
        {Listat,Listaf,Listag,Listaf2,Listag2,m,M,A,B,
            LisPlo={}},
        A=Min[a,c];
        B=Max[b,d];
        Listaf=N[Table[{a+(b-a) j/l,
            f/.x->a+(b-a) j/l},{j,0,l}]];
        Listag=N[Table[{c+(d-c) j/l,
            g/.x->c+(d-c) j/l},{j,0,l}]];
        Listaf2=Table[Listaf[[j,2]],{j,1,l+1}];
        Listag2=Table[Listag[[j,2]],{j,1,l+1}];
        m=Min[Listaf2,Listag2];
        M=Max[Listaf2,Listag2];
        Do[Listat=Listaf+t(Listag-Listaf)/n;
            AppendTo[LisPlo,
            ListPlot[Listat,PlotRange->{{A,B},{m,M}},
            PlotJoined->True,AspectRatio->Automatic,
            DisplayFunction->Identity]],
            {t,0,n}];
        Show[LisPlo,DisplayFunction->$DisplayFunction]]

Deforma2[x^2,2+Sin[2x],{-1,1,Pi,2Pi},{9,60}]

Solución Ejercicio 3: Primero obtenemos el punto con abcisa menor (y ordenada menor), y a continuación el que forme un ángulo menor . Repetimos el proceso con cada nuevo punto.  La función MinList calcula el par, en una lista de pares, donde se alcanza el vértice que teniendo abcisa menor,  minimiza también la ordenada.  An calcula el ángulo de un segmento. La función MinPen calcula el punto donde la pendiente es menor. Finalmente, EnvCon dibuja la envolvente convexa de la lista de puntos.

MinList[lista_List]:=Module[{m,n,c},
m=Part[lista,1,1];
n=Part[lista,1,2];
c=1;
Do[
If[m>Part[lista,k,1],m=Part[lista,k,1];c=k,
If[And[m==Part[lista,k,1],n>Part[lista,k,2]],
n=Part[lista,k,2];c=k]
],{k,2,Length[lista]}];
Part[lista,c]]

An[{a_,b_},{c_,d_}]:=Module[{an,Na,Nb,Nc,Nd},
Na=N[a];
Nb=N[b];
Nc=N[c];
Nd=N[d];
If[And[Na==Nc,Nb<=Nd],an=0];
If[And[Na==Nc,Nb>Nd],an=Pi];
If[And[Nd==Nb,Nc>Na],an=Pi/2];
If[And[Nd==Nb,Nc<Na],an=3Pi/2];
If[And[Na<Nc,Nd>Nb],an=ArcTan[(c-a)/(d-b)]];
If[Nd<Nb,an=Pi+ArcTan[(c-a)/(d-b)]];
If[And[Nc<Na,Nd>Nb],an=2Pi+ArcTan[(c-a)/(d-b)]];
N[an]
]

MinPen[{a_,b_},lista_List,um_]:=Module[
{mm={},y,min,con,dis,ang,i},
Do[y=Part[lista,v];ang=An[{a,b},y];
AppendTo[mm,ang],
{v,1,Length[lista]}];
i=1;
While[Part[lista,i]=={a,b},i++];
While[mm[[i]]<um,i++];
min=mm[[i]];
dis=(a-Part[lista,i,1])^2+(b-Part[lista,i,2])^2;
con=i;
Do[If[And[mm[[k]]==0,Part[lista,k]!={a,b},
    mm[[k]]>=um],
    min=0;con=k;
dis=(a-Part[lista,k,1])^2+(b-Part[lista,k,2])^2];
If[And[um<=mm[[k]]==min,mm[[k]]!=0,
    dis>(a-Part[lista,k,1])^2+(b-Part[lista,k,2])^2],
    dis=(a-Part[lista,k,1])^2+(b-Part[lista,k,2])^2;
    con=k];
If[And[um<=mm[[k]]<min,mm[[k]]!=0],con=k;min=mm[[k]]],
{k,i,Length[lista]}];
Part[lista,con]
]

EnvCon[lista_List]:=Module[
        {aa,vlist={},pri,enc,enc2,lis,um=0,bb},
        aa=MinList[lista];
        bb=aa;
        pri=aa;
        AppendTo[vlist,aa];
        While[Length[Cases[vlist,pri]]==1,
        um=An[bb,aa];
        bb=aa;
        aa=MinPen[aa,lista,um];
        AppendTo[vlist,aa]
            ];
            
            enc=ListPlot[vlist,
            PlotStyle->{PointSize[.02]},
            DisplayFunction->Identity];
            enc2=ListPlot[vlist,
            PlotJoined->True,
            DisplayFunction->Identity];
            
            lis=ListPlot[lista,DisplayFunction->Identity];
            Show[{enc,enc2,lis},DisplayFunction->$DisplayFunction,
            PlotRange->All,Axes->None]
        ]

ppp=Table[Random[],{200},{2}];
EnvCon[ppp]

     -Graphics-

EnvCon[{{0,0},{0,1},{1,1},{1,0}}]