antologia informatico-matematica

Una  biblioteca di programmi di Mathematica. Appunti presi da quaderni di Mathematica n.1

Packages

home#basi#mappa#pigreco#numericiclici#mappacomplessa#cometa#prodotto#radici

#gauss#implicita#integrale#newton#grafica#logica

Plot[x^2,{x,-3,3}]

 

Basi.

Ogni package di Mathematica riportato nel seguito solge il compito assegnato cosi come descritto nell'usage stesso del programma. Viene riportata una nota per l'esigenza di intercalare una nota dell'editor con il testo del programma.#home

BeginPackage["myfrau`basi`"];
cB::usage="cB[n,k] converte un numero in base 10 in un numero in qualsiasi base da 2 a 10.";
rB::usage="rB[lista,k] converte una lista delle cifre di un numero in una base da 2 a 10 in un numero in base 10.";

Begin["`Private`"];
         cB[n_,k_]:=
        Module[{a=n,b={Mod[n,k]},c},
                   While[a>=k,
                            a=Quotient[a,k];
                            c=Mod[a,k];
                            b=Prepend[b,c]];
                                                       b];
         rB[l_List,k_]:=
        Module[{t=Reverse[l]},
                  Sum[k^(i-1)*t[[i]],{i,1,Length[t]}]];
            End[];

  EndPackage[]

 

Mappa.

Mappa complessa rende il grafico su un piano cartesiano dell'applicazione allo stesso di una funzione complessa di variabile complessa.#home

 

carMap[func_,{x0_,x1_,dx_},{y0_,y1_,dy_}]:=
Module[{x,y,coords,lines},
  coords=Table[N[func[x+I y]],{x,x0,x1,dx},{y,y0,y1,dy}];
  coords=Map[{Re[#],Im[#]}&,coords,{2}];
    Show[{Graphics[{RGBColor[1,0,0],
         Map[Line,coords]}],
            Graphics[{RGBColor[0,0,1],
        Map[Line,Transpose[coords]]}]},
                AspectRatio->Automatic,Axes->None]];

 

Pigreco

E' un algoritmo per la ricerca del valore numerico della costante Pigreco.#home

cercaPi[n_]:=
      N[
             2 Sum[Abs[N[
                                     Sqrt[(i^2 (n^2-(i+1)^2))/n^4]-
                                     Sqrt[((i+1)^2 (n^2-i^2))/n^4],

                                10]],
                     {i,0,n-1}],

           10]

 

Numeri ciclici.

Questo algoritmo ricerca i numeri ciclici. I numeri ciclici sono stati usati nel libro sos Contos per costruire la favola Su Vicariu.#home

BeginPackage["myfrau`cicloN`"];

cicloN::usage="cicloN[n] restituisce un numero ciclico
quando n è primo e il periodo di 1/n è di n-1 cifre.";

Begin["`Private`"];

periodo[n_Integer]:=
Module[{k=Mod[10,n]*10},
            b={Quotient[10,n]};
                  If[Not[Mod[n,6]===0],
                     While[Not[k===0||k===10],
                        b=Append[b,Quotient[k,n]];
                        k=Mod[k,n]*10],
                        b={}];b];
                               cicloN[m_Integer]:=
                   If[PrimeQ[m],
                     Module[{per=periodo[m]},
                      If[Not[m==2]&&PrimeQ[m]&&Length[per]==m-1,
                      Print[m," ",per],
                      Print[m," non genera un numero ciclico"]]],
                      Print[m," non genera un numero ciclico"]];

End[];

EndPackage[]

 

Mappa Complessa

Si lavora ancora sulla rappresentazione cartesiana di funzionu complesse di variabile complessa.#home

BeginPackage["myfrau`provamap`"];

MapCar::usage="MapCar[func,{x0,x1,dx},{y0,y1,dy}] rende una mappa a colori della funz. di var. comp. func.";

Begin["`Private`"];

MapCar[func_,{x0_,x1_,dx_},{y0_,y1_,dy_}]:=
Module[{x,y,coords,lines},
coords=Table[N[func[x+I y]],{x,x0,x1,dx},{y,y0,y1,dy}];
coords=Map[{Re[#],Im[#]}&,coords,{2}];
lines=Map[Line,Join[coords,Transpose[coords]]];
Show[Graphics[{RGBColor[1,0,1],lines}],
AspectRatio->Automatic,Axes->Automatic]]

End[];

EndPackage[]

 

Cometa

Il grafico sull'ipotesi di Goldbach.#home

 

BeginPackage["myfrau`cometa`"];
cometa::usage="cometa[n] disegna il grafico delle frequenze con le quali può essere espresso un  numero pari come somma di due numeri primi,";
Begin["`Private`"];

primoQ[n_Integer]:=Apply[Plus,Divisors[n]]==n+1;
numeriPrimi[n_]:=Select[Range[n],primoQ];

KS[l_List,0]:={{}}
KS[l_List,1]:=Partition[l,1]
KS[l_List,k_Integer?Positive]:={l}/;(k==Length[l])
KS[l_List,k_Integer?Positive]:={}/;(k>Length[l])
KS[l_List,k_Integer?Positive]:=
Join[Map[(Prepend[#,First[l]])&,
KS[Rest[l],k-1]],
KS[Rest[l],k]];

radd[n_Integer]:=
Partition[Sort[Flatten[Append[
  numeriPrimi[n],numeriPrimi[n]]]],2];

comb[n_Integer]:=KS[Delete[numeriPrimi[n],1],2];

freq[l_List]:=
   Map[({#,Count[l,#]})&,Union[l]];

cometa[j_Integer]:=
           Module[{b=j},
                 minN[n_Integer]:=n<b;
                     a=Sort[
                           Apply[
                                  Plus,
                                    Partition[
                                           Flatten[
                                                Append[comb[b],radd[b]]],2],2]];
                                         ListPlot[freq[Select[a,minN]],
                  PlotStyle->{PointSize[0.01],RGBColor[1,0,0]}];
          Clear[a]];

     End[];
        EndPackage[]

 

prodotto

La moltiplicazione del contadino russo: un esempio di come lo stesso risultato si ottenga ispiegabilmente seguendo strade molto diverse tra di loro. Non tutti siamo uguali.#home

 

BeginPackage["myfrau`cR`"];

cR::usage="cR[n,m] effettua la moltiplicazione tra n m.";

Begin["`Private`"];

cR[n_Integer,m_Integer]:=
Module[{a=n,b=m,c=0},
  While[a>=1,
   If[OddQ[a],
    c=c+b,
    c=c+0];
   Print[{a,b}];
  b=2 b;
If[OddQ[a],
   a=(a-1)/2,
   a=a/2]];
Print[c]]

End[];

EndPackage[]

 

Radici

Un algoritmo per trovare le radici approssimate delle equazioni.#home

 

BeginPackage["myfrau`cRad`"];

cRad::usage="cRad[funz,iniz,eps] calcola gli zeri approssimati di funz iniziando da iniz con approssimazione epsilon col metodo di Newton.";

Begin["`Private`"];

cRad[funz_,iniz_,eps_]:=
Module[{a=iniz,valfunza=funz[iniz]},
While[Abs[valfunza]>eps,
a=N[a-valfunza/funz'[a]];
valfunza=funz[a]];a]

End[];

EndPackage;

 

Gauss

Il metodo di Gauss per risolvere i sistemi lineari.#home

 

BeginPackage["myfrau`metodogauss`"];
risolvigauss::usage="risolvigauss[matrice orlata]
risolve un sistema lineare";
Begin["`Private`"];
risolvigauss[S_]:=
Module[{E1=First[S],
dax2axn=risolvigauss[eliminax1[S]]},
Module[{b1=Last[E1],
a11=First[E1],
daa12aa1n=Drop[Rest[E1],-1]},
Join[{(b1-daa12aa1n.dax2axn)/a11},dax2axn]]];
risolvigauss[{{a11_,b1_}}]:={b1/a11};
eliminax1[S_]:=Map[sottraiE1[S[[1]],#]&,Rest[S]];
sottraiE1[E1_,Ei_]:=
Module[{z=Ei[[1]]/E1[[1]]},
Module[{nuovoE1=z*Rest[E1]},
Rest[Ei]-nuovoE1]];
End[];
EndPackage[]   

 

implicita

Un modo per rappresentare nel piano le funzioni date in forma implicita.#home

BeginPackage["myfrau`implicitPlot`"];
             implicitPlot::usage="implicitPlot[I°membro=II°membro,{x,x0,x1},{y,y0,y1}],rende il grafico di una funzione data in forma implicita.";

Begin["`Private`"];
               implicitPlot[sinistra_==destra_,xRange_,yRange_]:=
                       ContourPlot[sinistra-destra,xRange,yRange,
                             Contours->{0},
                             PlotPoints->30,
                             ContourShading->False,
                             ContourSmoothing->4]
End[];

EndPackage[]

 

integrale

Un modo per approssimare il valore numerico di un integrale definito.#home

 

BeginPackage["myfrau`intdef`"];
intdef::usage="intdef[fun, valiniz,valfin] calcola l'integrale definito di una funzione fun definita in precedenza."


Begin["`Private`"];

intdef[fun_,valiniz_,valfin_]:=
      Module[{csi=(valfin-valiniz)/1000},
            N[Sum[csi (fun[x]+fun[x+csi])/2,
                {x,valiniz,valfin-csi,csi}],10]];

End[];
EndPackage[]

 

newton

Il metodo di newton.#home

 

BeginPackage["myfrau`newton`"];
newton::usage= "newton[expr,{var,val.iniz}] calcola la radice reale di expr=0 più vicina a valore iniziale.";
Begin["`Private`"];

inUnPasso[expr_,{x_,x0_}]:=
(x-expr/D[expr,x])/.x->N[x0]

newton[expr_,{x_,x0_}]:=
FixedPoint[inUnPasso[expr,{x,#}]&,N[x0]]

End[];
EndPackage[]

 

grafica

un modo per divertirsi con la grafica e le funzioni.#home

 


BeginPackage["myfrau`myplot`"];

myplot::usage="myplot[f,estsin,estdest,w]  rende un grafico a colori della funzione f precedentemente definita in un intervallo della variabile x colorandolo con colori randomizzati e attribuendo ai punti una estensione randomizzata definita da w.";

Begin["`Private`"];

myplot[f_,estsin_,estdes_,w_]:=
       Module[{s=estsin,d=estdes},
          Show[
            Graphics[{
                      Table[{
                            RGBColor[Random[],
                                               Random[],
                                               Random[]],
                      PointSize[Random[]*Abs[w[x]-Ceiling[w[x]]]],
                      Point[{x,f[x]}]},
                     {x,N[s],N[d],0.01}]}],
                      Axes->None,
                       PlotRange->All]];

End[];

EndPackage[]

 

logica

Calcola il valore di verità delle frasi.#home

 

BeginPackage["myfrau`tver`"];
tver::usage="tver[model] rende una tavola di
verità e la funzione equivalente";
Begin["`Private`"];
tver[model_,p_,q_]:=
Module[{a=1<2,b=1>2,c=m===m,d=n===m},
vv=model/.{p->a,q->c};
fv=model/.{p->b,q->c};
vf=model/.{p->a,q->b};
ff=model/.{p->b,q->d};
t=Transpose[{{"vv","fv","vf","ff"},
{vv,fv,vf,ff}}]//ColumnForm;
v=Table[t[[1,i,2]],{i,1,4}];
Which[
v==={True,True,False,True},
Print[model," <=> p->q"],
v==={True,True,True,True},
Print[model," <=> T"],
v==={False,True,True,True},
Print[model," <=> -(p^q)"],
v==={True,False,True,True},
Print[model," <=> q->p"],
v==={True,True,True,False},
Print[model," <=> pvq"],
v==={False,False,True,True},
Print[model," <=> -q"],
v==={False,True,False,True},
Print[model," <=> -p"],
v==={False,True,True,False},
Print[model," <=> -(p<->q)"],
v==={True,False,True,False},
Print[model," <=> p"],
v==={True,True,False,False},
Print[model," <=> q"],
v==={True,False,False,True},
Print[model," <=> p<->q"],
v==={False,False,False,True},
Print[model," <=> -(pvq)"],
v==={False,False,True,False},
Print[model," <=> -(p->q)"],
v==={False,True,False,False},
Print[model," <=> -(q->p)"],
v==={True,False,False,False},
Print[model," <=> p^q"],
v==={False,False,False,False},
Print[model," <=> C"]];t];
End[];
EndPackage;

torna a inizio pagina#home

antologia informatico-matematica