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}]
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 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]];
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]
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[]
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[]
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[]
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[]
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;
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[]
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[]
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[]
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[]
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[]
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