Regole di trasformazione in Mathematica

Giulio C. Barozzi
Università di Bologna

[Revisione: luglio 2001]

Clear["Global`*"]

Regole di trasformazione immediata e differita

Abbiamo visto in precedenza le regole di assegnazione immediata e differita.Abbiamo analogamente regole di trasformazione immediata e regole di trasformazione differita. 
Consideriamo un'espressione contenente due lettere:

Clear[a, b]; 
cubo = a^3 + 3*a^3*b + 3*a*b^2 + b^3

Dato che cubo non è stato definito come una funzione, è utile un meccanismo per calcolarla in corrispondenza di certi valori di a e b. Ecco il meccanismo (regola di sostituzione immediata):

cubo/.a -> 3

Si osservi che la variabile a non è stata “istanziata" (cioè non le è stato assegnato il valore 3):

a

Possiamo eseguire più sostituzioni in parallelo:

cubo/.{a -> 3, b -> 5}

In generale abbiamo
espressione1 /. espressione2 -> espressione3
o una lista di sostituzioni a destra del simbolo  -> . L'ordine delle azioni compiute dal kernel è
1) valutare espressione1
2) valutare expressione2
3) sostituire ogni occorrenza espressione2 nella forma valutata di espressione1 (se ce ne sono) con espressione3.
Esempio:

3x+3x/.x -> 5

Altro esempio. Cominciamo con l'esaminare le funzione Table e Random:

Table[x, {3}]

Random[]

Random[]

Ad ogni chiamata della funzione Random si ha un diverso numero pseudo-casuale. Ed ora:

Table[x,{3}]/.x -> Random[]

Table[x,{3}]/.x -> Random[]

Si ottiene una terna di tre numeri uguali tra loro, ma una diversa terna ad ogni chiamata. Questo perché:
1)  viene costruita la lista {x, x, x}
2)  viene valutata l'espressione Random[ ] 
3)  ogni occorrenza di  x  viene sostituita dal numero appena calcolato.
Vi è un'altra regola di sostituzione, in cui la valutazione dell'espressione3 viene fatta alla fine. La sintassi è:
espressione1 /. espressione2 : > espressione3
con la freccia -> sostituita da :>. 
Ad esempio

Table[x,{3}]/.x :> Random[]

Questo perché:
1) viene costruita la lista  {x, x, x} 
2)  x viene sostituito da  Random[ ] dando luogo alla lista
{ Random[ ], Random[ ], Random[ ] }
 3) ogni occorrenza di Random[ ] viene valutata, generando ogni volta un diverso numero random.
Altro esempio (senza spiegazione):

Range[5]/. a_ -> N[Log[a]]

Range[5]/. a_ :> N[Log[a]]

Regola di trasformazione immediata: l'algoritmo euclideo per il MCD

Clear["Global`*"]

Cominciamo da una trasformazione immediata:

r = ({a_,b_}/; b > 0) -> {b, Mod[a,b]}

Spiegazione: alla coppia {a, b} (purché b sia positivo) sostituisci la coppia 
{b, resto della divisione di a per b}.
Non è difficile riconoscere l'algoritmo euclideo per il calcolo del MCD. In effetti possiamo usare il comando //. (sostituzione ripetuta) per ottenere il MCD:

mcdr1[a_,b_] := First[{a,b}//.r]

mcdr1[13, 26]

mcdr1[123, 124]

Posso inglobare la regola di trasfomazione nella funzione:

mcdr2[a_,b_] := 
First[{a,b}//.({n_,m_}/; m > 0) -> {m, Mod[n,m]}]

mcdr2[89,144]

Regola di trasformazione immediata: il "falso quadrato"

fq = a_.x_^2 + b_.x_ -> a(x+b/(2a))^2-b^2/(4a)

Spiegazione: tutte le volte che si incontra un'espressione del tipo "un monomio di secondo grado più un monomio di primo grado in una certa lettera" sostituirla con l'espressione ecc. ecc. Si osservi che i coefficienti dei due monomi possono anche non comparire esplicitamente: in tal caso essi vengono assunti uguali a 1 (questo è il valore di default di una variabile seguita da _.  quando essa è un fattore di un prodotto.
Esempi:

t^2 + t /.fq

Expand[%]

2 t^2 + 3 t /.fq

2 x^2 + x /.fq

Regola di trasformazione immediata:
il calcolo proposizionale

ClearAll["Global`*"]

Definiamo, sotto forma di funzioni polinomiali, i connettivi logici usuali:

non[p_]:= 1 + p

et[p_,q_]:= p q

vel[p_,q_]:= p + q + p q

seq[p_,q_]:= 1 + p + p q

aeq[p_,q_]:= 1 + p + q

S'intende che p e q sono variabili "booleane", cioè assumono i valori 0 (falso) e 1 (vero). esse vengono moltiplicate e sommate in aritmetica binaria, cioè modulo 2.
Costruiamo, a mo' di verifica, le tabelle di verità dei connettivi sopra definiti:

Table[{p,PolynomialMod[non[p],2]}, {p,0,1}];

MatrixForm[%]

Table[{p,q,PolynomialMod[et[p,q],2]}, {p,0,1},{q,0,1}];
Reverse[Flatten[%,1]];
MatrixForm[%]

Table[{p,q,PolynomialMod[vel[p,q],2]}, {p,0,1},{q,0,1}];
Reverse[Flatten[%,1]];
MatrixForm[%]

Table[{p,q,PolynomialMod[seq[p,q],2]}, {p,0,1},{q,0,1}];
Reverse[Flatten[%,1]];
MatrixForm[%]

Table[{p,q,PolynomialMod[aeq[p,q],2]}, {p,0,1},{q,0,1}];
Reverse[Flatten[%,1]];
MatrixForm[%]

Definiamo la seguente regola di sostituzione: ogni potenza del tipo  x^n  (dove x è una qualunque lettera ed n un esponente naturale) deve essere sostituita della lettera x stessa. 
In altri termini: ogni potenza viene sostituita con la base della potenza stessa.

sost := x_^n_ -> x

Un esempio di applicazione:

1+ x^2 + y^3

%/.sost

Il modus ponens:

mp = seq[et[p,seq[p,q]],q]

Expand[%]

%/.sost

Riduciamo i coefficienti del polinomio ottenuto modulo 2:

PolynomialMod[%,2]

Conclusione: il modus ponens è una tautologia

Scriviamo una funzione di riduzione:

rid[pol_]:=
PolynomialMod[Expand[pol]/.sost,2]

Ad esempio:

rid[mp]

Altro esempio (reductio ad absurdum):

aeq[seq[p,q], seq[non[q], non[p]]]

rid[%]

Vogliamo verificare se (p et q) -> r è equivalente a  (p et non r ) -> non q.

prop1 = seq[et[p,q], r]

prop2 = seq[et[p,non[r]],non[q]]

rid[prop2]

Dunque prop1 e prop2 sono equivalenti.

Consideriamo un ulteriore connettivo modificando la quarta riga della tabella di verità di seq:

seq1[p_,q_]:= q

Table[{p,q,q}, {p,0,1},{q,0,1}];
Reverse[Flatten[%,1]];
MatrixForm[%]

Scriviamo il modus ponens sostituendo seq con seq1:

mp2 = seq1[et[p,seq1[p,q]],q]

Non abbiamo una tautologia.
Modifichiamo la terza e la quarta riga della tabella di verità di seq:

imp[p_,q_]:=p(1 + p + p q)

Table[{p,q,PolynomialMod[imp[p,q],2]}, {p,0,1},{q,0,1}];
Reverse[Flatten[%,1]];
MatrixForm[%]

imp[et[p,imp[p,q]],q]

rid[%]

Regola di trasformazione differita: la derivazione dei polinomi

Le funzioni non sono altro che regole di trasformazione differita in cui intervengono variabili (lettere seguite dal trattino di sottolineatura).
Supponiamo di voler insegnare a Mathematica  le regole di derivazione dei polinomi (fingendo di non saper che le conosce benissimo).

La derivata della somma è la somma delle derivate:

dp[p_ + q_, x_] := dp[p,x] + dp[q,x]

La derivata di una costante (rispetto alla variabile di derivazione) per una funzione è uguale alla costante per la derivata della funzione:

dp[c_ p_, x_] := c dp[p,x]/; FreeQ[c, x]

La scrittura  /; FreeQ[c, x] significa "a patto che l'espressione c non contenga x".

La derivata di una costante è 0:

dp[c_, x_] := 0/;FreeQ[c, x]

La derivata della variabile rispetto a se stessa è 1:

dp[x_, x_] := 1

La derivata di un monomio con esponente positivo è uguale all'esponente per il monomio con l'esponente diminuito di un'unità:

dp[x_^n_Integer?Positive, x_] := n x^(n-1)

Esempio:

pol =  4 x^2 + a x + 3 + y^5 t

dp[pol, x]

dp[pol, y]

dp[pol,  a]

Regola di trasformazione differita: modificazione di poligoni nel piano e nello spazio

Consideriamo la seguente regola di sostituzione:

mp = Polygon[x_]:>Polygon[(x+RotateLeft[x])/2]

Poiché x sta al posto della lista dei vertici, l'operazione indicata a secondo membro sostituisce ad una lista di vertici la lista costituita dai punti medi dei lati. Ad esempio

vertici = {{0,0}, {3,1}, {7/2, 3}, {1/2, 3}};

(% + RotateLeft[%])/2

In termini grafici:

Show[Graphics[{GrayLevel[0.8], Polygon[vertici]}],
Axes -> True, AxesOrigin -> {0,0},
AspectRatio -> Automatic];

Show[Graphics[{GrayLevel[0.8], Polygon[vertici]/.mp}],
Axes -> True, AxesOrigin -> {0,0},
AspectRatio -> Automatic];

Show[Graphics[{GrayLevel[0.8], Polygon[vertici]/.mp/.mp}],
Axes -> True, AxesOrigin -> {0,0},
AspectRatio -> Automatic,
Ticks -> {{0,1,2},{0,1,2}}];

La funzione ParametricPlot3D utilizza la primitiva Polygon (nello spazio); possiamo utilizzare la regola di trasformazione mp per costruire dei grafici semi-trasparenti.

cilindro = ParametricPlot3D[{Cos[t],Sin[t],u},
 {t,0,2Pi},{u,0,1},PlotPoints -> {20,10}];

Show[cilindro/.mp/.mp];

cono = ParametricPlot3D[{u Cos[t],u Sin[t],u},
 {t,0,2Pi},{u,0.2,1},
 PlotPoints->{20,10}];

piano = Polygon[
     {{1,-1,0.2},{1,1,0.2},{-1,1,.9},{-1,-1,.9}}];

Show[{Graphics3D[piano], cono/.mp/.mp},
BoxRatios -> {1.5,1.5,1},
ViewPoint -> {1.5, -3., 1.121}];

ParametricPlot3D[{x,y,x^2+Sin[y^2]},
{x,-1,1}, {y,-1,1}];

Show[%/.mp/.mp];