0
hmod = (assign_df)

sir_model = function (t, y, parms)
{
  # label state variables from within the y vector of initial values
  S = y[1]        # susceptibles
  I = y[2]        # infectious
  R = y[3]        # recovered
  D = y[4]        # dead
  N = S + I + R + D
  
  # Pull parameter values from the parms vector
  beta = parms["beta"]
  gamma = parms["gamma"]
  alpha = parms["alpha"]
  
  # Define equations (dS etc. are simplified notation for dS/dt)
  dS = -(beta*S*I)/N
  dI = (beta*S*I)/N - gamma*I
  dR = alpha*gamma*I
  dD = (1-alpha)*gamma*I
  
  # return list of gradients   
  res = c(dS, dI, dR, dD)
  list(res)
}

par_init = c(beta=1, gamma=1, alpha =0.5)
init_sav = c(S=1079, I=1, R=0, D=0)
times_sav = hmod$time

n_obs <- length(hmod$D_obs)

opt_fun_sav = function(par){
  
  ## The following lines prevent 'optim_nm' from wandering into negative parameter space
  if (par[1]<0){
    par[1] = -par[1]
  } 
  if(par[2]<0){
    par[2] = -par[2]
  }
  ## Run the SIR model with the current parameter values 
  output_sav_try = ode(
    y=init_sav, 
    times = times_sav, 
    func = sir_model, 
parms= c(
      beta = par_init[1], 
      gamma = par_init[2],
      alpha = par_init[3]
    )
  )
  n_obs = nrow(hmod)
  
  output_savtry_df = as.data.frame(output_sav_try) # coerce to a data.frame object

  
  ## Create a data frame with observed and model prediction data for Savoonga
  sav_rmse_df = data.frame(
    time = hmod$time,
    obs = hmod$D_obs,
    # the following lines find the cumulative I prediction for each time in the mummps data
    pred = sapply(1:n_obs, function(i){output_savtry_df$D[
      output_savtry_df$time == hmod$time[i]
    ]})
  )
  # Calculate the RMSE for this prediction
  rmse_try = sqrt((1/n_obs)*(sum((sav_rmse_df$pred - sav_rmse_df$obs)^2)))  
  
  return(rmse_try)
  
}

optnm_result=optim_nm(opt_fun_sav,start=c(0.6,0.6),k=2, trace=TRUE)

Error in while (tol < End) { : missing value where TRUE/FALSE needed

I can't get around this error, I'm also not sure if other parts of my code is wrong The aim of this code is to optomise the prediction of ra low RMSE when compared with death counts in the dataset hmod

I've tried alot of things, removing pieces which seems to be causing issues, checking where False or true values could be, none of it has worked.

Use the code below to replicate the dataset of real death totals

time <- 1:40
D_obs <- round(seq(1, 200, length.out = 40))
hmod <- data.frame(time, D_obs)
print(hmod)
  • 1
    It's easier to help you if you include a simple [reproducible example](https://stackoverflow.com/questions/5963269/how-to-make-a-great-r-reproducible-example) with sample input that can be used to test and verify possible solutions. – MrFlick Feb 23 '23 at 16:15
  • The added information about the real dataset reproduction should help this. – James Gothard Feb 24 '23 at 11:42

0 Answers0