SEPAR Rekursion  full dark sector und zentraler Rekursion in H[k]
delta=1 kappa7 aus HDach7 berechnet
  lange Intervalle bis Oktober
 mit Impfung, Veranschlagung der Mutante durch erhöhtes gamma
übernommen vom 04.05.2021;
20.06.2021

Char1[x_,axx_ ,bxx_] := 2^-1 (Sign[x -axx] - Sign[x-bxx]); 
suppMult[x_,Axx_,Bxx_,cxx_ ]=( Char1[x,-10^6, Axx]+((1+cxx)/2+((1-cxx)/2)Cos[((x-Axx)Pi)/(Bxx-Axx)])Char1[x,Axx,Bxx]+cxx  Char1[x,Bxx,10^6]); (*multiplikative Absenkung bzw Anhebung von 1 auf cxx von A nach B f mit cosinus-Glättung*)
LinsuppMult[x_,Axx_,Bxx_,cxx_ ]=Char1[x,-10^6, Axx]+(1+  ((cxx-1)/((Bxx-Axx))) (x-Axx) )Char1[x,Axx,Bxx]+cxx  Char1[x,Bxx,10^6];(*multiplikative Absenkung bzw Anhebung von 1 auf cxx von A nach B linear*)
Char[x_,AAA_,BBB_]=Piecewise[{{1,AAA<=x<=BBB}},0];(*charakteristische Funktion des Intervalls [a,b])*)
hilf1ModMult[x_]= Piecewise[{{0,x≤0},{Exp[-(x^(-1))],0≤x}}];
hilf2ModMult[x_]=((hilf1ModMult[x])/(hilf1ModMult[x]+hilf1ModMult[1-x]));
ModMult[x_,AAA_,BBB_,ccc_]=1+(ccc-1) hilf2ModMult[((x-AAA)/(BBB-AAA))](*glatte Anhebung um Faktor ccc im Intervall [AAA,BBB]*) ;

(i) Eingabe von

e, p_c, p_d,  q, N0, α, δ,     ζ (Faktor Infektivität Mutante)
parT, Impf-Funktion V(k)
Conf0 = AtotJHU0 
a0, eta7 für k=1 bis t1/.parT -- wichtig:  Auswertung mit dark Faktor δ wie oben
aa[j] Modellwerte für η[j]
AneuJHU für k  1 bis  1 +p+q

Print["e= ", e, "  pc= ", pc, "  pd= ", pd, "  q= ", q,  "  α= ", α,  "  δ= ", δ,  "  ξ= ", ξ,   ",  N = ", N0];
(*Beginn des ersten Hauptintervalls*)
(*end of data*)
teod=Length[QJHU];datet1=DatePlus[datet0,t1JHU-1];
Print["t0 in JHU-Zählung = ", t0JHU, " in Landeszählung = 1,",  " i.e. ",datet0, "; 
 t1 in Landeszählung = " , t1JHU, " i.e. ", datet1];

Aktuelle Daten (lange Intervalle)

(*lange Intervalle im Sommer 2020*)
parT={t0->1,t1->t1JHU,t2->62,Δ2->2, t3->132,Δ3->4, t4->216 +2,Δ4->9,t5->tOct1+30(*tOct1+17*),Δ5->11 ,t6->tNov1+27-2,Δ6->8 ,(*t10->tNov1+27-2,Δ10->8 ,*)t7 ->tDec1+13+2,Δ7->6   ,  t8-> tMar12021(*+7-1*), Δ8->7 , t9-> tApr12021+9 (*+7-1*), Δ9->7  };
datet1=DatePlus[datet0, -1+t1/.parT];
datet2=DatePlus[datet0, -1+t2/.parT];
datet3=DatePlus[datet0, -1+t3/.parT];
datet4=DatePlus[datet0, -1+t4/.parT];
datet5=DatePlus[datet0, -1+t5/.parT];
datet6=DatePlus[datet0, -1+t6/.parT];
datet7=DatePlus[datet0, -1+t7/.parT];
datet8=DatePlus[datet0, -1+t8/.parT];
 datet9=DatePlus[datet0, -1+t9/.parT];
(*datet10=DatePlus[datet0, -1+t10/.parT];
datet11=DatePlus[datet0, -1+t11/.parT];
datet12=DatePlus[datet0, -1+t12/.parT];
datet13=DatePlus[datet0, -1+t13/.parT];*)
eod=DatePlus[datet0, Length[QJHU]-1];
Print["t0=",t0/.parT, ",  t0JHU=",  t0JHU,",  i.e. ", datet0];
Print["t1=",t1/.parT, ",  t1JHU=",  t0JHU+t1/.parT,",  i.e. ", datet1];
Print["t2=",t2/.parT, ",  t2JHU=",  t0JHU+t2/.parT,",  i.e. ", datet2];Print["t3=",t3/.parT, ",  t3JHU=",  t0JHU+t3/.parT,",  i.e. ", datet3];
Print["t4=",t4/.parT, ",  t4JHU=",  t0JHU+t4/.parT,",  i.e. ", datet4];Print["t5=",t5/.parT, ",  t5JHU=",  t0JHU+t5/.parT,",  i.e. ", datet5];
Print["t6=",t6/.parT, ",  t6JHU=",  t0JHU+t6/.parT,",  i.e. ", datet6];
Print["t7=",t7/.parT, ",  t7JHU=",  t0JHU+t7/.parT,",  i.e. ", datet7];
Print["t8=",t8/.parT, ",  t8JHU=",  t0JHU+t8/.parT,",  i.e. ", datet8];
Print["t9=",t9/.parT, ",  t9JHU=",  t0JHU+t9/.parT,",  i.e. ", datet9];(*Print["t10=",t10/.parT, ",  t10JHU=",  t0JHU+t10/.parT,",  i.e. ", datet10];Print["t11=",t11/.parT, ",  t10JHU=",  t0JHU+t11/.parT,",  i.e. ", datet11];
Print["t12=",t12/.parT, ",  t10JHU=",  t0JHU+t12/.parT,",  i.e. ", datet12];Print["t13=",t13/.parT, ",  t10JHU=",  t0JHU+t13/.parT,",  i.e. ", datet13];*)
Print["eod=",Length[QJHU]," i.e. ",eod];(*Intervall-Mittelwerte der a-quer(k) *)
κ=N[{Mean[Take[kappa7,{t0,t1}/.parT]],
Mean[Take[kappa7,{t1,t2-Δ2}/.parT]],
Mean[Take[kappa7,{t2,t3-Δ3}/.parT]],
Mean[Take[kappa7,{t3,t4-Δ4}/.parT]],
Mean[Take[kappa7,{t4,t5-Δ5}/.parT]], 
Mean[Take[kappa7,{t5,t6-Δ6}/.parT]], 
Mean[Take[kappa7,{t6,t7-Δ7}/.parT]], 
Mean[Take[kappa7,{t7,t8-Δ8}/.parT]],
 Mean[Take[kappa7,{t8,t9-Δ9}/.parT]],
Mean[Take[kappa7,{t9,Length[kappa7]}/.parT]](*,
Mean[Take[kappa7,{t10,Length[kappa7]}/.parT]] (
 Mean[Take[kappa7,{t11,t12}/.parT]]
  Mean[Take[kappa7,{t12,t13-Δ13}/.parT]], 
Mean[Take[kappa7,{t13,Length[kappa7]}/.parT]]*)
}] ;

sigmaκ={StandardDeviation[Take[kappa7,{t0,t1-1}/.parT]],
StandardDeviation[Take[kappa7,{t1,t2-Δ2}/.parT]],
StandardDeviation[Take[kappa7,{t2,t3-Δ3}/.parT]],
StandardDeviation[Take[kappa7,{t3,t4-Δ4}/.parT]],
StandardDeviation[Take[kappa7,{t4,t5-Δ5}/.parT]],StandardDeviation[Take[kappa7,{t5,t6-Δ6}/.parT]],
StandardDeviation[Take[kappa7,{t6,t7-Δ7}/.parT]],
StandardDeviation[Take[kappa7,{t7,t8-Δ8}/.parT]],
StandardDeviation[Take[kappa7,{t8,t9-Δ9}/.parT]] ,
StandardDeviation[Take[kappa7,{t9,Length[kappa7]}/.parT]](*,
StandardDeviation[Take[kappa7,{t10,Length[kappa7]}/.parT]],
StandardDeviation[Take[kappa7,{t11,t12}/.parT]],
StandardDeviation[Take[kappa7,{t12,t13-Δ13}/.parT]],
StandardDeviation[Take[kappa7,{t13,Length[kappa7]}/.parT]]*)
} ;

datendkappa

κ

sigmaκ

Length[κ]

faktor1=1;faktor2=1;
a1=κ[[2]](*-0.3sigmaκ[[2]]*); a2=κ[[3]]-0.1sigmaκ[[3]] ; a3=κ[[4]](*-0.6sigmaκ[[4]]*); a4=κ[[5]]-0.6sigmaκ[[5]]; a5=κ[[6]]  -0.2sigmaκ[[6]]; a6=κ[[7]] (*-0.1sigmaκ[[7]]*);a7=κ[[8]]  -0.15sigmaκ[[8]];
 a8=  κ[[9]] +0.15sigmaκ[[9]];
a9=  κ[[10]] +0sigmaκ[[10]];
aa[x_]=a1 suppMult[x,t2-Δ2,t2,(a2/a1)]suppMult[x,t3-Δ3,t3,(a3/a2)]suppMult[x,t4-Δ4,t4,(a4/a3)]*suppMult[x,t5-Δ5,t5,(a5/a4)] suppMult[x,t6-Δ6,t6,(a6/a5)] suppMult[x,t7-Δ7,t7,(a7/a6)]suppMult[x,t8-Δ8,t8,(a8/a7)]suppMult[x,t9-Δ9,t9,(a9/a8)](*suppMult[x,t11-Δ11,t11,(a11/a10)]suppMult[x,t12-Δ12,t12,(a12/a11)]*)/.parT;aModel=Table[aa[k],{k,t1/.parT,kend}];
GraphaModelX=DateListPlot[Take[aModel,Length[kappa7]+15],datet1,PlotStyle->{Black,Dashed},Sequence[PlotTheme->"Detailed", ImageSize->Medium],(*GridLines->{{{"{2020,03,24}" ,Thick},{"{2020,04,26}",Thick},{"{2020,07,05}",Thick},{"{2020,09,27}",Thick},{"{2020,10,31}",Thick},{"{2020,12,6}",Thick},{"{2021,03,02}",Thick}},{0.1,0.2,0.3,0.4}},*)GridLines->{{"{2020,03,24}" ,"{2020,04,26}","{2020,07,05}","{2020,09,29}","{2020,10,31}","{2020,11,26}","{2020,12,16}","{2021,03,07}"},Automatic},GridLinesStyle->{Directive[Gray],Directive[Dotted]},PlotRange->{0,0.4}];GraphaModel=DateListPlot[Take[aModel,Length[kappa7]+15],datet1,PlotStyle->{Black,Dashed},Sequence[PlotTheme->"Detailed", ImageSize->Medium],Epilog->{Text[Subscript["J",1],{{2020,04,6} ,0.02}],Text[Subscript["J",2],{{2020,06,1} ,0.02}],Text[Subscript["J",3],{{2020,08,12} ,0.02}] ,Text[Subscript["J",4],{{2020,10,14} ,0.02}] ,Text[Subscript["J",5],{{2020,11,14} ,0.02}],Text[Subscript["J",6],{{2020,12,7} ,0.02}],Text[Subscript["J",7],{{2021,01,26} ,0.02}],Text[Subscript["J",8],{{2021,04,2} ,0.02}]},(*GridLines->{{{"{2020,03,24}" ,Thick},{"{2020,04,26}",Thick},{"{2020,07,05}",Thick},{"{2020,09,27}",Thick},{"{2020,10,31}",Thick},{"{2020,12,6}",Thick},{"{2021,03,02}",Thick}},{0.1,0.2,0.3,0.4}},*)GridLines->{{"{2020,03,24}" ,"{2020,04,26}","{2020,07,05}","{2020,09,29}","{2020,10,31}","{2020,11,26}","{2020,12,16}","{2021,03,07}"},Automatic},GridLinesStyle->{Directive[Gray],Directive[Dotted]},PlotRange->{0,0.4}];

Graphkappa7A=DateListPlot[Take[kappa7,Length[kappa7] ],datet0,(*Joined->False,*)  PlotStyle->{Colorkappa},Sequence[PlotTheme->"Detailed", ImageSize->Medium] ,  (*GridLines->{{{"{2020,03,24}",Thick},{"{2020,04,26}",Thick},{"{2020,07,05}",Thick},{"{2020,09,27}",Thick},{"{2020,10,31}",Thick},{"{2020,12,6}",Thick},{"{2021,03,02}",Thick}},{0.1,0.2,0.3,0.4,0.5,0.6,0.7}},*)PlotRange->{0, 0.8},FrameLabel->{None,"kappa"}];Graphcrit=DateListPlot[Table[1/ptilde[k],{k,1,tMay12021
+60}],datet0,Sequence[PlotTheme->"Detailed", ImageSize->Medium], PlotStyle->{Black, Thin, Dotted}];

Print["a1=", a1, " a2=", a2,   "  a3 =" , a3, " a4 =" , a4, " a5 =" , a5, " a6 =" , a6,  " a7 =" , a7 (*,  " a8 =" , a8  ,  " a9 =" , a9   ,   " a10 =" , a10 ,   " a11 =" , a11 ,   " a12 =" , a12,   " a13 =" , a13*)];Print[Show[GraphaModel,Graphkappa7A,Graphcrit]]
Print["Kontaktraten D mit Modellwerten"]

Export["/file-path/graph-D-kappa.pdf",%]

"//home/erhard/Dropbox/Mathematica_notebooks/Corona/Deutschland-2021-06ff/graph-D-kappa.pdf"

a8/a7

für c=1.5    a8/a7=  1.15 (am 27.03.)

datendkappa

datendRhokappa

kappa7von0

X0=1-(e+pd); kend=1000;
Do[qq[j]=q,{j,-100,kend}];

gamma

___ ___ ___ ___ ___ __
Run <SEPAR-recursion-2014-04-17.nb>  version (iii)

NotebookEvaluate["/file-path/SEPAR-recursion-Version-iii-2021-06-20.nb"]

_____________________________

Show[GraphQneurek,GraphQneu7JHU]

Length[kappa1]+e+pd

Show[GraphRhokappa7]

{Qneurek[[tApr12021]],Qneurek[[tApr12021+15-1]],Qneurek[[tMay12021]]}