Figure 8

Copyright (c) 2019 Raj Saha (rsaha@bates.edu) and Meredith Greer (mgreer@bates.edu)

Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sub-license, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions : The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.

SetDirectory[NotebookDirectory[]];

Japan

dataPopJapan=Import["Japan_Hida_population.dat","Data"];

Table[dataPopJapan[[i]][[2]],{i,2,Length[dataPopJapan]}];

popMedianJapan=Median[%];

βlowJapan=1.13 (10^(-2));
βhighJapan=2.097 (10^(-2));

βrangeJapan={popMedianJapan βlowJapan, popMedianJapan βhighJapan};

αmedianJapan=96;
δmedianJapan=0.028641285;

R0starJapan=3.15;
μstarJapan=16;

βstarJapan=R0starJapan δmedianJapan ((μstarJapan)/(αmedianJapan));

β0starJapan=popMedianJapan βstarJapan;

British India

dataPopBI=Import["British_India_population.dat","Data"]

popMedianBI=Median[dataPopBI[[2;;,2]]]

βlowBI=1.694 (10^(-7));
βhighBI=2.402 (10^(-7));

βrangeBI={popMedianBI βlowBI, popMedianBI βhighBI};

αmedianBI=11000091.95;
δmedianBI=0.041106;

R0starBI=3.2;
μstarBI=16.5;

βstarBI=R0starBI δmedianBI ((μstarBI)/(αmedianBI));

β0starBI=popMedianBI βstarBI;

Sweden

dataPopSweden=Import["Sweden_alldata.dat"];

Table[dataPopSweden[[i]][[2]],{i,2,Length[dataPopSweden]}];

popMedianSweden=Median[%];

βlowSweden=3.48 (10^(-5));
βhighSweden=7.32 (10^(-5));

βrangeSweden={popMedianSweden βlowSweden, popMedianSweden βhighSweden};

αmedianSweden=42370;
δmedianSweden=0.025643473;

R0starSweden=3.3;
μstarSweden=24;

βstarSweden=R0starSweden δmedianSweden ((μstarSweden)/(αmedianSweden));

β0starSweden=popMedianSweden βstarSweden;

PLOT

Show[
ParametricPlot[{u,1},{u,βrangeJapan[[1]],βrangeJapan[[2]]},PlotStyle->{AbsoluteThickness[20],RGBColor[0.368417, 0.506779, 0.709798]}],
ParametricPlot[{u,2},{u,βrangeBI[[1]],βrangeBI[[2]]},PlotStyle->{AbsoluteThickness[20],RGBColor[0.880722, 0.611041, 0.142051]}],
ParametricPlot[{u,3},{u,βrangeSweden[[1]],βrangeSweden[[2]]},PlotStyle->{AbsoluteThickness[20],RGBColor[0.560181, 0.691569, 0.194885]}],

Graphics[{Text[Style["Hida District, Japan",FontFamily->"Open Sans", FontColor->White],{βrangeJapan[[1]],1},{-1,0}]}],
Graphics[{Text[Style["British India",FontFamily->"Open Sans", FontColor->White],{βrangeBI[[1]],2},{-1,0}]}],
Graphics[{Text[Style["Sweden",FontFamily->"Open Sans", FontColor->White],{βrangeSweden[[1]],3},{-1,0}]}],

AspectRatio->1/4,
ImageSize->400,
PlotRange->{0.5,3.5},
Frame->True,
Axes->None,
FrameTicks->{Automatic,None},
FrameLabel->{"(Subscript[β, 0])",None}

]