SWB codes

D. Gurarie

SWB with mating

(*Uninfected Source*)
UV[n_]:=UnitVector[n+1,1];
(*Host system*)
HTM[{λ_,μ_,γ_},n_,h_]:=
Table[λ h[k-1]-(λ Sign[n-k]+k γ+μ)h[k]+(k+1)γ h[k+1],{k,0,n}]/.{h[-1]->0,h[n+1]->0};
(*Mated Count*)
MC[n_]=(n/2)(1-(2^(-2Floor[n/2]))Binomial[2Floor[n/2],Floor[n/2]]);
SetAttributes[MC,Listable];
(*Equilibrium SWB with source so*)
QSW[l_,m_,n_,so_]:=Block[{az,hv,bz,mz},
az=HTM[{l,m,1},n,h]+so;hv=h/@Range[0,n];{bz,mz}=CoefficientArrays[az,hv];LinearSolve[mz,-bz]]
(*Child equilibrium*)
SWc[l_,μ_,n_]:=QSW[l,μ,n,μ UV[n]];
SetAttributes[SWc,Listable]
(*Fecundity*)
Fec[(*strata*)k_,{(*(Subscript[ρ, 0])*)r_,k0_}]=r (E^(-k /k0));
(*SWB worm prev*)
SWP[l_,μ_,n_]:=1-First@QSW[l,μ,n,μ UV[n]]
(*Infected Egg prev: children*)
EPC[{L_,μ_,n_},{ρ_,w0_,r_},dw_]:=
Block[{rg=Range[0,n],sw,mc,fc},
(*mated count*)mc=MC[dw rg];
(*Fec*)fc=Fec[rg,{ρ,(w0/dw)}];
(*SW*)sw=SWc[L,μ,n];
1-((((r/(r+fc))))^(r mc)).sw]
(*Infected Egg prev with source =sB*)
EPS[{L_,μ_,n_,sB_},{ρ_,w0_,r_},dw_]:=
Block[{rg=Range[0,n],sw,mc,fc},
(*mated count*)mc=MC[dw rg];
(*Fec*)fc=Fec[rg,{ρ,(w0/dw)}];
(*SW*)sw=QSW[L,μ,n,sB];
1-((((r/(r+fc))))^(r mc)).sw]
(*Mean egg release: children*)
MEC[{L_,μ_,n_},{ρ_,w0_,r_},dw_]:=
Block[{rg=Range[0,n],sw,mc,fc},
(*mated count*)mc=MC[dw rg];
(*Fec*)fc=Fec[rg,{ρ,(w0/dw)}];
(*SW*)sw=SWc[L,μ,n];
(mc fc).sw]
(*Mean egg release with source SWB =sB*)
MES[{L_,μ_,n_,sB_},{ρ_,w0_,r_},dw_]:=
Block[{rg=Range[0,n],sw,mc,fc},
(*mated count*)mc=MC[dw rg];
(*Fec*)fc=Fec[rg,{ρ,(w0/dw)}];
(*SW*)sw=QSW[L,μ,n,sB];
(mc fc).sw]

MDA

(*Treatment map for h-strata: h[i]-> h[ϵ*i]*)
TrM[h_,n_,e_]:=PadRight[Total/@Map[h,GatherBy[Range[0,n],Floor[e #]&],{2}],n+1];
(*MDA Event control of SWB-system hv[t] with parameters: {fc=fraction cover, ep=efficacy, tz= interval(years)}*)
WEB[hv_,{fc_,ep_,tz_}]:=With[{hz=Through@(hv@t),h=Head@hv[[1]],ht=TrM[h,Length@hv-1,ep]/.h[i_]->h[i][t]},
WhenEvent[Mod[t,tz]==0,
{f@t->fc,hz->(1-f@t)hz+f@t ht}]];
(* Event occurence control: remove after m+1 occurence*)
WEBm[hv_,{fc_,ep_,tz_,m_}]:=
With[{hz=Through@(hv@t),h=Head@hv[[1]],ht=TrM[h,Length@hv-1,ep]/.h[i_]->h[i][t]},
WhenEvent[Mod[t,tz]==0,
{f@t->fc,hz->(1-f@t)hz+f@t ht,c[t]->c[t]+1,
If[c[t]>m,"RemoveEvent"]}]];
(*Conditional Event control by y-value*)
WEBc[hv_,{fc_,ep_,tz_,yc_}]:=
With[{hz=Through@(hv@t),h=Head@hv[[1]],ht=TrM[h,Length@hv-1,ep]/.h[i_]->h[i][t]},
WhenEvent[Mod[t,tz]==0,
{f@t->fc,h->(1-f@t)h+f@t ht,
If[y[t]<yc,"RemoveEvent"]}]];

Coupled SWB-snail; 2-risk group SWB

(*Snail FOI/"host"x"contact"*)
FOS[(*input strata*){h_,n_,dw_},(*Fecundity pars*)fpa_]:= 
Block[{Fec},
(*Fecundity*)Fec[k_,(*parameters*){r_,a_,k0_}]= (r/(1+(((k/k0))^a)));
Sum[ Fec[k,fpa]MC[dw k]h[k],{k,n}]];
(*Single SWB with mating/fecundity: a= A*snail-density*contact; b= B*(H-pop)*contact*)
SWB[(*strata*){h_,n_,dw_},
(*Demographics/biology*){μ_,γ_,ν_},
(*Fecundity*)fpa_,
(*Transmision*){a_,b_},
(*Source*)so_]:=
{(HTM[{((a y)/dw),μ,γ},n,h]+μ so),b FOS[{h,n,dw},fpa](1-y)- ν y};
(*2-risk group SWB*)
SW2[(*strata*){h_,n_,dw_},(*Demographics*){μ_,γ_,ν_},(*fecund*)fpa_,
(*transmision*){a1_,b1_,a2_,b2_,f1_},(*Source*)so_]:=
{HTM[{((a1 y)/dw),μ,γ},n,(Subscript[h, 1])]+μ so,
HTM[{((a2 y)/dw),μ,γ},n,(Subscript[h, 2])]+μ so,
(b1 f1 FOS[{(Subscript[h, 1]),n,dw},fpa]+b2 (1-f1)FOS[{(Subscript[h, 2]),n,dw},fpa])(1-y)- ν y};
(*Child-adult 2-risk SWB*)
SWC[(*strata*){hc_,ha_,n_,dw_},
(*worm/ snail*){γ_,ν_},
(*fecundity*)fcp_,fap_,
(*Demographics*){(*birth/mort*)μ_,(*maturation*)ma_},
(*child transmision*){a1_,b1_,a2_,b2_,f1_},
(*adult transmision*){A1_,B1_,A2_,B2_,F1_}]:=
Block[{hc1,hc2,ha1,ha2,(*sources*)Sc,Sa,rr=Range[0,n],(*variables*)vc1,vc2},
hc1=HTM[{((a1 y)/dw),ma,γ},n,(Subscript[hc, 1])];
hc2=HTM[{((a2 y)/dw),ma,γ},n,(Subscript[hc, 2])];
ha1=HTM[{((A1 y)/dw),μ,γ},n,(Subscript[ha, 1])];
ha2=HTM[{((A2 y)/dw),μ,γ},n,(Subscript[ha, 2])];
(*variables*)vc1=(Subscript[hc, 1])/@rr;vc2=(Subscript[hc, 2])/@rr;
Sc=ma UV[n];
Sa=μ(f1 vc1+(1-f1)vc2);
{hc1+Sc,hc2+Sc,
ha1+Sa,ha2+Sa,
(b1 f1 FOS[{(Subscript[hc, 1]),n,dw},fcp]+b2 (1-f1)FOS[{(Subscript[hc, 2]),n,dw},fcp]+
(*relative adult/child*)(ma/μ)(B1 F1 FOS[{(Subscript[ha, 1]),n,dw},fap]+B2 (1-F1)FOS[{(Subscript[ha, 2]),n,dw},fap]))(1-y)- ν y}];