Covid-19 Case Fitting Curves
Esmerindo Bernardes
sousa@ifsc.usp.br
04/2020 - 05/2021 - 07/2022 - 05/2023

Model function

Accumulated cases: a linear superposition of hyperbolic tangents 
where each hyperbolic tangent describes one wave.

(Subscript[Z, N])(n)=(∑_(i=1)^l)(Subscript[b, i])tanh((Subscript[a, i])n-(Subscript[c, i]))+δ

Cases per week: first derivative of a linear superposition of hyperbolic tangents.

(Subscript[ℨ, N])(n)=(∑_(i=1)^l)(((Subscript[a, i])(Subscript[b, i]))/((cosh^2)((Subscript[a, i])n-(Subscript[c, i]))))

Routines

Model functions

cshn[z_,a_,b_,c_]:=Sum[a[[i]]*b[[i]]/Cosh[a[[i]]*z-c[[i]]]^2,{i,1,Length[a]}]

RMS

RMS[R_,n_,m_]:=Sqrt[Sum[FR[[i]]^2,{i,1,n}]/(n-m)]

Joined parameters

Tabc[aux1_,aux2_,l1_,l2_]:=Join[aux1[[1;;l1]],Table[{(Subscript[a, i+l1]),aux2[[i,2]]},{i,1,l2}],aux1[[l1+1;;2*l1]],Table[{(Subscript[c, i+l1]),aux2[[i+l2,2]]},{i,1,l2}],aux1[[2*l1+1;;3*l1]],Table[{(Subscript[b, i+l1]),aux2[[i+2*l2,2]]},{i,1,l2}]]

Data

Data import (output from Maple).
n (week)
ac (accumulated contamination)
ad (accumulated death)
av (accumulated vaccine)
cw (contamination per week)
dw (death per week)
vw (vaccine per week)

DataBR=Import["D:\\sousa\\Covid19\\GnuPlot\\CovidBR.txt",{"Data"}] //Short

nBR=Length[DataBR[[1]]]

Contamination

DataAll=DataBR

n=nBR

Data=Table[DataAll[[1,i,5]],{i,1,n}];

Datab=Table[{i,DataAll[[1,i,5]]},{i,1,n}];

gc=BarChart[Data,ImageSize->800,ImagePadding->60,BarSpacing->Large,ChartLabels->Table[i,{i,1,n}],ChartStyle->Blue,Frame->{True,True,False,False},FrameTicks->False,PlotRange->{{0,210},{0,1.6*(10^6)}}];

gc

Deaths

Data=Table[DataAll[[1,i,6]],{i,1,n}];

Datab=Table[{i,DataAll[[1,i,6]]},{i,1,n}];

gd=BarChart[Data,ImageSize->800,ImagePadding->60,BarSpacing->Large,ChartLabels->Table[i,{i,1,n}],ChartStyle->Blue,Frame->{True,True,False,False},FrameTicks->False,PlotRange->{{0,140},{0,24*(10^3)}}];

gd

Contaminations

First part

n1= 96 (*BR*)

Data1=Table[DataAll[[1,i,5]],{i,1,n1}];

Data1b=Table[{i,DataAll[[1,i,5]]},{i,1,n1}];

l1=10

mf1=cshn[z,Table[(Subscript[a, i]),{i,1,l1}],Table[(Subscript[b, i]),{i,1,l1}],Table[(Subscript[c, i]),{i,1,l1}]];

Pars1=Join[Table[(Subscript[a, i]),{i,1,l1}],Table[(Subscript[c, i]),{i,1,l1}],Table[(Subscript[b, i]),{i,1,l1}]];

Cons1=Join[Table[0.01<(Subscript[a, i])<0.96,{i,1,l1}],Table[1<(Subscript[c, i])<80,{i,1,l1}],Table[(10^1)<(Subscript[b, i])<(10^7),{i,1,l1}],Table[(Subscript[c, i])/(Subscript[a, i])<n1,{i,1,l1}]];

Cons1=Join[Table[0.01<(Subscript[a, i])<0.6,{i,1,l1}],Table[0.1<(Subscript[c, i])<80,{i,1,l1}],Table[(10^1)<(Subscript[b, i])<(10^7),{i,1,l1}],Table[0<(Subscript[c, i])/(Subscript[a, i])<n1+4,{i,1,l1}]];

{t0,lsf1}=AbsoluteTiming[NonlinearModelFit[Data1,{mf1,Cons1},Pars1,{z},MaxIterations->60000]]; t0

FR=lsf1["FitResiduals"];
lsf1["EstimatedVariance",VarianceEstimatorFunction->(RMS[#,n1,3*l1]&)]

Plot[lsf1[i],{i,1,n1+4},PlotStyle->{Red,Thick},PlotRange->Full,Epilog->Point[Data1b]]

pars1=lsf1["BestFitParameters"]

{(Subscript[a, 1])->0.34021560276398`,(Subscript[a, 2])->0.18365561466844585`,(Subscript[a, 3])->0.599387552917628`,(Subscript[a, 4])->0.21232184323617703`,(Subscript[a, 5])->0.11592628454961819`,(Subscript[a, 6])->0.1852184686874211`,(Subscript[a, 7])->0.36328108033834133`,(Subscript[a, 8])->0.2655525613171134`,(Subscript[a, 9])->0.06788533127270235`,(Subscript[a, 10])->0.6000000099997532`,(Subscript[c, 1])->14.21644649910547`,(Subscript[c, 2])->10.34519280976851`,(Subscript[c, 3])->41.648874859162625`,(Subscript[c, 4])->3.513794155803186`,(Subscript[c, 5])->3.7316961389351393`,(Subscript[c, 6])->4.393707527126317`,(Subscript[c, 7])->17.250953225533554`,(Subscript[c, 8])->17.311967590219375`,(Subscript[c, 9])->4.9277713590183785`,(Subscript[c, 10])->44.37237274108177`,(Subscript[b, 1])->663144.4164750094`,(Subscript[b, 2])->2.356167880322695`*^6,(Subscript[b, 3])->391790.56452744553`,(Subscript[b, 4])->674253.825370191`,(Subscript[b, 5])->1.1809796140324108`*^6,(Subscript[b, 6])->1.2087077316876717`*^6,(Subscript[b, 7])->730228.6631671429`,(Subscript[b, 8])->810107.1170989581`,(Subscript[b, 9])->3.097326988746786`*^6,(Subscript[b, 10])->133014.89787129784`}

Pars1=Join[Table[{(Subscript[a, i]),(Subscript[a, i])/.pars1},{i,1,l1}],Table[{(Subscript[c, i]),(Subscript[c, i])/.pars1},{i,1,l1}],Table[{(Subscript[b, i]),(Subscript[b, i])/.pars1},{i,1,l1}]]

Pars1BR={{(Subscript[a, 1]),0.3442544314568885`},{(Subscript[a, 2]),0.06265025791695183`},{(Subscript[a, 3]),0.11751913671825302`},{(Subscript[a, 4]),0.3695226437922263`},{(Subscript[a, 5]),0.19378419843330846`},{(Subscript[a, 6]),0.29894114249384784`},{(Subscript[a, 7]),0.18752557321622793`},{(Subscript[a, 8]),0.21221509339360087`},{(Subscript[a, 9]),0.5971713010553253`},{(Subscript[a, 10]),0.9600000099999672`},{(Subscript[c, 1]),14.38120931929726`},{(Subscript[c, 2]),4.351620378460686`},{(Subscript[c, 3]),3.7478183168053985`},{(Subscript[c, 4]),17.54671424061865`},{(Subscript[c, 5]),10.903826746993905`},{(Subscript[c, 6]),19.457759706853334`},{(Subscript[c, 7]),4.446031475614506`},{(Subscript[c, 8]),3.516623652679805`},{(Subscript[c, 9]),41.47475464006512`},{(Subscript[c, 10]),71.06632302071381`},{(Subscript[b, 1]),633664.3243725311`},{(Subscript[b, 2]),4.0044840715635186`*^6},{(Subscript[b, 3]),1.135564175304713`*^6},{(Subscript[b, 4]),686639.3094733317`},{(Subscript[b, 5]),1.9440307014502825`*^6},{(Subscript[b, 6]),549142.436488662`},{(Subscript[b, 7]),1.178598948495137`*^6},{(Subscript[b, 8]),680689.1254867393`},{(Subscript[b, 9]),370152.93649694487`},{(Subscript[b, 10]),79019.55848215359`}}

Go Maple!

ParsMaple=Join[Table[(Subscript[a, i])/.pars1,{i,1,l1}],Table[(Subscript[c, i])/.pars1,{i,1,l1}],Table[(Subscript[b, i])/.pars1,{i,1,l1}]];

Export["D:\\sousa\\Covid19\\GnuPlot\\ParsBRp1.txt",ParsMaple,"CSV"];

gf1=Plot[{lsf1[i]},{i,1,n1+12},PlotRange->{{0,200},{0,1.6*(10^6)}},PlotStyle->{Magenta},GridLines->Automatic,Frame->True,ImageSize->800,ImagePadding->60,PlotLegends->Placed[{"(Subscript[𝒵, a])(n)"},Below],FrameLabel->{{"Contamination/week",None},{"n (week)",None}}];

gfc1=Overlay[{gf1,gc}]

Second part

n2=96

n3=153

Data2=Table[Data[[i]],{i,n2,n3}];

Data2b=Table[{i,Data[[i]]},{i,n2,n3}];

l1=10

l2=6

mf2=cshn[z,Table[(Subscript[a, i]),{i,l1+1,l1+l2}],Table[(Subscript[b, i]),{i,l1+1,l1+l2}],Table[(Subscript[c, i]),{i,l1+1,l1+l2}]];

Pars2=Join[Table[(Subscript[a, i]),{i,l1+1,l1+l2}],Table[(Subscript[c, i]),{i,l1+1,l1+l2}],Table[(Subscript[b, i]),{i,l1+1,l1+l2}]]

Cons2=Join[Table[0.01<(Subscript[a, i])<0.9,{i,l1+1,l1+l2}],Table[1<(Subscript[c, i])<80,{i,l1+1,l1+l2}],Table[(10^1)<(Subscript[b, i])<(10^7),{i,l1+1,l1+l2}]];

Cons2=Join[Table[0.01<(Subscript[a, i])<0.6,{i,l1+1,l1+l2}],Table[0.1<(Subscript[c, i])<60,{i,l1+1,l1+l2}],Table[(10^1)<(Subscript[b, i])<(10^7),{i,l1+1,l1+l2}],Table[1<(Subscript[c, i])/(Subscript[a, i])<n3+4,{i,l1+1,l1+l2}]];

{t0,lsf2}=AbsoluteTiming[NonlinearModelFit[Data2,{mf2,Cons2},Pars2,{z},MaxIterations->60000]]; t0

{t0,lsf2}=AbsoluteTiming[NonlinearModelFit[Data2,{mf2,Cons2},Pars2,{z},Method->{"NMinimize",Method->{"NelderMead","ContractRatio"->0.5,"ExpandRatio"-> 2,"ReflectRatio"->1,"ShrinkRatio"->0.5, "RandomSeed"-> 0}}]]; t0

FR=lsf2["FitResiduals"];
lsf2["EstimatedVariance",VarianceEstimatorFunction->(RMS[#,n3-n2+1,3*l2]&)]

Plot[lsf2[i-n2+1],{i,n2-2,n3+2},PlotStyle->{Red,Thick},PlotRange->Full,Epilog->Point[Data2b]]

pars2=lsf2["BestFitParameters"]

{(Subscript[a, 11])->0.1174148402688292`,(Subscript[a, 12])->0.3559202014274435`,(Subscript[a, 13])->0.6000000099999976`,(Subscript[a, 14])->0.487113079987704`,(Subscript[a, 15])->0.2539487635454348`,(Subscript[a, 16])->0.3470700696276073`,(Subscript[c, 11])->3.270402947873767`,(Subscript[c, 12])->4.641247715944888`,(Subscript[c, 13])->5.530858632325461`,(Subscript[c, 14])->3.0475613371110413`,(Subscript[c, 15])->13.288225956137694`,(Subscript[c, 16])->10.002224478846516`,(Subscript[b, 11])->1.7631013052131534`*^6,(Subscript[b, 12])->604055.2178172288`,(Subscript[b, 13])->662169.0675293418`,(Subscript[b, 14])->2.656442363393395`*^6,(Subscript[b, 15])->1.0345024377270349`*^6,(Subscript[b, 16])->631309.9868757344`}

Pars2=Join[Table[{(Subscript[a, i]),(Subscript[a, i])/.pars2},{i,l1+1,l1+l2}],Table[{(Subscript[c, i]),(Subscript[c, i])/.pars2},{i,l1+1,l1+l2}],Table[{(Subscript[b, i]),(Subscript[b, i])/.pars2},{i,l1+1,l1+l2}]]

Go Maple!

ParsMaple2=Join[Table[(Subscript[a, i+l1])/.pars2,{i,1,l2}],Table[(Subscript[c, i+l1])/.pars2,{i,1,l2}],Table[(Subscript[b, i+l1])/.pars2,{i,1,l2}]];

Export["D:\\sousa\\Covid19\\GnuPlot\\ParsBRp2.txt",ParsMaple2,"CSV"];

gf2=Plot[{lsf2[i-n2+1]},{i,n2-8,n3+8},PlotRange->{{0,200},{0,1.6*(10^6)}},PlotStyle->{Red},GridLines->Automatic,Frame->True,ImageSize->800,ImagePadding->60,PlotLegends->Placed[{"(Subscript[𝒵, b])(n)"},Below],FrameLabel->{{"Contamination/week",None},{"n (week)",None}}];

gfc2=Overlay[{gf2,gc}]

gf12=Plot[{lsf1[i],lsf2[i-n2+1]},{i,1,n3+8},PlotRange->{{0,200},{0,1.6*(10^6)}},PlotStyle->{Magenta,Red},GridLines->Automatic,Frame->True,ImageSize->800,ImagePadding->60,PlotLegends->Placed[{"(Subscript[𝒵, a])(n)","(Subscript[𝒵, b])(n)"},Below],FrameLabel->{{"Contamination/week",None},{"n (week)",None}}];

gfc12=Overlay[{gf12,gc}]

Third part

n

n2=96

n3=153

Data3=Table[Data[[i]],{i,n3,n}];

Data3b=Table[{i,Data[[i]]},{i,n3,n}];

l1=10

l2=6

l3=6

lt=l1+l2+l3

mf3=cshn[z,Table[(Subscript[a, i]),{i,l1+l2+1,lt}],Table[(Subscript[b, i]),{i,l1+l2+1,lt}],Table[(Subscript[c, i]),{i,l1+l2+1,lt}]]

Pars3=Join[Table[(Subscript[a, i]),{i,l1+l2+1,lt}],Table[(Subscript[c, i]),{i,l1+l2+1,lt}],Table[(Subscript[b, i]),{i,l1+l2+1,lt}]];

Cons3=Join[Table[0.01<(Subscript[a, i])<0.5,{i,l1+l2+1,lt}],Table[0.1<(Subscript[c, i])<80,{i,l1+l2+1,lt}],Table[(10^4)<(Subscript[b, i])<(10^6),{i,l1+l2+1,lt}],Table[(Subscript[c, i])/(Subscript[a, i])<n+4,{i,l1+l2+1,lt}]];

{t0,lsf3}=AbsoluteTiming[NonlinearModelFit[Data3,{mf3,Cons3},Pars3,{z},MaxIterations->80000]]; t0

{t0,lsf3}=AbsoluteTiming[NonlinearModelFit[Data3,{mf3,Cons3},Pars3,{z},Method->{"NMinimize"}]]; t0

{t0,lsf3}=AbsoluteTiming[NonlinearModelFit[Data3,{mf3,Cons3},Pars3,{z},Method->{"NMinimize",Method->{"SimulatedAnnealing"}}]]; t0

{t0,lsf3}=AbsoluteTiming[NonlinearModelFit[Data3,{mf3,Cons3},Pars3,{z},Method->{"NMinimize",Method->{"DifferentialEvolution"}}]]; t0

{t0,lsf3}=AbsoluteTiming[NonlinearModelFit[Data3,{mf3,Cons3},Pars3,{z},Method->{"NMinimize",Method->{"NelderMead"}}]]; t0

{t0,lsf3}=AbsoluteTiming[NonlinearModelFit[Data3,{mf3,Cons3},Pars3,{z},Method->{"NMinimize",Method->{"NelderMead","ContractRatio"->0.5,"ExpandRatio"-> 2,"ReflectRatio"->1,"ShrinkRatio"->0.5, "RandomSeed"-> 3}}]]; t0

FR=lsf3["FitResiduals"];
lsf3["EstimatedVariance",VarianceEstimatorFunction->(RMS[#,n-n3+1,3*l3]&)]

Plot[lsf3[i-n3+1],{i,n3-2,n+3},PlotStyle->{Red,Thick},PlotRange->{Full,{-20000,8*(10^4)}},Epilog->Point[Data3b]]

pars3=lsf3["BestFitParameters"]

{(Subscript[a, 17])->0.05259018903730917`,(Subscript[a, 18])->0.4248970206553723`,(Subscript[a, 19])->0.5000000099999989`,(Subscript[a, 20])->0.409809079436609`,(Subscript[a, 21])->0.11684692597294524`,(Subscript[a, 22])->0.5000000099999995`,(Subscript[c, 17])->2.9635608321029325`,(Subscript[c, 18])->0.5934672438955724`,(Subscript[c, 19])->30.50195364635578`,(Subscript[c, 20])->3.0499212449457205`,(Subscript[c, 21])->1.2729408870193393`,(Subscript[c, 22])->20.049524548135505`,(Subscript[b, 17])->629569.49960185`,(Subscript[b, 18])->147781.62005191733`,(Subscript[b, 19])->1.0000000000998992`*^6,(Subscript[b, 20])->59265.29999894921`,(Subscript[b, 21])->352150.6546609944`,(Subscript[b, 22])->57737.01417100171`}

{(Subscript[a, 17])->0.5`,(Subscript[a, 18])->0.1950922974053174`,(Subscript[a, 19])->0.24760795038853178`,(Subscript[a, 20])->0.45960907062158396`,(Subscript[a, 21])->0.18630193324026556`,(Subscript[a, 22])->0.05288236739435117`,(Subscript[c, 17])->71.01886674722282`,(Subscript[c, 18])->1.6849523651720035`,(Subscript[c, 19])->11.21344381301426`,(Subscript[c, 20])->0.5588045382572836`,(Subscript[c, 21])->25.88167897170759`,(Subscript[c, 22])->0.4103325757414098`,(Subscript[b, 17])->487110.9677730558`,(Subscript[b, 18])->161433.40892857817`,(Subscript[b, 19])->910147.9490974662`,(Subscript[b, 20])->106365.42373089133`,(Subscript[b, 21])->253240.1041622933`,(Subscript[b, 22])->495072.7065197839`}

{(Subscript[a, 17])->0.16305472151867859`,(Subscript[a, 18])->0.26104937388046123`,(Subscript[a, 19])->0.3539217259281477`,(Subscript[a, 20])->0.11217348209463326`,(Subscript[a, 21])->0.3149144667485326`,(Subscript[a, 22])->0.11929171880148229`,(Subscript[c, 17])->18.494907070954756`,(Subscript[c, 18])->50.51954467139468`,(Subscript[c, 19])->49.39774755727376`,(Subscript[c, 20])->1.0347818899375927`,(Subscript[c, 21])->0.1`,(Subscript[c, 22])->4.963783148920079`,(Subscript[b, 17])->264900.1096874074`,(Subscript[b, 18])->140837.77371690777`,(Subscript[b, 19])->591901.154688666`,(Subscript[b, 20])->465989.40727218677`,(Subscript[b, 21])->178709.97264323078`,(Subscript[b, 22])->267044.6238703088`}

{(Subscript[a, 17])->0.05106535775310851`,(Subscript[a, 18])->0.29144690900730263`,(Subscript[a, 19])->0.43417300919747115`,(Subscript[a, 20])->0.12018508267875898`,(Subscript[a, 21])->0.5387338333137469`,(Subscript[a, 22])->0.6`,(Subscript[c, 17])->2.198571586091153`,(Subscript[c, 18])->45.74811732067876`,(Subscript[c, 19])->52.89692730469241`,(Subscript[c, 20])->1.0012090332581143`,(Subscript[c, 21])->0.7145377087060496`,(Subscript[c, 22])->25.0841617968805`,(Subscript[b, 17])->320761.8367953987`,(Subscript[b, 18])->234014.4706722478`,(Subscript[b, 19])->624071.5407899718`,(Subscript[b, 20])->450970.477863821`,(Subscript[b, 21])->91558.84461164151`,(Subscript[b, 22])->350944.046357481`}

{(Subscript[a, 17])->0.14977211619776876`,(Subscript[a, 18])->0.3001729728670107`,(Subscript[a, 19])->0.38465958542850825`,(Subscript[a, 20])->0.18670861777962097`,(Subscript[a, 21])->0.076621252519706`,(Subscript[a, 22])->0.06519976931349596`,(Subscript[c, 17])->6.612159057874141`,(Subscript[c, 18])->44.44050411384107`,(Subscript[c, 19])->44.26419431588458`,(Subscript[c, 20])->20.240159154036018`,(Subscript[c, 21])->0.1`,(Subscript[c, 22])->0.22843516172832784`,(Subscript[b, 17])->380537.3971346515`,(Subscript[b, 18])->227450.53954509864`,(Subscript[b, 19])->510242.7397772788`,(Subscript[b, 20])->503848.11399058707`,(Subscript[b, 21])->361742.85256340884`,(Subscript[b, 22])->568240.9051427492`}

Pars3=Join[Table[{(Subscript[a, i]),(Subscript[a, i])/.pars3},{i,l1+l2+1,lt}],Table[{(Subscript[c, i]),(Subscript[c, i])/.pars3},{i,l1+l2+1,lt}],Table[{(Subscript[b, i]),(Subscript[b, i])/.pars3},{i,l1+l2+1,lt}]]

Go Maple!

ParsMaple3=Join[Table[(Subscript[a, i+l1+l2])/.pars3,{i,1,l3}],Table[(Subscript[c, i+l1+l2])/.pars3,{i,1,l3}],Table[(Subscript[b, i+l1+l2])/.pars3,{i,1,l3}]];

Export["D:\\sousa\\Covid19\\GnuPlot\\ParsBRp3.txt",ParsMaple3,"CSV"];

gf3=Plot[{lsf3[i-n3+1]},{i,n3-32,n+4},PlotRange->{{0,200},{0,1.6*(10^6)}},PlotStyle->{Black},GridLines->Automatic,Frame->True,ImageSize->800,ImagePadding->60,PlotLegends->Placed[{"(Subscript[𝒵, c])(n)"},Below],FrameLabel->{{"Contamination/week",None},{"n (week)",None}}];

gfc3=Overlay[{gf3,gc}]

gf123=Plot[{lsf1[i],lsf2[i-n2+1],lsf3[i-n3+1]},{i,1,n+4},PlotRange->{{0,200},{0,1.6*(10^6)}},PlotStyle->{Magenta,Red,Black},GridLines->Automatic,Frame->True,ImageSize->800,ImagePadding->60,PlotLegends->Placed[{"(Subscript[𝒵, a])(n)","(Subscript[𝒵, b])(n)","(Subscript[𝒵, c])(n)"},Below],FrameLabel->{{"Contamination/week",None},{"n (week)",None}}]

gfc123=Overlay[{gf123,gc}]

gfc123=Overlay[{gf1,gf2,gf3,gc}]

Joint parameters

Tabc[aux1_,aux2_,aux3_,l1_,l2_,l3_]:=Join[aux1[[1;;l1]],Table[{(Subscript[a, i+l1]),aux2[[i,2]]},{i,1,l2}],Table[{(Subscript[a, i+l1+l2]),aux3[[i,2]]},{i,1,l3}],aux1[[l1+1;;2*l1]],Table[{(Subscript[c, i+l1]),aux2[[i+l2,2]]},{i,1,l2}],Table[{(Subscript[c, i+l1+l2]),aux3[[i+l3,2]]},{i,1,l3}],aux1[[2*l1+1;;3*l1]],Table[{(Subscript[b, i+l1]),aux2[[i+2*l2,2]]},{i,1,l2}],Table[{(Subscript[b, i+l1+l2]),aux3[[i+2*l3,2]]},{i,1,l3}]]

Pars=Tabc[Pars1,Pars2,Pars3,l1,l2,l3]

ParsM=Table[Pars[[i,2]],{i,1,3*(l1+l2+l3)}]

ParsM=Table[Pars1BR[[i,2]],{i,1,3*(l1+0)}]

Export["D:\\sousa\\Covid19\\GnuPlot\\ParsBR.txt",ParsM,"CSV"];

ParsBRc={{(Subscript[a, 1]),0.3442544314568885`},{(Subscript[a, 2]),0.06265025791695183`},{(Subscript[a, 3]),0.11751913671825302`},{(Subscript[a, 4]),0.3695226437922263`},{(Subscript[a, 5]),0.19378419843330846`},{(Subscript[a, 6]),0.29894114249384784`},{(Subscript[a, 7]),0.18752557321622793`},{(Subscript[a, 8]),0.21221509339360087`},{(Subscript[a, 9]),0.5971713010553253`},{(Subscript[a, 10]),0.9600000099999672`},{(Subscript[a, 11]),0.6000000100054333`},{(Subscript[a, 12]),0.22157316504842214`},{(Subscript[a, 13]),0.19779096864618154`},{(Subscript[a, 14]),0.6000000100018034`},{(Subscript[a, 15]),0.3250359893137727`},{(Subscript[a, 16]),0.05092284557133669`},{(Subscript[a, 17]),0.6000000099999716`},{(Subscript[a, 18]),0.6000000099999978`},{(Subscript[c, 1]),14.38120931929726`},{(Subscript[c, 2]),4.351620378460686`},{(Subscript[c, 3]),3.7478183168053985`},{(Subscript[c, 4]),17.54671424061865`},{(Subscript[c, 5]),10.903826746993905`},{(Subscript[c, 6]),19.457759706853334`},{(Subscript[c, 7]),4.446031475614506`},{(Subscript[c, 8]),3.516623652679805`},{(Subscript[c, 9]),41.47475464006512`},{(Subscript[c, 10]),71.06632302071381`},{(Subscript[c, 11]),3.3242044737711267`},{(Subscript[c, 12]),2.7965316615865374`},{(Subscript[c, 13]),5.633124600538097`},{(Subscript[c, 14]),4.027765699621836`},{(Subscript[c, 15]),16.940564466764428`},{(Subscript[c, 16]),3.022304386922389`},{(Subscript[c, 17]),2.518949546658343`},{(Subscript[c, 18]),5.436739265157799`},{(Subscript[b, 1]),633664.3243725311`},{(Subscript[b, 2]),4.0044840715635186`*^6},{(Subscript[b, 3]),1.135564175304713`*^6},{(Subscript[b, 4]),686639.3094733317`},{(Subscript[b, 5]),1.9440307014502825`*^6},{(Subscript[b, 6]),549142.436488662`},{(Subscript[b, 7]),1.178598948495137`*^6},{(Subscript[b, 8]),680689.1254867393`},{(Subscript[b, 9]),370152.93649694487`},{(Subscript[b, 10]),79019.55848215359`},{(Subscript[b, 11]),920994.5623687214`},{(Subscript[b, 12]),1.0226601270489899`*^6},{(Subscript[b, 13]),1.9668264057100106`*^6},{(Subscript[b, 14]),1.351941244276504`*^6},{(Subscript[b, 15]),692029.5451003822`},{(Subscript[b, 16]),1.1248643751510964`*^6},{(Subscript[b, 17]),135827.8438653382`},{(Subscript[b, 18]),678825.3872858201`}}

ParsUSc={{(Subscript[a, 1]),0.22307323041929009`},{(Subscript[a, 2]),0.46626237661958264`},{(Subscript[a, 3]),0.2858617973432077`},{(Subscript[a, 4]),0.5889348660805614`},{(Subscript[a, 5]),0.269154465636806`},{(Subscript[a, 6]),0.06696604631700814`},{(Subscript[a, 7]),0.48462232049929177`},{(Subscript[a, 8]),0.5429243341906766`},{(Subscript[a, 9]),0.5877996581269637`},{(Subscript[a, 10]),0.15870457585807324`},{(Subscript[a, 11]),0.290831710931846`},{(Subscript[a, 12]),0.21220602021402282`},{(Subscript[a, 13]),0.028658433031011843`},{(Subscript[a, 14]),0.6065802948734511`},{(Subscript[a, 15]),0.6616591166626528`},{(Subscript[a, 16]),0.1255880312581142`},{(Subscript[a, 17]),0.3655277215373987`},{(Subscript[c, 1]),5.942158564428258`},{(Subscript[c, 2]),20.380190456077532`},{(Subscript[c, 3]),18.574452856249945`},{(Subscript[c, 4]),30.15739461022833`},{(Subscript[c, 5]),3.668747115167499`},{(Subscript[c, 6]),3.310702150300672`},{(Subscript[c, 7]),22.988822305378054`},{(Subscript[c, 8]),29.385332300047775`},{(Subscript[c, 9]),0.3655277215373987`},{(Subscript[c, 10]),19.96380498296387`},{(Subscript[c, 11]),9.082681348053972`},{(Subscript[c, 12]),14.090047144010972`},{(Subscript[c, 13]),2.457470772507497`},{(Subscript[c, 14]),2.1105418187161815`},{(Subscript[c, 15]),18.994858171374325`},{(Subscript[c, 16]),19.422408277503614`},{(Subscript[c, 17]),3.298842077560371`},{(Subscript[b, 1]),1.6296647872806403`*^6},{(Subscript[b, 2]),1.2552303394426382`*^6},{(Subscript[b, 3]),886397.2717791495`},{(Subscript[b, 4]),1.775234431633412`*^6},{(Subscript[b, 5]),760606.4057041183`},{(Subscript[b, 6]),8.244728731029832`*^6},{(Subscript[b, 7]),1.883600316780816`*^6},{(Subscript[b, 8]),737239.1395470635`},{(Subscript[b, 9]),3.298842077560371`},{(Subscript[b, 10]),2.8775094990698076`},{(Subscript[b, 11]),639997.8081759373`},{(Subscript[b, 12]),4.347049924845669`*^6},{(Subscript[b, 13]),1.5626173188986466`*^6},{(Subscript[b, 14]),4.371205197098493`*^6},{(Subscript[b, 15]),8.040848471546578`*^6},{(Subscript[b, 16]),5.221108990394659`*^6},{(Subscript[b, 17]),5.80930989835473`*^6}};

All

l=16

mf=cshn[z,Table[(Subscript[a, i]),{i,1,l}],Table[(Subscript[b, i]),{i,1,l}],Table[(Subscript[c, i]),{i,1,l}]];

Pars=Join[Table[(Subscript[a, i]),{i,1,l}],Table[(Subscript[c, i]),{i,1,l}],Table[(Subscript[b, i]),{i,1,l}]];

Cons=Join[Table[0.01<(Subscript[a, i])<0.9,{i,1,l}],Table[1<(Subscript[c, i])<80,{i,1,l}],Table[(10^1)<(Subscript[b, i])<(10^7),{i,1,l}]];

Cons=Join[Table[0.01<(Subscript[a, i])<2.5,{i,1,l}],Table[1<(Subscript[c, i])<80,{i,1,l}],Table[(10^1)<(Subscript[b, i])<(10^7),{i,1,l}],Table[(Subscript[c, i])/(Subscript[a, i])<n+2,{i,1,l}]];

Cons=Join[Table[0.01<(Subscript[a, i])<4.6,{i,1,l}],Table[1<(Subscript[c, i])<280,{i,1,l}],Table[(10^1)<(Subscript[b, i])<(10^7),{i,1,l}],Table[(Subscript[c, i])/(Subscript[a, i])<n+2,{i,1,l}]];

Cons//Short

{t0,lsf}=AbsoluteTiming[NonlinearModelFit[Data,{mf,Cons},Pars,{z},MaxIterations->40000]]; t0

FR=lsf["FitResiduals"];
lsf["EstimatedVariance",VarianceEstimatorFunction->(RMS[#,n,3*l]&)]

lsf[z]

Plot[lsf[i],{i,1,160},PlotStyle->{Red,Thick},PlotRange->Full,Epilog->Point[Datab]]

pars=lsf["BestFitParameters"]

Pars=Join[Table[{(Subscript[a, i]),(Subscript[a, i])/.pars},{i,1,l}],Table[{(Subscript[c, i]),(Subscript[c, i])/.pars},{i,1,l}],Table[{(Subscript[b, i]),(Subscript[b, i])/.pars},{i,1,l}]];

Go Maple!

ParsMaple=Join[Table[(Subscript[a, i])/.pars,{i,1,l}],Table[(Subscript[c, i])/.pars,{i,1,l}],Table[(Subscript[b, i])/.pars,{i,1,l}]]

Export["D:\\sousa\\pesquisa\\Covid19\\GnuPlot\\ParsUSc.txt",ParsMaple,"CSV"];

gf=Plot[{lsf[i]},{i,1,150},PlotRange->{{0,150},{0,6*(10^6)}},PlotStyle->{Red},GridLines->Automatic,Frame->True,ImageSize->800,ImagePadding->60,PlotLegends->Placed[{"(Subscript[𝒵, 147])(n)"},Below],FrameLabel->{{"Contamination/week",None},{"n (week)",None}}];

gfc=Overlay[{gf,gc}]

Deaths

All

l=16

mf=cshn[z,Table[(Subscript[a, i]),{i,1,l}],Table[(Subscript[b, i]),{i,1,l}],Table[(Subscript[c, i]),{i,1,l}]];

Pars=Join[Table[(Subscript[a, i]),{i,1,l}],Table[(Subscript[c, i]),{i,1,l}],Table[(Subscript[b, i]),{i,1,l}]];

Cons=Join[Table[0.01<(Subscript[a, i])<0.9,{i,1,l}],Table[1<(Subscript[c, i])<80,{i,1,l}],Table[(10^1)<(Subscript[b, i])<(10^7),{i,1,l}]];

Cons=Join[Table[0.01<(Subscript[a, i])<0.96,{i,1,l}],Table[1<(Subscript[c, i])<80,{i,1,l}],Table[(10^1)<(Subscript[b, i])<(10^7),{i,1,l}],Table[(Subscript[c, i])/(Subscript[a, i])<n,{i,1,l}]];

Cons//Short

{t0,lsf}=AbsoluteTiming[NonlinearModelFit[Data,{mf,Cons},Pars,{z},MaxIterations->40000]]; t0

FR=lsf["FitResiduals"];
lsf["EstimatedVariance",VarianceEstimatorFunction->(RMS[#,n,3*l]&)]

Plot[lsf[i],{i,1,n+10},PlotStyle->{Red,Thick},PlotRange->Full,Epilog->Point[Datab]]

pars=lsf["BestFitParameters"]

Pars=Join[Table[{(Subscript[a, i]),(Subscript[a, i])/.pars},{i,1,l}],Table[{(Subscript[c, i]),(Subscript[c, i])/.pars},{i,1,l}],Table[{(Subscript[b, i]),(Subscript[b, i])/.pars},{i,1,l}]];

Go Maple!

ParsMaple=Join[Table[(Subscript[a, i])/.pars,{i,1,l}],Table[(Subscript[c, i])/.pars,{i,1,l}],Table[(Subscript[b, i])/.pars,{i,1,l}]];

Export["D:\\sousa\\pesquisa\\Covid19\\GnuPlot\\parsUSall3.txt",ParsMaple,"CSV"];

gf=Plot[{lsf[i]},{i,1,140},PlotRange->{{0,140},{0,24*(10^3)}},PlotStyle->{Red},GridLines->Automatic,Frame->True,ImageSize->800,ImagePadding->60,PlotLegends->Placed[{"(Subscript[𝒵, 140])(n)"},Below],FrameLabel->{{"Deaths/week",None},{"n (week)",None}}];

gfd=Overlay[{gf,gd}]

First part

Data1=Table[DataAll[[1,i,6]],{i,1,75}];

Data1b=Table[{i,DataAll[[1,i,6]]},{i,1,75}];

l1=8

mf1=cshn[z,Table[(Subscript[a, i]),{i,1,l1}],Table[(Subscript[b, i]),{i,1,l1}],Table[(Subscript[c, i]),{i,1,l1}]];

Pars1=Join[Table[(Subscript[a, i]),{i,1,l1}],Table[(Subscript[c, i]),{i,1,l1}],Table[(Subscript[b, i]),{i,1,l1}]];

Cons1=Join[Table[0.01<(Subscript[a, i])<0.9,{i,1,l1}],Table[1<(Subscript[c, i])<80,{i,1,l1}],Table[(10^1)<(Subscript[b, i])<(10^7),{i,1,l1}]];

Cons1=Join[Table[0.01<(Subscript[a, i])<0.96,{i,1,l1}],Table[1<(Subscript[c, i])<90,{i,1,l1}],Table[(10^1)<(Subscript[b, i])<(10^6),{i,1,l1}],Table[(Subscript[c, i])/(Subscript[a, i])<n,{i,1,l1}]];

{t0,lsf1}=AbsoluteTiming[NonlinearModelFit[Data1,{mf1,Cons1},Pars1,{z},MaxIterations->40000]]; t0

FR=lsf1["FitResiduals"];
lsf1["EstimatedVariance",VarianceEstimatorFunction->(RMS[#,75,3*l1]&)]

Plot[lsf1[i],{i,1,80},PlotStyle->{Red,Thick},PlotRange->Full,Epilog->Point[Data1b]]

pars1=lsf1["BestFitParameters"]

Pars1=Join[Table[{(Subscript[a, i]),(Subscript[a, i])/.pars1},{i,1,l1}],Table[{(Subscript[c, i]),(Subscript[c, i])/.pars1},{i,1,l1}],Table[{(Subscript[b, i]),(Subscript[b, i])/.pars1},{i,1,l1}]]

Pars1={{(Subscript[a, 1]),0.1381608070121996`},{(Subscript[a, 2]),0.14638418501069994`},{(Subscript[a, 3]),0.5279302641157294`},{(Subscript[a, 4]),0.9157789286701654`},{(Subscript[a, 5]),0.2173116437906986`},{(Subscript[a, 6]),0.29520749024480714`},{(Subscript[a, 7]),0.5834548838763242`},{(Subscript[a, 8]),0.08556712721338508`},{(Subscript[c, 1]),4.016173455884751`},{(Subscript[c, 2]),6.657301100425359`},{(Subscript[c, 3]),24.93065167827863`},{(Subscript[c, 4]),47.00255809930365`},{(Subscript[c, 5]),11.681824205982881`},{(Subscript[c, 6]),4.65227584335838`},{(Subscript[c, 7]),7.29846129780184`},{(Subscript[c, 8]),5.436268385557547`},{(Subscript[b, 1]),48876.959694935125`},{(Subscript[b, 2]),49993.15567563796`},{(Subscript[b, 3]),12649.417137695442`},{(Subscript[b, 4]),4748.186990122024`},{(Subscript[b, 5]),77120.98352739475`},{(Subscript[b, 6]),36936.084869910555`},{(Subscript[b, 7]),18751.91815379085`},{(Subscript[b, 8]),58988.11396158941`}}

gf1=Plot[{lsf1[i]},{i,1,140},PlotRange->{{0,140},{0,24*(10^3)}},PlotStyle->{Red},GridLines->Automatic,Frame->True,ImageSize->800,ImagePadding->60,PlotLegends->Placed[{"(Subscript[𝒵, a])(n)"},Below],FrameLabel->{{"Deaths/week",None},{"n (week)",None}}];

gfd1=Overlay[{gf1,gd}]

Second part

Data2=Table[DataAll[[1,i,6]],{i,75,n}];

Data2b=Table[{i,DataAll[[1,i,6]]},{i,75,n}];

l2=8

mf2=cshn[z,Table[(Subscript[a, i]),{i,l1+1,l1+l2}],Table[(Subscript[b, i]),{i,l1+1,l1+l2}],Table[(Subscript[c, i]),{i,l1+1,l1+l2}]];

Pars2=Join[Table[(Subscript[a, i]),{i,l1+1,l1+l2}],Table[(Subscript[c, i]),{i,l1+1,l1+l2}],Table[(Subscript[b, i]),{i,l1+1,l1+l2}]];

Cons2=Join[Table[0.01<(Subscript[a, i])<0.9,{i,l1+1,l1+l2}],Table[1<(Subscript[c, i])<80,{i,l1+1,l1+l2}],Table[(10^1)<(Subscript[b, i])<(10^7),{i,l1+1,l1+l2}]];

Cons2=Join[Table[0.01<(Subscript[a, i])<0.98,{i,l1+1,l1+l2}],Table[0.1<(Subscript[c, i])<90,{i,l1+1,l1+l2}],Table[(10^1)<(Subscript[b, i])<(10^6),{i,l1+1,l1+l2}],Table[5<(Subscript[c, i])/(Subscript[a, i])<n,{i,l1+1,l1+l2}]];

{t0,lsf2}=AbsoluteTiming[NonlinearModelFit[Data2,{mf2,Cons2},Pars2,{z},MaxIterations->30000]]; t0

FR=lsf2["FitResiduals"];
lsf2["EstimatedVariance",VarianceEstimatorFunction->(RMS[#,n-74,3*l2]&)]

Plot[lsf2[i-74],{i,69,140},PlotStyle->{Red,Thick},PlotRange->Full,Epilog->Point[Data2b]]

pars2=lsf2["BestFitParameters"]

Pars2=Join[Table[{(Subscript[a, i]),(Subscript[a, i])/.pars2},{i,l1+1,l1+l2}],Table[{(Subscript[c, i]),(Subscript[c, i])/.pars2},{i,l1+1,l1+l2}],Table[{(Subscript[b, i]),(Subscript[b, i])/.pars2},{i,l1+1,l1+l2}]]

Pars2=

gf2=Plot[{lsf2[i-74]},{i,69,140},PlotRange->{{0,140},{0,24*(10^3)}},PlotStyle->{Red},GridLines->Automatic,Frame->True,ImageSize->800,ImagePadding->60,PlotLegends->Placed[{"(Subscript[𝒵, b])(n)"},Below],FrameLabel->{{"Deaths/week",None},{"n (week)",None}}];

gfd2=Overlay[{gf2,gd}]

gf12=Plot[{lsf1[i],lsf2[i-74]},{i,1,140},PlotRange->{{0,140},{0,24*(10^3)}},PlotStyle->{Red,Brown},GridLines->Automatic,Frame->True,ImageSize->800,ImagePadding->60,PlotLegends->Placed[{"(Subscript[𝒵, a])(n)","(Subscript[𝒵, b])(n)"},Below],FrameLabel->{{"Deaths/week",None},{"n (week)",None}}];

gfd12=Overlay[{gf12,gd}]

Joint parameters

Tabc[aux1_,aux2_,l1_,l2_]:=Join[aux1[[1;;l1]],Table[{(Subscript[a, i+l1]),aux2[[i,2]]},{i,1,l2}],aux1[[l1+1;;2*l1]],Table[{(Subscript[c, i+l1]),aux2[[i+l1,2]]},{i,1,l2}],aux1[[2*l1+1;;3*l1]],Table[{(Subscript[b, i+l1]),aux2[[i+2*l1,2]]},{i,1,l2}]]

Pars=Tabc[Pars1,Pars2,l1,l2]

ParsM=Table[Pars[[i,2]],{i,1,3*(l1+l2)}]

Export["D:\\sousa\\pesquisa\\Covid19\\GnuPlot\\teste0.txt",ParsM,"CSV"];