DNN Gel Constitutive Law

SetDirectory[NotebookDirectory[]]

Define exact constitutive law

Import 2d flux definitions

NotebookEvaluate[Directory[] <> "/../../FluxDefinitions2d.nb"];

Import averaged Hessian

<<Hav.mx;

Define reduced Jacobian that gives the momentum flux

M=Table[H[[k]].U[[k]],{k,d}];
Map[TableForm[#]&,M]

Replacement of (Subscript[∇, 𝔽])ℙ with averaged Hessian components

Prules = Flatten[Table[(Subscript[P, i,j])->Hav[[i,j]],{i,(d^2)},{j,(d^2)}]];

MP =Table[M[[k,i,j]] /. Prules,{k,1,d,1},{i,1,d,1},{j,1,d,1}];

Manipulate[MP[[k,i,j]] ,{k,1,d,1},{i,1,d,1},{j,1,d,1}]

Define training data

Define ranges of displacement gradient ∂u/∂a, and increment

minDuDa=-0.2; maxDuDa=0.2; δDuDa=0.1;

Construct 𝔽 input data set

Fdata = Flatten[Table[{FL1,FL2,FL3,FL4,FR1,FR2,FR3,FR4},
{FL1,1+minDuDa,1+maxDuDa, δDuDa},
{FL2,minDuDa,maxDuDa, δDuDa},
{FL3,minDuDa,maxDuDa, δDuDa},
{FL4,1+minDuDa,1+maxDuDa, δDuDa},
{FR1,1+minDuDa,1+maxDuDa, δDuDa},
{FR2,minDuDa,maxDuDa, δDuDa},
{FR3,minDuDa,maxDuDa, δDuDa},
{FR4,1+minDuDa,1+maxDuDa, δDuDa}],7];

Define material parameters

matRules = {AL->0.,DL->0.,muL->2.,AR->0.,DR->0.,muR->2.};

Construct M output data

kDir=1;
Mk=Flatten[MP[[kDir]] /. matRules];

Mdata=Map[ (Mk /. 
{(Subscript[F, L,1])->#[[1]], (Subscript[F, L,2])->#[[2]], (Subscript[F, L,3])->#[[3]], (Subscript[F, L,4])->#[[4]], 
(Subscript[F, R,1])->#[[5]], (Subscript[F, R,2])->#[[6]], (Subscript[F, R,3])->#[[7]], (Subscript[F, R,4])->#[[8]]})&, Fdata];

Dimensions[Mdata]

Construct training data set

nData=Length[Mdata]

FMdata = Table[Fdata[[i]]->Mdata[[i]],{i,nData}];

Networks with single-step dimension reduction

Linear, least-squares approximation

nLayersF=1;  nLayersM=1;
nlmF = Table[{nIn},{n,nLayersF}];
nlmM =Table[{nOut},{n,nLayersM}];
nlmL=NetChain[Flatten[{nlmF,nlmM}]]

nlmLTrained = NetTrain[nlmL,FMdata]

dk=1000;
errors=Table[Norm[nlmLTrained[Fdata[[k]]] - Mdata[[k]]],{k,1,nData,dk}];
ListPlot[errors,PlotLabel->dk Mean[errors]/nData]

Single layer DNN

nLayersF=1;  nLayersM=1;
nlmF = Table[{nIn,LogisticSigmoid},{n,nLayersF}];
nlmM =Table[{nOut,LogisticSigmoid},{n,nLayersM}];
nlmSL=NetChain[Flatten[{nlmF,nlmM}]]

nlmSLTrained = NetTrain[nlmSL,FMdata]

dk=1000;
errors=Table[Norm[nlmSLTrained[Fdata[[k]]] - Mdata[[k]]],{k,1,nData,dk}];
ListPlot[errors,PlotLabel->dk Mean[errors]/nData]

Two layer DNN

nLayersF=2;  nLayersM=2;
nlmF = Table[{nIn,LogisticSigmoid},{n,nLayersF}];
nlmM =Table[{nOut,LogisticSigmoid},{n,nLayersM}];
nlmDL=NetChain[Flatten[{nlmF,nlmM}]]

nlmDLTrained = NetTrain[nlmDL,FMdata]

dk=500;
errors=Table[Norm[nlmDLTrained[Fdata[[k]]] - Mdata[[k]]],{k,1,nData,dk}];
ListPlot[errors,PlotLabel->dk Mean[errors]/nData]

Three layer DNN

nLayersF=3;  nLayersM=3;
nlmF = Table[{nIn,LogisticSigmoid},{n,nLayersF}];
nlmM =Table[{nOut,LogisticSigmoid},{n,nLayersM}];
nlmTL=NetChain[Flatten[{nlmF,nlmM}]]

nlmTLTrained = NetTrain[nlmTL,FMdata]

dk=500;
errors=Table[Norm[nlmTLTrained[Fdata[[k]]] - Mdata[[k]]],{k,1,nData,dk}];
ListPlot[errors,PlotLabel->dk Mean[errors]/nData]

Four layer DNN

nLayersF=4;  nLayersM=4;
nlmF = Table[{nIn,LogisticSigmoid},{n,nLayersF}];
nlmM =Table[{nOut,LogisticSigmoid},{n,nLayersM}];
nlmQL=NetChain[Flatten[{nlmF,nlmM}]]

nlmQLTrained = NetTrain[nlmQL,FMdata]

dk=500;
errors=Table[Norm[nlmQLTrained[Fdata[[k]]] - Mdata[[k]]],{k,1,nData,dk}];
ListPlot[errors,PlotLabel->dk Mean[errors]/nData]

Networks with multiple-step dimension reduction

Three layers per dimension reduction DNN

nLayersF=3;  nLayersT=3; nLayersM=3;
nlmF = Table[{nIn,LogisticSigmoid},{n,nLayersF}];
nlmT = Table[Flatten[Table[{n,LogisticSigmoid},nLayersT]],{n,nIn,nOut,-1}];
nlmM =Table[{nOut,LogisticSigmoid},{n,nLayersM}];
nlmT3L=NetChain[Flatten[{nlmF,nlmT,nlmM}]]

nlmT3LTrained = NetTrain[nlmT3L,FMdata]

dk=1000;
errors=Table[Norm[nlmT3LTrained[Fdata[[k]]] - Mdata[[k]]],{k,1,nData,dk}];
ListPlot[errors,PlotLabel->dk Mean[errors]/nData]

Two layer DNN

nLayersF=2;  nLayersM=2;
nlmF = Table[{nIn,LogisticSigmoid},{n,nLayersF}];
nlmM =Table[{nOut,LogisticSigmoid},{n,nLayersM}];
nlmDL=NetChain[Flatten[{nlmF,nlmM}]]

nlmDLTrained = NetTrain[nlmDL,FMdata]

dk=500;
errors=Table[Norm[nlmDLTrained[Fdata[[k]]] - Mdata[[k]]],{k,1,nData,dk}];
ListPlot[errors,PlotLabel->dk Mean[errors]/nData]

Three layer DNN

nLayersF=3;  nLayersM=3;
nlmF = Table[{nIn,LogisticSigmoid},{n,nLayersF}];
nlmM =Table[{nOut,LogisticSigmoid},{n,nLayersM}];
nlmTL=NetChain[Flatten[{nlmF,nlmM}]]

nlmTLTrained = NetTrain[nlmTL,FMdata]

dk=500;
errors=Table[Norm[nlmTLTrained[Fdata[[k]]] - Mdata[[k]]],{k,1,nData,dk}];
ListPlot[errors,PlotLabel->dk Mean[errors]/nData]

Four layer DNN

nLayersF=4;  nLayersM=4;
nlmF = Table[{nIn,LogisticSigmoid},{n,nLayersF}];
nlmM =Table[{nOut,LogisticSigmoid},{n,nLayersM}];
nlmQL=NetChain[Flatten[{nlmF,nlmM}]]

nlmQLTrained = NetTrain[nlmQL,FMdata]

dk=500;
errors=Table[Norm[nlmQLTrained[Fdata[[k]]] - Mdata[[k]]],{k,1,nData,dk}];
ListPlot[errors,PlotLabel->dk Mean[errors]/nData]