[Maxima-discuss] Frechet derivative and adjoint Frechet derivative

[YUP <yup...@gm...>]

Dear users,

I would like to share my Maxima code for computing Frechet and adjoint
Frechet derivatives. Background was taken from the book of  Gert
Bauman "Symmetry analysis of differential equations with Mathematica"
https://books.google.pl/books?id=KQjpBwAAQBAJ&pg=PA56&lpg=PA56&dq=frechet+derivative+mathematica&source=bl&ots=EI2fhajCVr&sig=yPChpgYUfEp3jLlF_cQZKagVuLw&hl=uk&sa=X&ved=0ahUKEwjFlNvK3qLLAhXqApoKHUhhDtcQ6AEIMjAC#v=onepage&q=frechet%20derivative%20mathematica&f=false
Please take into account that it is my first adventure with Maxima and
code is far from the ideal. Suggestions and comments are welcome.

Straightforward calculation of Frechet derivative based on definition (3.17):

kill(all);
load('pdiff);

/*
Frechet derivative
U - dependent variables, X - independent variables

Test system:
-u+v_x=0
-u_x/(u^2)+v_y=0

U[1]=u
U[2]=v
X[1]=x
X[2]=y

result:
-w1                                     w2_x
2*w1*u_x/(u^3)-w1_x/(u^2)               w2_y



*/
eqsys(U,X):=[-U[1]+diff(U[2],X[1],1,X[2],0),-diff(U[1],X[1],1,X[2],0)/(U[1]^2)+'diff(U[2],X[1],0,X[2],1)];

UU:[u(x,y),v(x,y)];
WW:[w1(x,y),w2(x,y)];
XX:[x,y];
eqsys(UU,XX);
r:length(UU);
q:length(XX);
FD:genmatrix(FD,r,q);
for i:1 thru r do (
    for j:1 thru q do (

        UU[j]:UU[j]+eps*WW[j],

        FD[i,j]:convert_to_diff(limit(diff(eqsys(UU,XX)[i],eps,1),eps,0)),


        print("FD[",i,j,"]=",FD[i,j]),

        UU[j]:UU[j]-eps*WW[j]

    )
    );
FD;



Calculations of Frechet derivative based on formula (3.18)

kill(all);
load('pdiff);

/*Frechet derivative*/

/*test functions*/
w:[w1(x,t),w2(x,t)];

/*dependent variables*/
uu:[u(x,t),v(x,t)];

/*independent variables*/
xx:[x,t];

/*system*/
ff:[-uu[1]+'diff(uu[2],xx[1],1,xx[2],0),-'diff(uu[1],xx[1],1,xx[2],0)/(uu[1]^2)+'diff(uu[2],xx[1],0,xx[2],1)];

/*maximal order of derivatives*/
maxderiv:3;

/*generation of Frechet derivative matrix*/
FD:genmatrix(FD,length(ff),length(uu));

for mu:1 thru length(ff) do (
    for alpha:1 thru length(uu) do (
        FD[mu,alpha]:diff(ff[mu],uu[alpha],1)*w[alpha],
        for i:1 thru length(xx) do (
            FD[mu,alpha]:FD[mu,alpha]+sum(diff(ff[mu],'diff(uu[alpha],xx[i],J),1)*'diff(w[alpha],xx[i],J),J,1,maxderiv)
            /*print("FD[",mu,",",alpha,"]=",FD[mu,alpha])*/
            )
        )
    );
convert_to_diff(FD);

Calculation of adjoint Frechet derivative based on formula (3.22):

/*Adjoint Frechet derivative*/

kill(all);
load('pdiff);

/*test functions*/
w:[w1(x,t),w2(x,t)];

/*dependent variables*/
dv:[u(x,t),v(x,t)];

/*independent variables*/
iv:[x,t];

/*system*/
/*ff:[-dv[1]+'diff(dv[2],iv[1],1,iv[2],0),
    -'diff(dv[1],iv[1],1,iv[2],0)/(dv[1]^2)+'diff(dv[2],iv[1],0,iv[2],1)];*/
ff:[%i*'diff(dv[1],iv[1],2)-2*dv[1]*dv[2]*'diff(dv[1],iv[1],1),
    -%i*'diff(dv[2],iv[1],2)-2*dv[1]*dv[2]*'diff(dv[2],iv[1],1)];

/*maximal order of derivatives in the system*/
maxderiv:3;

/*generation of Frechet derivative matrix*/
FD:genmatrix(FD,length(ff),length(dv));
for mu:1 thru length(ff) do (
    for alpha:1 thru length(dv) do (
        FD[mu,alpha]:diff(ff[mu],dv[alpha],1)*w[alpha],
        for i:1 thru length(iv) do (
            FD[mu,alpha]:FD[mu,alpha]+
            sum((-1)^J*diff(diff(ff[mu],'diff(dv[alpha],iv[i],J),1)*w[alpha],iv[i],J),J,1,maxderiv)/*,
            print("FD[",mu,",",alpha,"]=",FD[mu,alpha])*/
            )
        )
    );
convert_to_diff(transpose(FD));


Regards,
Yarema