INTRODUCCIÓN A LOS MODELOS MATEMÁTICOS PARA ENFERMEDADES INFECCIOSAS 
Y BREVE HISTORIA DE LAS PANDEMIAS

Leonardo Dagdug

CurrentValue[EvaluationNotebook[],DefaultNaturalLanguage]="Spanish";

Now

SARS-COV-2

Show[Entity["Species","Genus:Coronavirus"]["Image"],ImageSize->120]

GeoHistogram[ResourceData["Epidemic Data for Novel Coronavirus COVID-19","WorldCountries"][All,#Country->#ConfirmedCases["LastValue"]&],"Country",Sequence[PlotLegends->Automatic,PlotStyle->{Opacity[1],EdgeForm[{Thickness[Tiny],GrayLevel[0.5]}]}]]

El modelo de Bernoulli

Tabla de Halley, 4.1

TablaH={{0 ,1300, 1300, 0, 17.2 ,1300},{1, 1000 ,896, 104, 12.3 ,1015},
{2 ,855 ,685 ,170 ,9.8 ,879},{3 ,798 ,571 ,227 ,8.2 ,830},
{4 ,760 ,485 ,275 ,7.0 ,799},{5 ,732 ,416 ,316 ,6.1 ,777},
{6 ,710 ,359 ,351 ,5.2 ,760},{7 ,692 ,311 ,381 ,4.6 ,746},
{8 ,680 ,272 ,408 ,4.0 ,738},{9 ,670 ,238 ,432 ,3.5 ,732},
{10, 661, 208, 453, 3.0, 726},{11 ,653 ,182 ,471 ,2.7 ,720},
{12 ,646 ,160 ,486 ,2.3 ,715},{13 ,640 ,140 ,500 ,2.1 ,711},
{14 ,634 ,123 ,511 ,1.8 ,707},{15 ,628 ,108 ,520 ,1.6 ,702},
{16 ,622 ,94 ,528 ,1.4 ,697},{17 ,616 ,83 ,533 ,1.2 ,692},
{18 ,610 ,72 ,538 ,1.1 ,687},{19 ,604 ,63 ,541 ,0.9 ,681},
{20 ,598 ,55 ,543 ,0.8 ,676},{21 ,592 ,49 ,543 ,0.7 ,670},
{22 ,586 ,42 ,544 ,0.6 ,664},{23 ,579 ,37 ,542 ,0.5 ,656},
{24 ,572 ,32 ,540 ,649}};(*Guardamos los datos en una lista, los datos se incluyen entre llaves separados por comas*)

TableForm[TablaH,TableHeadings->{None,{"x","P(x)","S(x)","R(x)","M.V.", "M. no V."}}](*Con el comando TableForm se despliga una lista en el modo tradicional. Con TableHeadings se puede etiquetar cada entrada*)

Figura 4.25

ListPlot[{(*Con el comando ListPlot se grafica una lista de datos*)
Table[{i,TablaH[[i,3]]},{i,1,Length[TablaH]}],(*Se grafica la 1er contra la 3er columna*)
Table[{i,TablaH[[i,4]]},{i,1,Length[TablaH]}],(*Se grafica la 1er contra la 4a columna*)
Table[{i,TablaH[[i,2]]},{i,1,Length[TablaH]}],(*Se grafica la 1er contra la 2a columna*)
Table[{i,TablaH[[i,6]]},{i,1,Length[TablaH]-1}](*Se grafica la la 1er contra la 6a columna*)},
Frame->True,PlotRange->All,(*Ponemos un marco a la gráfica y le indicamos que grafique todo el rango*)Joined->{True,True,True},Mesh->All,(*Unimos todos los puntos con una línea*)FrameLabel->{"Días","Número de personas"}(*Damos las leyendas de los ejes*),PlotLegends->Placed[{"S(t)","R(t)","P(t)","(SuperStar[P])(t)"},(*Se agregan las leyendas de los diferentes datos*){0.85,0.75}]](*Coordenadas donde aprarecerán las leyendas*)

El Modelo de Ross

Figura 5.28

pp=1/3;p=1/3;m=Log[3]/10;a=Log[2]/90;b=Log[8/7];(*Damos valores a las constantes, renombramos p' por pp*)

f[n_]:=If[ n<(a m)/(b^2 p pp),0,(1-a m/(b^2 p pp n))/(1+a /(b pp n))];(*Definimos la función f=I/N de la ecuación (7.4) haciendo N=1. Para valores monores que (SuperStar[n]),definimmos el valor de la función igual a cero ya que si no lo hacemos nos daría valores negativos sin significado físico*)

Show[(*Con el comando Show se pueden mostrar más de una gráfica e incluso imprimir información sobre ésta*)Plot[{f[n]},{n,0,3}(*Con el comando Plot se grafica una función*),
Frame->True,PlotRange->All,Frame->True,FrameLabel->{"n / N","I / N"},PlotStyle->{Thickness[0.008]}],Graphics[(*Con el comando Graphics se pueden representar imágenes en dos dimensiones, con este comando pondremos un ponto rojo con el valor (SuperStar[n])/N*){{PointSize[Large],Red,Point[{(a m)/(b^2 p pp),0}]},Inset[(*Con el comando Inset se inserta objetos en una gráfica*)"((SuperStar[n])/N)",{0.3,0.1}]},Axes->False,Ticks->None]]

Crecimiento de poblaciones, COVID-19

Ecuación logística Figuras 6.29

K=1;r=-1;(*Parametros para la capacidad de carga y la razón de crecimiento para gráficar una ecuación logística*)

Plot[Evaluate[Table[(( K)/(1+(E^(-r t))((K/x0)-1))),{x0,0.0000001,1,0.15}]],{t,0,10},
Frame->True,
FrameLabel->{"t","x(t)"},PlotRange->All(*Con el comando Plot se grafica una función*)]

Ecuación logística Figuras 6.30

K=1;r=1;(*parametros para la capacidad de carga y la razón de crecimiento para gráficar una ecuación logística*)

Plot[Evaluate[Table[(( K)/(1+(E^(-r t))((K/x0)-1))),{x0,0.0000001,1,0.15}]],{t,0,10},
Frame->True,
FrameLabel->{"t","x(t)"},PlotRange->All(*Con el comando Plot se grafica una función*)]

Ecuación de Gompertz Figuras 6.31

K=1;c=-0.1;(*parametros para la capacidad de carga y la razón de crecimiento para gráficar una ecuación de Gompertz*)

Plot[Evaluate[Table[K Exp[-c Exp[-r t]],{r,0.0,1,0.15}]],{t,0,20},
Frame->True,
FrameLabel->{"t","x(t)"},PlotRange->All]

Ecuación de Gompertz Figuras 6.32

K=1;c=10;(*parametros para la capacidad de carga y la razón de crecimiento para gráficar una ecuación de Gompertz*)

Plot[Evaluate[Table[K Exp[-c Exp[-r t]],{r,0.0,1,0.15}]],{t,0,20},
Frame->True,
FrameLabel->{"t","x(t)"},PlotRange->All]

Hubei, China. Figura 6.34

Clear[r,K,tc,t]

hubei=ResourceData["Epidemic Data for Novel Coronavirus COVID-19"][SelectFirst[#AdministrativeDivision==(Entity["Hubei, China", Entity["AdministrativeDivision",{"Hubei","China"}], "Entity[\"AdministrativeDivision\", {\"Hubei\", \"China\"}]", "administrative division"])&],"ConfirmedCases"](*Con este comando cargamos la base de datos de la acumulación de infectados por COVID-19 de laprovincia de Hubei*);

hubeicc=TimeSeriesWindow[hubei,{hubei["FirstDate"],{2020,04,29}}](*Extaraemos de los datos el número de infectados por día*);

data=Table[{i,hubeicc["Values"][[i]]},{i,1,Length[hubeicc["Values"]]}(*Asignamos los datos a una lista*)];

hubeiNLM=NonlinearModelFit[data,K/(1+(E^(-r(t-tc)))),{{r,0.20},{K,70000},{tc,19}},t](*Con el comando NonlinearModelFit podemos obtener los parámetros del mejor ajuste, la ecución que se quiere ajustar tiene que ser incluida*);

hubeiNLM@"RSquared"(*Coeficiente de determinación*)

hubeiNLM@"ParameterConfidenceIntervalTable"(*Obtenemos los valores encontrados para el mejor ajuste*)

bands90[t_]:=hubeiNLM["SinglePredictionBands",ConfidenceLevel->.90](*Encontramos los valores con una confiabilidad del 90%*);

f[t_]=Normal[hubeiNLM](*Le asiganamos una ecuación a nuestro ajuste*)

Show[Plot[{f[t],bands90[t]},{t,0,60},Filling->{2->{1}},PlotStyle->{Thickness[0.008],Thickness[0.0035]},Frame->True,GridLines->Automatic,FrameLabel->{"Días","Nuevos infectados acumulados"}],ListPlot[data,PlotStyle->{Darker[Blue],PointSize[0.014]}]](*Graficamos toda la información, el mejor ajuste, el rango de confiabilidad, y los datos*)

Datos COVID - 19 Mx (https://www.worldometers.info/coronavirus/country/mexico/)
Nuevos infectados - Recuperados - Muertos

(*Datos Covid-19 México, en la primer columna se encuentra la fecha, en la segunda los infectados confirmados, y en la tercera los fallecidos*)

covidmx={{DateObject[{2020,2,28}],2,0},{DateObject[{2020,2,29}],4,0},{DateObject[{2020,3,1}],5,0},{DateObject[{2020,3,2}],6,0,0},{DateObject[{2020,3,3}],6,0},{DateObject[{2020,3,4}],6,0},{DateObject[{2020,3,5}],6,0},{DateObject[{2020,3,6}],6,,0},{DateObject[{2020,3,7}],6,0},{DateObject[{2020,3,8}],7,0},{DateObject[{2020,3,9}],7,0},{DateObject[{2020,3,10}],7,0},{DateObject[{2020,3,11}],11,0},{DateObject[{2020,3,12}],12,0},{DateObject[{2020,3,13}],15,0},{DateObject[{2020,3,14}],26,0},{DateObject[{2020,3,15}],44,0},{DateObject[{2020,3,16}],54,0},{DateObject[{2020,3,17}],84,0},{DateObject[{2020,3,18}],95,0},{DateObject[{2020,3,19}],121,0},{DateObject[{2020,3,20}],168,1},{DateObject[{2020,3,21}],208,2},{DateObject[{2020,3,22}],258,2},{DateObject[{2020,3,23}],325,0,3},{DateObject[{2020,3,24}],378,4},{DateObject[{2020,3,25}],417,5},{DateObject[{2020,3,26}],489,6},{DateObject[{2020,3,27}],603,8},{DateObject[{2020,3,28}],739,31,12},{DateObject[{2020,3,29}],874,16},{DateObject[{2020,3,30}],1024,20},{DateObject[{2020,3,31}],1128,28},{DateObject[{2020,4,1}],1253,29},{DateObject[{2020,4,2}],1421,37},{DateObject[{2020,4,3}],1557,50},{DateObject[{2020,4,4}],1741,60},{DateObject[{2020,4,5}],1950,80},{DateObject[{2020,4,6}],2211,95},{DateObject[{2020,4,7}],2517,127},{DateObject[{2020,4,8}],2874,144},{DateObject[{2020,4,9}],3283,178},{DateObject[{2020,4,10}],3551,199},{DateObject[{2020,4,11}],3967,239},{DateObject[{2020,4,12}],4354,280},{DateObject[{2020,4,13}],4810,304},{DateObject[{2020,4,14}],5174,341},{DateObject[{2020,4,15}],5571,417},{DateObject[{2020,4,16}],6034,461},{DateObject[{2020,4,17}],6499,499},{DateObject[{2020,4,18}],7096,561},{DateObject[{2020,4,19}],7738,668},{DateObject[{2020,4,20}],8527,705},{DateObject[{2020,4,21}],9055,732},{DateObject[{2020,4,22}],9808,882},{DateObject[{2020,4,23}],10855,999},{DateObject[{2020,4,24}],12009,1101},{DateObject[{2020,4,25}],13288,1258},{DateObject[{2020,4,26}],14289,1345},{DateObject[{2020,4,27}],15151,1393},{DateObject[{2020,4,28}],16031,1479},{DateObject[{2020,4,29}],17294,1618},{DateObject[{2020,4,30}],18375,1786},{DateObject[{2020,5,1}],19846,1917},{DateObject[{2020,5,2}],21410,2034},{DateObject[{2020,5,3}],22803,2126},{DateObject[{2020,5,4}],24231,2222},{DateObject[{2020,5,5}],25711,2343},{DateObject[{2020,5,6}],26867,2587},{DateObject[{2020,5,7}],28528,2791},{DateObject[{2020,5,8}],30574,3056},{DateObject[{2020,5,9}],32542,3262},{DateObject[{2020,5,10}],34543,3461},{DateObject[{2020,5,11}],36156,3577},{DateObject[{2020,5,12}],37503,3689},{DateObject[{2020,5,13}],39565,4054},{DateObject[{2020,5,14}],41487,4358},{DateObject[{2020,5,15}],43974,4623},{DateObject[{2020,5,16}],46490,4923},{DateObject[{2020,5,17}],48670,5210},{DateObject[{2020,5,18}],50812,5346},{DateObject[{2020,5,19}],53304,5506},{DateObject[{2020,5,20}],56105,5851},{DateObject[{2020,5,21}],58426,6289},{DateObject[{2020,5,22}],61495,6723},{DateObject[{2020,5,23}],64551,7218},{DateObject[{2020,5,24}],67988,7414},{DateObject[{2020,5,25}],70842,7636},{DateObject[{2020,5,26}],73408,7883},{DateObject[{2020,5,27}],76975,8401},{DateObject[{2020,5,28}],80550,8879},{DateObject[{2020,5,29}],84037,9341},{DateObject[{2020,5,30}],87369,9724},{DateObject[{2020,5,31}],90348,10100},{DateObject[{2020,6,1}],93602,10256},{DateObject[{2020,6,2}],96463,10501},{DateObject[{2020,6,3}],100480,10987},{DateObject[{2020,6,4}],104519,12115},{DateObject[{2020,6,5}],109105,12958},{DateObject[{2020,6,6}],113592,13604},{DateObject[{2020,6,7}],117302,13956},{DateObject[{2020,6,8}],120899,14150},{DateObject[{2020,6,9}],123995,14516},{DateObject[{2020,6,10}],128330,15132},{DateObject[{2020,6,11}],133371,15863},{DateObject[{2020,6,12}],138316,16469},{DateObject[{2020,6,13}],143707,16990},{DateObject[{2020,6,14}],147314,17428},{DateObject[{2020,6,15}],151595,17706},{DateObject[{2020,6,16}],155133,18159},{DateObject[{2020,6,17}],159881,18913},{DateObject[{2020,6,18}],164971,19708},{DateObject[{2020,6,19}],170817,20397},{DateObject[{2020,6,20}],176010,21065},{DateObject[{2020,6,21}],180880,21465},{DateObject[{2020,6,22}],186396,22543},{DateObject[{2020,6,23}],191121,23327},{DateObject[{2020,6,24}],197613,24146},{DateObject[{2020,6,25}],203226,25124},{DateObject[{2020,6,26}],209528,25884},{DateObject[{2020,6,27}],215145, 26627},{DateObject[{2020,6,28}],219698,27249},{DateObject[{2020,6,29}],223879,27525},{DateObject[{2020,6,30}],227807, 28014},{DateObject[{2020,7,1}],233415,28683},{DateObject[{2020,7,2}],239280,29448},{DateObject[{2020,7,3}],246240, 30149},{DateObject[{2020,7,4}],253199, 30825},{DateObject[{2020,7,5}],260337, 31365},{DateObject[{2020,7,6}],265172, 31647},{DateObject[{2020,7,7}],270233, 32143},{DateObject[{2020,7,8}],276694,33068},{DateObject[{2020,7,9}],283916,33876},{DateObject[{2020,7,10}],291432, 34630},{DateObject[{2020,7,11}],298546, 35317},{DateObject[{2020,7,12}],304838, 35874},{DateObject[{2020,7,13}],309465, 36159},{DateObject[{2020,7,14}],314302,36660},{DateObject[{2020,7,15}],321582, 37524},{DateObject[{2020,7,16}],327930,38122},{DateObject[{2020,7,17}],334544, 38812},{DateObject[{2020,7,18}],342036, 39572},{DateObject[{2020,7,19}],349898, 40169},{DateObject[{2020,7,20}],355381, 40475},{DateObject[{2020,7,21}],360721, 40786},{DateObject[{2020,7,22}],367802, 41731},{DateObject[{2020,7,23}],374016,42547},{DateObject[{2020,7,24}],382728,43289},{DateObject[{2020,7,25}],390547,44050},{DateObject[{2020,7,26}],397517,44803},{DateObject[{2020,7,27}],403175,45119},{DateObject[{2020,7,28}],408309,45472},{DateObject[{2020,7,29}],415751,46354},{DateObject[{2020,7,30}],421690,46855},{DateObject[{2020,7,31}],429671,47515},{DateObject[{2020,8,1}],438403,48226},{DateObject[{2020,8,2}],448269,49036},{DateObject[{2020,8,3}],453279,49319},{DateObject[{2020,8,4}],458201,49594},{DateObject[{2020,8,5}],464548,50479},{DateObject[{2020,8,6}],470886,51335},{DateObject[{2020,8,7}],477690,52181},{DateObject[{2020,8,8}],484625,53001},{DateObject[{2020,8,9}],491331,53719},{DateObject[{2020,8,10}],495849,54021},{DateObject[{2020,8,11}],501587,54749},{DateObject[{2020,8,12}],508490,55706},{DateObject[{2020,8,13}],514538,56467},{DateObject[{2020,8,14}],522148,57115},{DateObject[{2020,8,15}],527948,57750},{DateObject[{2020,8,16}],534499,58406},{DateObject[{2020,8,17}],539091,58627},{DateObject[{2020,8,18}],542778,58902},{DateObject[{2020,8,19}],548463,59678},{DateObject[{2020,8,20}],554443,60408},{DateObject[{2020,8,21}],561438,61054},{DateObject[{2020,8,22}],567558,61575},{DateObject[{2020,8,23}],574250,62240},{DateObject[{2020,8,24}],578326,62473},{DateObject[{2020,8,25}],581982,62804},{DateObject[{2020,8,26}],587057,63475},{DateObject[{2020,8,27}],592495,64122},{DateObject[{2020,8,28}],598716,64657},{DateObject[{2020,8,29}],604729,65227},{DateObject[{2020,8,30}],610897,65922},{DateObject[{2020,8,31}],615160,66272},{DateObject[{2020,9,1}],619000,66536},{DateObject[{2020,9,2}],625686,67390},{DateObject[{2020,9,3}],630767,67984},{DateObject[{2020,9,4}],636897,68514},{DateObject[{2020,9,5}],643294,69053},{DateObject[{2020,9,6}],649818,69544},{DateObject[{2020,9,7}],654582,69784},{DateObject[{2020,9,8}],658181,70014},{DateObject[{2020,9,9}],663706,70740},{DateObject[{2020,9,10}],668504,71371},{DateObject[{2020,9,11}],673518,71943},{DateObject[{2020,9,12}],679645,72495},{DateObject[{2020,9,13}],685503,72930},{DateObject[{2020,9,14}],690054,73154},{DateObject[{2020,9,15}],693497,73390},{DateObject[{2020,9,16}],698423,74040},{DateObject[{2020,9,17}],703011,74350},{DateObject[{2020,9,18}],706296,74558},{DateObject[{2020,9,19}],711294,75203},{DateObject[{2020,9,20}],716629,75673},{DateObject[{2020,9,21}],720286,75916},{DateObject[{2020,9,22}],723298,76127},{DateObject[{2020,9,23}],728133,76800},{DateObject[{2020,9,24}],733074,77421},{DateObject[{2020,9,25}],738657,77927},{DateObject[{2020,9,26}],744233,78345},{DateObject[{2020,9,27}],749987,78757},{DateObject[{2020,9,28}],753999,78950},{DateObject[{2020,9,29}],757509,79129},{DateObject[{2020,9,30}],762099,79707}};

Ecuación logística México. Figura 6.36

Clear[r,t,tc,K](*Con el comando Clear se borran los valores anteriores de las variables especificadas*)

dia=Table[DateList[covidmx[[i,1]]],{i,1,Length[covidmx]}];(*Con el comando DateList se hace una serie de tiempo de la fecha*)

mxcc=Table[{dia[[i]],covidmx[[i,2]]},{i,1,Length[covidmx]}](*Extaraemos de los datos el número de infectados acumulados por fecha*);

DateListPlot[mxcc,Joined->False,PlotLegends->{"Casos acumulados"}](*Con DateListPlot se grafican las series de tiempo*)

data=Table[{i,covidmx[[i,2]]},{i,1,Length[covidmx]}];(*Asignamos los datos a una lista, para poder hacer el ajuste, en lugar de la fecha enumeramos los días*)

mxNLM=NonlinearModelFit[data,K/(1+(E^(-r(t-tc)))),{{r,0.03},{K,500000},{tc,150}},t](*Con el comando NonlinearModelFit podemos obtener los parámetros del mejor ajuste, la ecución que se quiere ajustar tiene que ser incluida*);

mxNLM@"ParameterConfidenceIntervalTable"(*Obtenemos los valores encontrados para el mejor ajuste*)

mxNLM@"RSquared"(*Coeficiente de determinación*)

vals=mxNLM["ParameterTableEntries"]

bands90[t_]:=mxNLM["SinglePredictionBands",ConfidenceLevel->.90](*Encontramos los valores con una confiabilidad del 90%*);

f[t_]=Normal[mxNLM](*Le asiganamos una ecuación a nuestro ajuste*)

bandsconf=Table[bands90[t],{t,0,300}];(*Hacemos una tabla de los valores de confiabilidad*)

bandsconf1=TimeSeries[Table[bandsconf[[i,1]],{i,1,Length[bandsconf]}],{"February 28, 2020"}];(*Generamos un serie de tiempo para la banda de confiabilidad*)

bandsconf2=TimeSeries[Table[bandsconf[[i,2]],{i,1,Length[bandsconf]}],{"February 28, 2020"}];(*Generamos un serie de tiempo para la banda de confiabilidad*)

Show[DateListStepPlot[{TimeSeries[Table[f[i],{i,1,300}],{"February 28, 2020"}],bandsconf1},PlotStyle->{Thickness[0.008],Thickness[0.0035]},Frame->True,GridLines->Automatic,FrameLabel->{"Fecha","Nuevos Infectados acumulados"}],DateListStepPlot[{TimeSeries[Table[f[i],{i,1,300}],{"February 28, 2020"}],bandsconf2}],DateListPlot[Table[{dia[[i]],data[[i,2]]},{i,1,Length[data]}],Mesh->Full,MeshStyle->Directive[PointSize[0.014],Darker[Blue]]]](*Graficamos toda la información, el mejor ajuste, el rango de confiabilidad, y los datos*)

Ecuación logística México. Figura 6.37

DateListPlot[Table[{dia[[i]],data[[i+1,2]]-data[[i,2]]},{i,1,Length[data]-1}],FrameLabel->{"Fecha","Positivos infectados"},PlotTheme->"Detailed",PlotStyle->{Thickness[0.007]}](*Generamos los datos de los infectados por día a partir de los acumulados y los graficamos*)

Clear[r,t,tc,K](*Con el comando Clear se borran los valores anteriores de las variables especificadas*)

datadiarios=Table[{i,data[[i+1,2]]-data[[i,2]]},{i,1,Length[data]-1}];(*Generamos una tabla con los datos de los infectados por día a partir de los acumulados para poder hacer el ajuste*)

modelSig=(((E^(-r (t-tc))) K r)/(((1+(E^(-r (t-tc)))))^2))(*Derivada de la ecuación Logística, que representa los nuevos infectados por día*)

mxSig=NonlinearModelFit[datadiarios,modelSig,{{r,0.065},{K,226105},{tc,100}},t];(*Con el comando NonlinearModelFit podemos obtener los parámetros del mejor ajuste, la ecución que se quiere ajustar tiene que ser incluida*)

mxSig@"ParameterConfidenceIntervalTable"(*Obtenemos los valores encontrados para el mejor ajuste*)

mxSig@"RSquared"(*Coeficiente de determinación*)

infSig[t_]=Normal[mxSig](*Le asiganamos una ecuación a nuestro ajuste*)

bands90[t_]=mxSig["MeanPredictionBands",ConfidenceLevel->.9];(*Hacemos una tabla de los valores de confiabilidad*)

Show[Plot[{infSig[t],bands90[t]},{t,0,300},PlotRange->{0,10500},Filling->{2->{1}},PlotStyle->{Thickness[0.008],Thickness[0.0035]},Frame->True,GridLines->Automatic,FrameLabel->{"Días","Nuevos infectados"},PlotLegends->{"model", "90% confidence bands"}],ListPlot[datadiarios,PlotStyle->{Darker[Blue],PointSize[0.014]}]](*Graficamos toda la información, el mejor ajuste, el rango de confiabilidad, y los datos*)

Gompertz México. Figura 6.38

Clear[K,c,r,t](*Con el comando Clear se borran los valores anteriores de las variables especificadas*)

data=Table[{i,covidmx[[i,2]]},{i,1,Length[covidmx]}];(*Asignamos los datos a una lista*)

mxNLM=NonlinearModelFit[data,K (E^(-c (E^(-r t)))),{K,c,r},t](*Con el comando NonlinearModelFit podemos obtener los parámetros del mejor ajuste, la ecución que se quiere ajustar tiene que ser incluida*);

mxNLM@"ParameterConfidenceIntervalTable"(*Obtenemos los valores encontrados para el mejor ajuste*)

mxNLM@"RSquared"(*Coeficiente de determinación*)

bands90[t_]:=mxNLM["SinglePredictionBands",ConfidenceLevel->.90];(*Encontramos los valores con una confiabilidad del 90%*)

vals=mxNLM["ParameterTableEntries"]

f[t_]=Normal[mxNLM](*Le asiganamos una ecuación a nuestro ajuste*)

bandsconf=Table[bands90[t],{t,0,360}];(*Hacemos una tabla de los valores de confiabilidad*)

bandsconf1=TimeSeries[Table[bandsconf[[i,1]],{i,1,Length[bandsconf]}],{"February 28, 2020"}];(*Generamos un serie de tiempo para la banda de confiabilidad*)

bandsconf2=TimeSeries[Table[bandsconf[[i,2]],{i,1,Length[bandsconf]}],{"February 28, 2020"}];(*Generamos un serie de tiempo para la banda de confiabilidad*)

Show[DateListStepPlot[{TimeSeries[Table[f[i],{i,1,360}],{"February 28, 2020"}],bandsconf1},PlotStyle->{Thickness[0.008],Thickness[0.0035]},Frame->True,GridLines->Automatic,FrameLabel->{"Fecha","Nuevos Infectados acumulados"}],DateListStepPlot[{TimeSeries[Table[f[i],{i,1,360}],{"February 28, 2020"}],bandsconf2}],DateListPlot[Table[{dia[[i]],data[[i,2]]},{i,1,Length[data]}],Mesh->Full,MeshStyle->Directive[PointSize[0.014],Darker[Blue]]]](*Graficamos toda la información, el mejor ajuste, el rango de confiabilidad, y los datos*)

Valor máximo

c=vals[[2,1]];r=vals[[3,1]];

N[Log[c]/r](*relación que nos da el valor máximo predicho por el mejor ajuste*)

DateObject[{2020,2,28}]+LinguisticAssistant

Gompertz México. Figura 6.39

Clear[K,c,r,t](*Con el comando Clear se borran los valores anteriores de las variables especificadas*)

datadiarios=Table[{i,data[[i+1,2]]-data[[i,2]]},{i,1,Length[data]-1}];(*Generamos los datos de los infectados por día a partir de los acumulados*)

D[K (E^(-c (E^(-r t)))),t](*Calculamos la derivada de la ecuación de Gompertz que nos da los nuevos infectados por día*)

GomNLM=NonlinearModelFit[datadiarios,c (E^(-c (E^(-r t))-r t)) K r,{K,{c,10},{r,0.015}},t];(*Con el comando NonlinearModelFit podemos obtener los parámetros del mejor ajuste, la ecución que se quiere ajustar tiene que ser incluida*)

GomNLM@"ParameterConfidenceIntervalTable"(*Obtenemos los valores encontrados para el mejor ajuste*)

GomNLM@"RSquared"(*Coeficiente de determinación*)

vals=GomNLM["ParameterTableEntries"]

bands90[t_]:=GomNLM["SinglePredictionBands",ConfidenceLevel->.90];(*Encontramos los valores con una confiabilidad del 90%*)

fd[t_]=Normal[GomNLM](*Le asiganamos una ecuación a nuestro ajuste*)

Show[Plot[{fd[t],bands90[t]},{t,0,250},Filling->{2->{1}},PlotRange->{0,10500},PlotStyle->{Thickness[0.008],Thickness[0.0035]},Frame->True,GridLines->Automatic,FrameLabel->{"Días","Nuevos infectados"},PlotLegends->{"model", "90% confidence bands"}],ListPlot[datadiarios,PlotStyle->{Darker[Blue],PointSize[0.014]}]](*Graficamos toda la información, el mejor ajuste, el rango de confiabilidad, y los datos*)

Valor máximo

c=vals[[2,1]];r=vals[[3,1]];

N[Log[c]/r](*Relación que nos da el valor máximo predicho por el mejor ajuste*)

DateObject[{2020,2,28}]+LinguisticAssistant

Gompertz México. Figura 6.40

dia=Table[DateList[covidmx[[i,1]]],{i,1,Length[covidmx]}];(*Con el comando DateList se hace una serie de tiempo de la fecha*)

mxde=Table[{dia[[i]],covidmx[[i,3]]},{i,1,Length[covidmx]}](*Extaraemos los datos el número de fallecidos acumulados*);

DateListPlot[mxde,Joined->False,PlotStyle->{Darker[Red],Thickness[0.01]},PlotLegends->{"Acumulado de defunciones"}](*Generamos los datos de los fallecidos acumulados y los graficamos*)

Clear[K,c,r,i](*Con el comando Clear se borran los valores anteriores de las variables especificadas*)

datamxmr=Table[{i,covidmx[[i,3]]},{i,9,Length[covidmx]}];(*Generamos los datos de los fallecidos acumulados*)

GomNLM=NonlinearModelFit[datamxmr,K (E^(-c (E^(-r t)))),{K,{c,10},{r,0.15}},t];(*Con el comando NonlinearModelFit podemos obtener los parámetros del mejor ajuste, la ecución que se quiere ajustar tiene que ser incluida*)

GomNLM@"ParameterConfidenceIntervalTable"(*Obtenemos los valores encontrados para el mejor ajuste*)

GomNLM@"RSquared"(*Coeficiente de determinación*)

vals=GomNLM["ParameterTableEntries"]

bands90[t_]:=GomNLM["SinglePredictionBands",ConfidenceLevel->.90];(*Encontramos los valores con una confiabilidad del 90%*)

f[t_]=Normal[GomNLM](*Le asiganamos una ecuación a nuestro ajuste*)

Show[Plot[{f[t],bands90[t]},{t,0,250},Filling->{2->{1}},PlotStyle->{Red,Thickness[0.008],Thickness[0.0035]},Frame->True,GridLines->Automatic,FrameLabel->{"Días","Acumulado de defunciones"},PlotLegends->{"model", "90% confidence bands"}],ListPlot[datamxmr,PlotStyle->{Darker[Red],PointSize[0.014]}]](*Graficamos toda la información, el mejor ajuste, el rango de confiabilidad, y los datos*)

Valor máximo

c=vals[[2,1]];r=vals[[3,1]];

N[Log[c]/r](*Relación que nos da el valor máximo predicho por el mejor ajuste*)

DateObject[{2020,3,18}]+LinguisticAssistant

Gompertz México. Figura 6.42

exmotc={{13,-289},{14,-253},{15,506},{16,1192},{17,3144},{18,4879},{19,7446},{20,8132},{21,9253},{21,9145},{23,10048},{24,10843},{25,10337},{26,10482},{27,11277},{28,12036},{29,13229},{30,11747},{31,10048},{32,9651},{32,8385},{34,7554},{35,6470},{36,5277},{37,3759},{38,2855},{39,3253}};(*Datos del exceso de defunciones por semana en México*)

ac=Accumulate[Table[exmotc[[i,2]],{i,1,Length[exmotc]}]];(*Acumulado de exceso de defunciones por semana*)

acexmotc=Table[{i+12,ac[[i]]},{i,1,Length[ac]}];(*Se hace una table de los acumulados por semana, se inicia en la semana 13*)

ListPlot[acexmotc,Joined->True,Mesh->All,FrameLabel->{"Semana epidemiológica","Exceso de defunciones acumuladas"},PlotTheme->"Detailed"]

Clear[a,b,c,t]

GomNLM=NonlinearModelFit[acexmotc,a (E^(-b (E^(-c t)))),{a,b,c},t];(*Con el comando NonlinearModelFit podemos obtener los parámetros del mejor ajuste, la ecución que se quiere ajustar tiene que ser incluida*)

GomNLM@"ParameterConfidenceIntervalTable"(*Obtenemos los valores encontrados para el mejor ajuste*)

GomNLM@"RSquared"(*Coeficiente de determinación*)

vals=GomNLM["ParameterTableEntries"]

bands90[t_]:=GomNLM["SinglePredictionBands",ConfidenceLevel->.90];(*Encontramos los valores con una confiabilidad del 90%*)

f[t_]=Normal[GomNLM](*Le asiganamos una ecuación a nuestro ajuste*)

Show[Plot[{f[t],bands90[t]},{t,13,52},Filling->{2->{1}},PlotStyle->{Thickness[0.009],Thickness[0.0035]},Frame->True,GridLines->Automatic,FrameLabel->{"Semana","Exceso de defunciones acumuladas"},PlotLegends->{"model", "90% confidence bands"}],ListPlot[acexmotc,PlotStyle->{Darker[Blue],PointSize[0.014]}]](*Graficamos toda la información, el mejor ajuste, el rango de confiabilidad, y los datos*)

Predicción de exceso de defunciones para la semana 52

f[52](*Valor del exceso de defunciones proyectado a la semana 52*)

Table[bands90[t],{t,51,52}](*Se obtienen los valores a la semana 52 con un 90% de confianza*)

Valor máximo en la semana 13 + 14 = 27

b=vals[[2,1]];c=vals[[3,1]];(*Se calcula la semana con el valor máximo del exceso de dunciones predicho por el ajuste*)

Log[b]/c

DateObject[{2020,3,24}]+LinguisticAssistant

Modelo SI

Figura 7.43

β=1;s0=0.01;(*Damos valores a β y (Subscript[s, 0])*)

Plot[{1-(( 1)/(1+((1/s0)-1)(E^(-β t)))),(( 1)/(1+((1/s0)-1)(E^(-β t))))},{t,0,10},(*Introducimos las ecuaciones para S e I de (9.4) y (9.5)*)
Frame->True,PlotRange->All,Frame->True,FrameLabel->{"Tiempo","Población"},PlotStyle->{Thickness[0.008]},PlotLegends->Placed[{"s(t)","i(t)"},{0.85,0.65}]]

Figura 7.44

s0=0.01;(*Damos el valor inicial de (Subscript[s, 0])*)

Plot[{(( 1)/(1+((1/s0)-1)(E^(-0.5 t)))),(( 1)/(1+((1/s0)-1)(E^(-1 t)))),(( 1)/(1+((1/s0)-1)(E^(-2 t))))},{t,0,18},(*introducimos las ecuaciones para I a partir de (9.4)*)
Frame->True,PlotRange->All,Frame->True,FrameLabel->{"Tiempo","Infectados"},PlotStyle->{{RGBColor[0.880722, 0.611041, 0.142051],Thickness[0.007]},{DotDashed,RGBColor[0.880722, 0.611041, 0.142051],Thickness[0.007]},{Dashed,RGBColor[0.880722, 0.611041, 0.142051],Thickness[0.007]}},PlotLegends->Placed[{"β=0.5","β=1.0","β=2.0"},{0.82,0.55}]]

Modelo SIS

Figura 8.45

f[R0_]:=If[ R0<1,0,1-(1/R0)];(*Definimos la función f=1-(1/R0) de la ecuación (10.8). Para valores monores que (SuperStar[i]),definimmos el valor de la función igual a cero ya que si no lo hacemos nos daría valores negativos sin significado físico*)

Show[(*Con el comando Show se pueden mostrar más de una gráfica e incluso imprimir información sobre ésta*)Plot[{f[R0]},{R0,0,5}(*Con el comando Plot se grafica una función*),Filling->{Axis}(*Con este comado se sombra por arriba y abajo de la función*),
Frame->True,PlotRange->All,Frame->True,FrameLabel->{"(Subscript[R, 0])","i"},PlotStyle->{Thickness[0.008]}],Graphics[(*Con el comando Graphics se pueden representar imágenes en dos dimensiones, con este comando pondremos un ponto rojo con el valor (SuperStar[n])/N*){{PointSize[Large],Red,Point[{1,0}]}},Axes->False,Ticks->None]]

Figura 8.48

DSolve[{i'[t]==β i[t](k-i[t]),i[0]==y0},i[t],t](*Resolvemos la ecuación diferencial (10.2)*)

β=2;δ=0.1;i0=0.01;(*damos valores a β, δ y (Subscript[i, 0])*)

N[β/δ,2](*Calculamos el valor de (Subscript[R, 0])*)

Show[Plot[{1-(( (E^((β-δ)t))(1-(δ/β))i0)/(i0 (E^((β-δ)t))+(1-(δ/β))-i0)),(( (E^((β-δ)t))(1-(δ/β))i0)/(i0 (E^((β-δ)t))+(1-(δ/β))-i0))},{t,0,10},(*introducimos las ecuaciones para s e i de (10.4)*)
Frame->True,PlotRange->All,Frame->True,FrameLabel->{"Tiempo","Población"},PlotStyle->{Thickness[0.008]},PlotLegends->Placed[{"s(t)","i(t)"},{0.85, 0.7}]],Graphics[{Inset["(Subscript[R, 0]) =",{5,0.7}],Inset[N[β/δ],{5.7,0.7}]},Axes->False,Ticks->None]]

Figura 8.49

β=0.2;δ=0.1;i0=0.01;(*damos valores a β, δ y (Subscript[i, 0])*)

N[β/δ](*Calculamos el valor de (Subscript[R, 0])*)

Show[Plot[{1-(( (E^((β-δ)t))(1-(δ/β))i0)/(i0 (E^((β-δ)t))+(1-(δ/β))-i0)),(( (E^((β-δ)t))(1-(δ/β))i0)/(i0 (E^((β-δ)t))+(1-(δ/β))-i0))},{t,0,100},(*introducimos las ecuaciones para s e i de (10.4)*)
Frame->True,PlotRange->All,Frame->True,FrameLabel->{"Tiempo","Población"},PlotStyle->{Thickness[0.008]},PlotLegends->Placed[{"s(t)","i(t)"},{0.85, 0.8}]],Graphics[{Inset["(Subscript[R, 0]) =",{55,0.9}],Inset[N[β/δ],{61,0.9}]},Axes->False,Ticks->None]]

Figura 8.50

β=0.1;δ=2;i0=0.4;(*damos valores a β, δ y (Subscript[i, 0])*)

N[β/δ](*Calculamos el valor de (Subscript[R, 0])*)

Show[Plot[{1-(( (E^((β-δ)t))(1-(δ/β))i0)/(i0 (E^((β-δ)t))+(1-(δ/β))-i0)),(( (E^((β-δ)t))(1-(δ/β))i0)/(i0 (E^((β-δ)t))+(1-(δ/β))-i0))},{t,0,10},(*introducimos las ecuaciones para s y i de (10.4)*)
Frame->True,PlotRange->All,Frame->True,FrameLabel->{"Tiempo","Población"},PlotStyle->{Thickness[0.008]},PlotLegends->Placed[{"s(t)","i(t)"},{0.85,0.65}]],Graphics[{Inset["(Subscript[R, 0]) =",{5,0.8}],Inset[N[β/δ],{5.8,0.8}]},Axes->False,Ticks->None]]

Modelo SIR

Figura 9.51

sol=With[{β=0.1,γ=0.01},(*Damos el valor inicial de las constantes*)With[{s0=0.99,i0=0.01},(*dDamos los valores inciciale de las variables para resolver el sistema de ecuaciones diferenciales (11.1) y (11.2) numericamente*)NDSolve[{s'[t]==-β s[t]i[t],i'[t]==β s[t]i[t]-γ  i[t],s[0]==s0,i[0]==i0},{s[t],i[t]},{t,0,600}]]](*con el comando NDSolve se resuelve el sistema de ecuaciones numericamente*)

β=0.1;γ=0.01;N[β/γ,2](*Calculamos el valor de (Subscript[R, 0])*)

Show[Plot[Evaluate[{s[t],i[t],1-s[t]-i[t]}/.sol],{t,0,500},PlotRange->All,Frame->True,FrameLabel->{"Tiempo","Población"},PlotStyle->{Thickness[0.008]},PlotLegends->Placed[{"s(t)","i(t)","r(t)"}, {0.85, 0.55}]],Graphics[{Inset["(Subscript[R, 0]) =",{100,0.9}],Inset[N[β/γ],{133,0.9}]},Axes->False,Ticks->None]](*Graficamos la solución numérica de (11.1) y (11.2)*)

Figura 9.52

sol=With[{β=0.05,γ=0.1},(*damos el valor inicial de las constantes*)With[{s0=0.99,i0=0.01},(*damos los valores inciciale de las variables para resolver el sistema de ecuaciones diferenciales*)NDSolve[{s'[t]==-β s[t]i[t],i'[t]==β s[t]i[t]-γ  i[t],s[0]==s0,i[0]==i0},{s[t],i[t]},{t,0,600}]]](*con el comando NDSolve se resuelve el sistema de ecuaciones (11.1) y (11.2) numericamente*)

β=0.05;γ=0.1;N[β/γ,2](*Calculamos el valor de (Subscript[R, 0])*)

Show[Plot[Evaluate[{s[t],i[t],1-s[t]-i[t]}/.sol],{t,0,500},PlotRange->All,Frame->True,FrameLabel->{"Tiempo","Población"},PlotStyle->{Thickness[0.008]},PlotLegends->Placed[{"s(t)","i(t)","r(t)"}, {0.85, 0.5}]],Graphics[{Inset["(Subscript[R, 0]) =",{120,0.7}],Inset[N[β/γ],{153,0.7}]},Axes->False,Ticks->None]](*Graficamos la solución numérica de (11.1) y (11.2)*)

Figura 9.53

sol=With[{β=0.1,γ=0.01},(*Damos el valor inicial de las constantes*)With[{s0=0.99,i0=0.01},(*dDamos los valores inciciale de las variables para resolver el sistema de ecuaciones diferenciales (11.1) y (11.2) numericamente*)NDSolve[{s'[t]==-β s[t]i[t],i'[t]==β s[t]i[t]-γ  i[t],s[0]==s0,i[0]==i0},{s[t],i[t]},{t,0,600}]]](*con el comando NDSolve se resuelve el sistema de ecuaciones numericamente*)

β=0.1;γ=0.01;N[β/γ,2](*Calculamos el valor de (Subscript[R, 0])*)

Show[Plot[{(( 1)/(1+((1/0.01)-1)(E^(-β t)))),(( (E^((β-γ)t))(1-(γ/β))0.01)/(0.01 (E^((β-γ)t))+(1-(γ/β))-0.01)),Evaluate[{i[t]}/.sol]},{t,0,500},PlotRange->All,Frame->True,FrameLabel->{"Tiempo","Infetados"},PlotStyle->{{Orange, Dashed,Thickness[0.008]},{Red, Dashed,Thickness[0.008]},{Brown, Dashed,Thickness[0.008]}},PlotLegends->Placed[{"SI","SIS","SIR"}, {0.85, 0.55}]],Graphics[{Inset["(Subscript[R, 0]) =",{110,0.1}],Inset[N[β/γ],{143,0.1}]},Axes->False,Ticks->None]](*Graficamos (9.8), (10.4) y la solución numérica de (11.2)*)

Espacio fase Figura 9.54

k=1; (*Con este contador vamos a generar diferentes curvas para diferentes condiciones iniciales*)
i0=0.1;β=3;γ=1;(*Definimos el valor inicial de los infectados y los valores de β y γ*)
tot=Plot[1-x,{x,0,1},PlotRange->{{0,1},{0,1}},Frame->True,FrameLabel->{"Susceptibles","Infectados"},PlotStyle->{Red,Thick},AspectRatio->1];(*Con esta gráfica mostraremos el valor máximo de i(t)+s(t)=1*)
pimax=Graphics[{Gray,Line[{{γ/β,0},{γ/β,1-(γ/β)}}]}](*Con esta gráfica mostraremos el valor máximo de i*);
While[k≤9,(*Contador para generar las gráficas*)
s0=1-i0;
eqns={s'[t]==-β i[t]s[t],(*Sistemas de ecuaciones diferenciales*)
 i'[t]==β i[t]s[t]-γ i[t],
 i[0]==i0,s[0]==s0};
vars={s,i};(*Variables, infectados y susceptibles*)
solns=NDSolve[eqns,vars,{t,0,50}];(*Solución númerica de la ecuación diferencial*)
plot[k]=ParametricPlot[{s[t],i[t]}/.solns,{t,0,50},PlotStyle->{Orange,Thick}];
i0=i0+0.1;k=k+1];(*Se generanlas gráficas de infectados en funcón de los susceptibles*)
Show[tot,pimax,plot[1],plot[2],plot[3],plot[4],plot[5],plot[6],plot[7],plot[8],plot[9](*Se muestran las diferentes gráficas*)
,Graphics[{Inset["(Subscript[R, 0]) = ",{0.75,0.9}],Inset[N[β/γ],{0.8,0.9}]},Axes->False,Ticks->None](*Se imprime el valor de (Subscript[R, 0])*),Graphics[{Inset["(Subscript[i, 0])",{0.48,0.58}]},Axes->False,Ticks->None](*Se imprime el valor de (Subscript[i, 0])*),Graphics[{Inset["(Subscript[i, max])",{0.39,0.035}]},Axes->False,Ticks->None](*Se imprime el valor de (Subscript[i, 0])*)]

Espacio fase Figura 9.55

k=1; (*Con este contador vamos a generar diferentes curvas para diferentes condiciones iniciales*)
i0=0.1;β=1;γ=10;(*Definimos el valor inicial de los infectados y los valores de β y γ*)
tot=Plot[1-x,{x,0,1},PlotRange->{{0,1},{0,1}},Frame->True,FrameLabel->{"Susceptibles","Infectados"},PlotStyle->{Red,Thick},AspectRatio->1,GridLinesStyle->Directive[Gray,Dashed],GridLines->Automatic];(*Con esta gráfica mostraremos el valor máximo de i(t)+s(t)=1*)
While[k≤9,(*contador para generar las gráficas*)
s0=1-i0;
eqns={s'[t]==-β i[t]s[t],(*Sistemas de ecuaciones diferenciales*)
 i'[t]==β i[t]s[t]-γ i[t],
 i[0]==i0,s[0]==s0};
vars={s,i};(*Variables, infectados y susceptibles*)
solns=NDSolve[eqns,vars,{t,0,50}];(*Solución númerica de la ecuación diferencial*)
plot[k]=ParametricPlot[{s[t],i[t]}/.solns,{t,0,50},PlotStyle->{Orange,Thick}];
i0=i0+0.1;k=k+1];(*Se generanlas gráficas de infectados en funcón de los susceptibles*)
Show[tot,plot[1],plot[2],plot[3],plot[4],plot[5],plot[6],plot[7],plot[8],plot[9](*Se muestran las diferentes gráficas*)
,Graphics[{Inset["(Subscript[R, 0]) = ",{0.7,0.9}],Inset[N[β/γ],{0.76,0.9}]},Axes->False,Ticks->None](*Se imprime el valor de (Subscript[R, 0])*),Graphics[{Inset["(Subscript[i, 0])",{0.49,0.55}]},Axes->False,Ticks->None](*Se imprime el valor de (Subscript[i, 0])*)]

(Subscript[R, 0]) Figura 9.56

Plot[1-(1+ Log[x])/(x),{x,1,20},PlotRange->All,Frame->True,FrameLabel->{"(Subscript[R, 0])","Fracción de máximo de infactados"},PlotStyle->{Thickness[0.008]}](*Con el comando Plor graficamos la ecuación (11.18)*)

Internado en Inglaterra (1978). Figura 9.57

infectados={{1,1},{3,25},{4,75},{5,227},{6,296},{7,258},{8,236},{9,192},{10,126},{11,71},{12,28},{13,11},{14,7}};(*Tabla de infecatados diarios en el intenado*)

sol=With[{β=0.00218,γ=0.4405},(*Damos el valor inicial de las constantes*)With[{s0=762,i0=1},(*Damos los valores inciciale de las variables para resolver el sistema de ecuaciones diferenciales*)NDSolve[{s'[t]==-β s[t]i[t],i'[t]==β s[t]i[t]-γ  i[t],s[0]==s0,i[0]==i0},{s[t],i[t]},{t,0,15}]]](*Con el comando NDSolve se resuelve el sistema de ecuaciones (11.1)-(11.3) numericamente*)

Show[Plot[Evaluate[{s[t],i[t],762-s[t]-i[t]}/.sol],{t,0,15},PlotRange->All,Frame->True,FrameLabel->{"Días","Estudiantes infectados"},PlotStyle->{Thickness[0.008]},PlotLegends->Placed[{"S(t)","I(t)","R(t)"}, {0.87, 0.6}]],ListPlot[infectados,PlotStyle->{Red,PointSize[0.02]}]](*Graficamos toda la información, la solución numérica y los datos*)

Bombay, India (1908). Tabla 9.4

fallecidos={{1,11},{2,16},{3,18},{4,25},{6,54},{7,54},{9,130},{10,183},{11,296},{12,391},{13,446},{14,643},{14.8,769},{15,777},{16,705},{17,694},{18,868},{18.5,757},{19,928},{20,805},{21,583},{22,403},{23,348},{24,209},{25,113},{26,65},{27,49},{27.3,51},{27.8,39},{28,38},{28.8,27},{29,27},{30,31}};(*Tabla de fallecidos diarios en Bombay*)

TableForm[fallecidos,TableHeadings->{None,{"Semana","Muertos"}}](*Con el comando TableForm se despliga una lista en el modo tradicional. Con TableHeadings se puede etiquetar cada entrada*)

Bombay, India (1908). Figura 9.58

Show[Plot[890*(Sech[0.2 t - 3.4])^2,{t,0,30}(*Aproximación teórica dada por la ecuación (11.32)*),PlotRange->All,Frame->True,FrameLabel->{"Semana","Muertos/semana ≈ dR / dt"},PlotStyle->{ RGBColor[0.560181, 0.691569, 0.194885],Thickness[0.008]},PlotLegends->Placed[{"R(t)"}, {0.87, 0.6}]],ListPlot[fallecidos (*valores de la tabla 11.4*),PlotStyle->{RGBColor[0.28026441037696703, 0.715, 0.4292089322474965],PointSize[Large]}]]

SIR-v, el efecto de las vacunas

Figura 10.59

lv=With[{b=0.18,g=0.01,p=0.6},(*Damos el valor inicial de las constantes*)With[{s0=0.4,i0=0.01},(*Damos los valores inciciale de las variables para resolver el sistema de ecuaciones diferenciales (12.1) y (12.2) numericamente*)NDSolve[{s'[t]==-b (1-p)s[t]i[t],i'[t]==b (1-p)s[t]i[t]-g  i[t],s[0]==s0,i[0]==i0},{s[t],i[t]},{t,0,600}]]](*Con el comando NDSolve se resuelve el sistema de ecuaciones numericamente*)

Plot[Evaluate[{s[t],i[t],1-s[t]-i[t]}/.lv],{t,0,500},PlotRange->All,Frame->True,FrameLabel->{"Tiempo","Población"},PlotStyle->{Thickness[0.008]},PlotLegends->Placed[{"s(t)","i(t)","r(t)"},{Scaled[{0.75,0.55}], {0.1, 0.7}}]](*Graficamos la solución numérica de (12.1) y (12.2)*)

Figura 10.60

lv=With[{b=0.18,g=0.01,p=0.0},(*Damos el valor inicial de las constantes*)With[{s0=0.99,i0=0.01},(*Damos los valores inciciale de las variables para resolver el sistema de ecuaciones diferenciales (12.1) y (12.2) numericamente*)NDSolve[{s'[t]==-b (1-p)s[t]i[t],i'[t]==b (1-p)s[t]i[t]-g  i[t],s[0]==s0,i[0]==i0},{s[t],i[t]},{t,0,600}]]](*Con el comando NDSolve se resuelve el sistema de ecuaciones numericamente*)

Plot[Evaluate[{s[t],i[t],1-s[t]-i[t]}/.lv],{t,0,500},PlotRange->All,Frame->True,FrameLabel->{"Tiempo","Población"},PlotStyle->{Thickness[0.008]},PlotLegends->Placed[{"s(t)","i(t)","r(t)"},{Scaled[{0.75,0.55}], {0.1, 0.7}}]](*Graficamos la solución numérica de (12.1) y (12.2)con p=0*)

Modelo SIR endémico

Figura 11.64

sol=With[{β=0.1,γ=0.01,μ=0.01},(*Damos el valor inicial de las constantes*)With[{s0=0.99,i0=0.01},(*Damos los valores inciciale de las variables para resolver el sistema de ecuaciones diferenciales (13.1) y (13.2) numericamente*)NDSolve[{s'[t]==-β s[t]i[t]+ μ (1-s[t]),i'[t]==β s[t]i[t]-γ i[t]-μ i[t],s[0]==s0,i[0]==i0},{s[t],i[t]},{t,0,600}]]](*Con el comando NDSolve se resuelve el sistema de ecuaciones numericamente*)

β=0.1;γ=0.01;μ=0.01;N[β/(γ+μ),2](*(Subscript[R, 0])*)

Show[Plot[Evaluate[{s[t],i[t],1-s[t]-i[t]}/.sol],{t,0,500},PlotRange->All,Frame->True,FrameLabel->{"Tiempo","Población"},PlotStyle->{Thickness[0.008]},PlotLegends->Placed[{"s(t)","i(t)","r(t)"}, {0.85, 0.75}]],Graphics[{Inset["(Subscript[R, 0]) =",{100,0.9}],Inset[N[β/(γ+μ)],{133,0.9}]},Axes->False,Ticks->None]](*Graficamos la solución numérica de (13.1) y (13.2)*)

Espacio fase Figura 11.65

k=1; (*con este contador vamos a generar diferentes curvas para diferentes condiciones iniciales*)
i0=0.1;β=3;γ=1;(*definimos el valor inicial de los infectados y los valores de β y γ*)
tot=Plot[1-x,{x,0,1},PlotRange->{{0,1},{0,1}},Frame->True,FrameLabel->{"Susceptibles","Infectados"},PlotStyle->{Red,Thick},AspectRatio->1];(*con esta gráfica mostraremos el valor máximo de i(t)+s(t)=1*)
μ=0.1 ;(*tasa de mortalidad*)
While[k≤9,(*contador para generar las gráficas*)
s0=1-i0;
eqns={s'[t]==-β i[t]s[t]+μ(1-s[t]),(*sistemas de ecuaciones diferenciales*)
 i'[t]==β i[t]s[t]-(γ+μ) i[t],
 i[0]==i0,s[0]==s0};
vars={s,i};(*variables, infectados y susceptibles*)
solns=NDSolve[eqns,vars,{t,0,50}];(*solución númerica de la ecuación diferencial*)
plot[k]=ParametricPlot[{s[t],i[t]}/.solns,{t,0,50},PlotStyle->{Orange,Thick}];
i0=i0+0.1;k=k+1];(*se generanlas gráficas de infectados en funcón de los susceptibles*)
Show[tot,plot[1],plot[2],plot[3],plot[4],plot[5],plot[6],plot[7],plot[8],plot[9](*se muestran las diferentes gráficas*)
,Graphics[{Inset["(Subscript[R, 0]) = ",{0.7,0.8}],Inset[N[β/(μ+γ)],{0.8,0.8}]},Axes->False,Ticks->None](*se imprime el valor de (Subscript[R, 0])*)]

Espacio fase Figura 11.66

k=1; (*con este contador vamos a generar diferentes curvas para diferentes condiciones iniciales*)
i0=0.1;β=1;γ=3;(*definimos el valor inicial de los infectados y los valores de β y γ*)
tot=Plot[1-x,{x,0,1},PlotRange->{{0,1},{0,1}},Frame->True,FrameLabel->{"Susceptibles","Infectados"},PlotStyle->{Red,Thick},AspectRatio->1];(*con esta gráfica mostraremos el valor máximo de i(t)+s(t)=1*)
μ=0.1 ;(*tasa de mortalidad*)
While[k≤9,(*contador para generar las gráficas*)
s0=1-i0;
eqns={s'[t]==-β i[t]s[t]+μ(1-s[t]),(*sistemas de ecuaciones diferenciales*)
 i'[t]==β i[t]s[t]-(γ+μ) i[t],
 i[0]==i0,s[0]==s0};
vars={s,i};(*variables, infectados y susceptibles*)
solns=NDSolve[eqns,vars,{t,0,50}];(*solución númerica de la ecuación diferencial*)
plot[k]=ParametricPlot[{s[t],i[t]}/.solns,{t,0,50},PlotStyle->{Orange,Thick}];
i0=i0+0.1;k=k+1];(*se generanlas gráficas de infectados en funcón de los susceptibles*)
Show[tot,plot[1],plot[2],plot[3],plot[4],plot[5],plot[6],plot[7],plot[8],plot[9](*se muestran las diferentes gráficas*)
,Graphics[{Inset["(Subscript[R, 0]) = ",{0.7,0.8}],Inset[N[β/(μ+γ)],{0.8,0.8}]},Axes->False,Ticks->None](*se imprime el valor de (Subscript[R, 0])*)]

Modelo SIQR

Figura 11.67

(*Primero se resuelve el modelo sin individuos en cuerentena, esto es el modelo SIR*)

sol=With[{β=5,γ=1},(* Damos el valor inicial de las constantes para el modelo SIR*)With[{s0=0.99,i0=0.01},(*Damos los valores inciciale de las variables para resolver el sistema de ecuaciones diferenciales (14.1)-(14.3) numericamente*)NDSolve[{s'[t]==-β s[t]i[t],i'[t]==β s[t]i[t]-γ  i[t],s[0]==s0,i[0]==i0},{s[t],i[t]},{t,0,10}]]](*con el comando NDSolve se resuelve el sistema de ecuaciones numericamente*)

sir=Show[Plot[Evaluate[{s[t],i[t],1-s[t]-i[t]}/.sol],{t,0,4},PlotRange->All,Frame->True,FrameLabel->{"Tiempo","Población"},PlotStyle->{{ Dashed,Thickness[0.008]}}]](*Se grafica la solución numérica de el sistema de acuaciones (14.1)-(14.3)*)

TableForm[Table[{t,Evaluate[s[t]/.sol],Evaluate[i[t]/.sol],1-Evaluate[s[t]/.sol]-Evaluate[i[t]/.sol]},{t,0,3,1}],TableHeadings->{None, {"tiempo","susceptibles","infectados","recuperados"}}](*en esta tabla se pueden var los valores de susceptibles e infectadods a diferentes tiempos, estos valores pueden ser usados para definir los valores al inicio de una cuarentena*)

(*Resolvemos el modelo SIQR imponiendo la cuantena al tiempo 1*)sol=With[{β=5,γ=1,ϵ=0.5},(*damos el valor inicial de las constantes*)With[{s0=0.6,i0=0.294,q0=0.0},(*damos los valores inciciale de las variables al tiempo 1 tomados de la tabla anterior, para resolver el sistema de ecuaciones diferenciales (14.1)-(14.3) numericamente basados en la table anterior*)NDSolve[{cs'[t]==-β cs[t]ci[t]/(1-cq[t]),ci'[t]==β cs[t]ci[t]/(1-cq[t])-γ  ci[t]-ϵ ci[t],cq'[t]==ϵ ci[t]-γ cq[t],cs[1]==s0,ci[1]==i0,cq[1]==q0},{cs[t],ci[t],cq[t]},{t,0,10}]]](*con el comando NDSolve se resuelve el sistema de ecuaciones numericamente*)

siqr=Show[Plot[Evaluate[{cs[t],ci[t],1-cs[t]-ci[t]-cq[t],cq[t]}/.sol],{t,1,4},PlotRange->All,Frame->True,FrameLabel->{"Tiempo","Población"},PlotStyle->{Thickness[0.008]},PlotLegends->Placed[{"s(t)","i(t)","r(t)","q(t)"}, {0.85, 0.55}]]](*Se grafica la solución numérica de el sistema de acuaciones (14.1)-(14.3)*)

Show[sir,siqr](*Se grafica la solución numérica deambos modelos*)

Figura 12.68

ic1=Table[{t,Evaluate[{ci[t]}/.sol]},{t,1,4,0.1}];(*Generamos una table de infectados inciando al tiempo igual a 1*)

ic2=Table[{ic1[[i,1]],First[First[ic1[[i,2]]]]},{i,1,Length[ic1]}];(*Solo tamamos los valores numéricos de la tabla anterior*)

p1=ListPlot[ic2,Joined->True,PlotStyle->{Dashed, { RGBColor[0.880722, 0.611041, 0.142051],Thickness[0.007]}},PlotLegends->Placed[{"i(t) con cuarentena"}, {0.76, 0.85}]]

sol=With[{β=5,γ=1},(*Damos el valor inicial de las constantes para el modelo SIR*)With[{s0=0.99,i0=0.01},(*Damos los valores inciciale de las variables para resolver el sistema de ecuaciones diferenciales*)NDSolve[{s'[t]==-β s[t]i[t],i'[t]==β s[t]i[t]-γ  i[t],s[0]==s0,i[0]==i0},{s[t],i[t]},{t,0,10}]]](*Con el comando NDSolve se resuelve el sistema de ecuaciones (14.1)-(14.3) numericamente*)

Show[Plot[Evaluate[{i[t]}/.sol],{t,0,4},PlotRange->All,Frame->True,FrameLabel->{"Tiempo","Población"},PlotStyle->{{RGBColor[0.880722, 0.611041, 0.142051],Thickness[0.007]}},PlotLegends->Placed[{"i(t) sin cuarentena"}, {0.78, 0.75}]],p1](*Comparamos los valores obtenidos con y sin cuarentena*)

Modelos SEIR

Figura 13.69

ex0e=0.01;i0e=0.0;s0e=1-ex0e;r0e=0;βe=1.0;γe=1/5;σe=1/7;(*Damos el valor inicial de las constantes*)

sol=NDSolve[{se'[t]==-βe se[t]ie[t],
exe'[t]==βe se[t]ie[t]-σe exe[t],
ie'[t]==σe exe[t]-γe ie[t],
re'[t]==γe ie[t],
se[0]==s0e,ie[0]==i0e,re[0]==0,exe[0]==ex0e},
{se[t],ie[t],re[t],exe[t]},{t,0,600}](*Con el comando NDSolve se resuelve el sistema de ecuaciones (15.1)-(15.3) numericamente*)

Plot[Evaluate[{se[t],ie[t],re[t],exe[t]}/.sol],{t,0,70},PlotRange->All,Frame->True,FrameLabel->{"Tiempo","Población"},PlotStyle->{Thickness[0.008]},PlotLegends->Placed[{"s(t)","i(t)","r(t)","e(t)"},{Scaled[{0.78,0.55}], {0.1, 0.7}}]](*Se grafica la solución numérica de el sistema de acuaciones (15.1)-(15.3)*)

Modelos con distanciamiento social

Figura 14.70

ex0e=0.01;i0e=0.0;s0e=1-ex0e;r0e=0;βe=1.0;γe=1/5;σe=1/7;(*Damos el valor inicial de las constantes*)

lve=NDSolve[{se'[t]==-βe se[t]ie[t],
exe'[t]==βe se[t]ie[t]-σe exe[t],
ie'[t]==σe exe[t]-γe ie[t],
re'[t]==γe ie[t],
se[0]==s0e,ie[0]==i0e,re[0]==0,exe[0]==ex0e},
{se[t],ie[t],re[t],exe[t]},{t,0,600}](*Con el comando NDSolve se resuelve el sistema de ecuaciones (15.1)-(15.3) numericamente*)

Plot[Evaluate[{se[t],ie[t],re[t],exe[t]}/.lve],{t,0,70},PlotRange->All,Frame->True,FrameLabel->{"Tiempo","Población"},PlotStyle->{Thickness[0.008]},PlotLegends->Placed[{"s(t)","i(t)","r(t)","e(t)"},{Scaled[{0.78,0.55}], {0.1, 0.7}}]](*Se grafica la solución numérica de el sistema de acuaciones (15.1)-(15.3)*)

Figura 14.71

ex0m1=0.01;i0m1=0.0;s0m1=1-ex0m1;r0m1=0;γm1=1/5;σm1=1/7;(*Damos el valor inicial de las constantes*)

β0m1=1;c0=1;cb=0.5;r1=1;(*damos los valores de las constantes y t0*)

βm1[t_]:=β0m1((c0-cb)Exp[-r1 t]+cb);(*Definimos β como función del tiempo de (16.3)*)

lvm1=NDSolve[{sm1'[t]==-βm1[t] sm1[t]im1[t],
exm1'[t]==βm1[t] sm1[t]im1[t]-σm1 exm1[t],
im1'[t]==σm1 exm1[t]-γm1 im1[t],
rm1'[t]==γm1  im1[t],
sm1[0]==s0m1,im1[0]==i0m1,rm1[0]==0,exm1[0]==ex0m1},
{sm1[t],im1[t],rm1[t],exm1[t]},{t,0,600}](*Con el comando NDSolve se resuelve el sistema de ecuaciones (15.1)-(15.3) numericamente*)

Plot[Evaluate[{sm1[t],im1[t],rm1[t],exm1[t]}/.lvm1],{t,0,120},PlotRange->All,Frame->True,FrameLabel->{"Tiempo","Población"},PlotStyle->{Thickness[0.008]},PlotLegends->Placed[{"s(t)","i(t)","r(t)","e(t)"},{Scaled[{0.78,0.55}], {0.1, 0.7}}]](*Se grafica la solución numérica de el sistema de acuaciones (15.1)-(15.3)*)

Figura 14.72

ex0m5=0.01;i0m5=0.0;s0m5=1-ex0m5;r0m5=0;γm5=1/5;σm5=1/7;(*Damos el valor inicial de las constantes*)

β0m5=1;c0=1;cb=0.5;r1=1; t0=20;(*damos los valores de las constantes y t0*)

βm5[t_]:=If[ t<t0,β0m5,β0m5((c0-cb)Exp[-r1 t]+cb)];(*Definimos β como función del tiempo de (16.3)*)

lvm5=NDSolve[{sm5'[t]==-βm5[t] sm5[t]im5[t],
exm5'[t]==βm5[t] sm5[t]im5[t]-σm5 exm5[t],
im5'[t]==σm5 exm5[t]-γm5 im5[t],
rm5'[t]==γm5  im5[t],
sm5[0]==s0m5,im5[0]==i0m5,rm5[0]==0,exm5[0]==ex0m5},
{sm5[t],im5[t],rm5[t],exm5[t]},{t,0,600}](*Con el comando NDSolve se resuelve el sistema de ecuaciones (15.1)-(15.3) numericamente*)

Plot[Evaluate[{sm5[t],im5[t],rm5[t],exm5[t]}/.lvm5],{t,0,70},PlotRange->All,Frame->True,FrameLabel->{"Tiempo","Población"},PlotStyle->{Thickness[0.008]},PlotLegends->Placed[{"s(t)","i(t)","r(t)","e(t)"},{Scaled[{0.78,0.55}], {0.1, 0.7}}]](*Se grafica la solución numérica de el sistema de acuaciones (15.1)-(15.3)*)

Figura 14.73

Plot[{Evaluate[{ie[t]}/.lve],Evaluate[{im1[t]}/.lvm1],Evaluate[{im5[t]}/.lvm5]},{t,0,120},PlotRange->All,Frame->True,FrameLabel->{"Tiempo","Población","Infectados"},PlotStyle->{{RGBColor[0.880722, 0.611041, 0.142051],Thickness[0.007]},{DotDashed,RGBColor[0.880722, 0.611041, 0.142051],Thickness[0.007]},{Dashed,RGBColor[0.880722, 0.611041, 0.142051],Thickness[0.007]}},PlotLegends->Placed[{"β=(Subscript[β, 0])","(Subscript[t, c])=0","(Subscript[t, c])=20"},{Scaled[{0.7,0.8}], {0.1, 0.7}}]](*Con el comando NDSolve se resuelve el sistema de ecuaciones (15.3) numericamente*)

Figura 14.74

Plot[{Evaluate[{se[t]}/.lve],Evaluate[{sm1[t]}/.lvm1],Evaluate[{sm5[t]}/.lvm5]},{t,0,120},PlotRange->All,Frame->True,FrameLabel->{"Tiempo","Población","Susceptibles"},PlotStyle->{{RGBColor[0.368417, 0.506779, 0.709798],Thickness[0.007]},{DotDashed,RGBColor[0.368417, 0.506779, 0.709798],Thickness[0.007]},{Dashed,RGBColor[0.368417, 0.506779, 0.709798],Thickness[0.007]}},PlotLegends->Placed[{"β=(Subscript[β, 0])","(Subscript[t, c])=0","(Subscript[t, c])=20"},{Scaled[{0.7,0.8}], {0.1, 0.7}}]](*Con el comando NDSolve se resuelve el sistema de ecuaciones (15.2) numericamente*)

Figura 14.75

Plot[{Evaluate[{re[t]}/.lve],Evaluate[{rm1[t]}/.lvm1],Evaluate[{rm5[t]}/.lvm5]},{t,0,120},PlotRange->All,Frame->True,FrameLabel->{"Tiempo","Población","Recuperados"},PlotStyle->{{ RGBColor[0.560181, 0.691569, 0.194885],Thickness[0.007]},{DotDashed, RGBColor[0.560181, 0.691569, 0.194885],Thickness[0.007]},{Dashed, RGBColor[0.560181, 0.691569, 0.194885],Thickness[0.007]}},PlotLegends->Placed[{"β=(Subscript[β, 0])","(Subscript[t, c])=0","(Subscript[t, c])=20"},{Scaled[{0.7,0.4}], {0.1, 0.7}}]](*Con el comando NDSolve se resuelve el sistema de ecuaciones (15.4) numericamente*)

Figura 14.76

Plot[{Evaluate[{exe[t]}/.lve],Evaluate[{exm1[t]}/.lvm1],Evaluate[{exm5[t]}/.lvm5]},{t,0,120},PlotRange->All,Frame->True,FrameLabel->{"Tiempo","Población","Expuestos"},PlotStyle->{{RGBColor[0.922526, 0.385626, 0.209179],Thickness[0.007]},{DotDashed,RGBColor[0.922526, 0.385626, 0.209179],Thickness[0.007]},{Dashed,RGBColor[0.922526, 0.385626, 0.209179],Thickness[0.007]}},PlotLegends->Placed[{"β=(Subscript[β, 0])","(Subscript[t, c])=0","(Subscript[t, c])=20"},{Scaled[{0.7,0.8}], {0.1, 0.7}}]](*Con el comando NDSolve se resuelve el sistema de ecuaciones (15.2) numericamente*)

β(t) para COVID-19 en México

data=Table[{i,covidmx[[i,2]]},{i,1,Length[covidmx]}];(*Primero se tiene que ejecutar covidmx*)

γ=1/6;(*Valor aproximado para el COVID-19*)

datadiarios=Table[{i,data[[i+1,2]]-data[[i,2]]},{i,1,Length[data]-1}];(*Generamos una tabla con los datos de los infectados por día a partir de los acumulados para poder hacer el ajuste*)

camdatadiarios=Table[{i,Abs[datadiarios[[i+1,2]]-datadiarios[[i,2]]]},{i,1,Length[datadiarios]-1}];

databeta=Table[{i,((camdatadiarios[[i,2]])/(datadiarios[[i,2]]))+γ},{i,12,Length[camdatadiarios]-1}];(*Valor calculado para β(t) a partir de los datos reportados y la ecuación (16.1)*)

ListPlot[databeta,PlotRange->All,FrameLabel->{"Días","β(t) = (di/dt) + γ"},PlotTheme->"Detailed",PlotStyle->{PointSize[0.014]}](*Se grafican los datos calculados*)

Figura 14.77

Clear[a,b,c,t](*Con el comando Clear se borran los valores anteriores de las variables especificadas*)

model= a + b /t^c  (*Ecuación propuesta para ajustar los valores obtenidos*)

beta=NonlinearModelFit[databeta,model,{{a,0.15},b,c},t];(*Con el comando NonlinearModelFit podemos obtener los parámetros del mejor ajuste, la ecución que se quiere ajustar tiene que ser incluida*)

beta@"ParameterConfidenceIntervalTable"(*Obtenemos los valores encontrados para el mejor ajuste*)

beta@"RSquared"(*Coeficiente de determinación*)

infbeta[t_]=Normal[beta](*Le asiganamos una ecuación a nuestro ajuste*)

bands95[t_]=beta["MeanPredictionBands",ConfidenceLevel->.95];(*Encontramos los valores con una confiabilidad del 95%*)

Show[Plot[{infbeta[t],bands95[t]},{t,10,250},PlotRange->{0.05,3},Filling->{2->{1}},PlotStyle->{Darker[Green],Thickness[0.009],Thickness[0.0035]},Frame->True,GridLines->Automatic,FrameLabel->{"Días","β(t) =(1/i) (di/dt) + γ"},PlotLegends->{"model", "95% confidence bands"}],ListPlot[databeta,PlotRange->{0.05,3},PlotStyle->{Blue,PointSize[0.014]}]](*Se grafica los datos reportados con el ajuste teórico*)

Figura 14.78

dia=Table[DateList[covidmx[[i,1]]],{i,1,Length[covidmx]}](*Se hace una lista con las fechas*);

DateListStepPlot[Table[{dia[[i]],(1/γ)((camdatadiarios[[i,2]])/(datadiarios[[i,2]]))+γ},{i,12,Length[camdatadiarios]-1}],PlotRange->All,FrameLabel->{"Fecha","R(t) = β(t)/γ"},PlotTheme->"Detailed",PlotStyle->{Orange,PointSize[0.014]}](*Con el comando DateListPlot se grafíca una serie de tiempo*)

Apéndice B

Figura 89

Show[Plot[{((1+10  (x^(10+1)))/(1+  (x^(10+1)))),((1+30  (x^(30+1)))/(1+  (x^(30+1)))),((1+50  (x^(50+1)))/(1+  (x^(50+1))))},{x,0.01,2},
Frame->True,PlotRange->All,Frame->True,FrameLabel->{"x","ν(x)"},PlotStyle->{Thickness[0.008]},PlotLegends->Placed[{"n=10","n=30","n=50"}, {0.15, 0.75}]]](*Seg grafica la ecuación (B.6) para diferentes valores de n*)