add custom function to print text of bad convergence

[ajpelu]

@dario-ssm here is the code to print an output of the bad fitting models:

# data examples
list_param2 <- as.data.frame(cbind(param_name = c("tmin", "a", "b", "tmax", "a", "b", "tmed", "a", "b"),
                param_est = c(27, 1, 4, 38, 5, 6, 25, 1,1), 
                para_se = c(1, 0.01, 0.2, 500, 0.1, 2, 200, 0.1, 2),
                model_name = c(rep("briere1", 3), rep("brier2", 3), rep("brier4", 3)),
                model_AIC = c(rep(2000, 9)), 
                fit = c(rep("good", 3), rep("BAD", 3), rep("BAD", 3))))

list_param1 <- as.data.frame(cbind(param_name = c("tmin", "a", "b", "tmax", "a", "b"),
                                   param_est = c(27, 1, 4, 38, 5, 6), 
                                   para_se = c(1, 0.01, 0.2, 500, 0.1, 2),
                                   model_name = c(rep("briere1", 3), rep("brier2", 3)),
                                   model_AIC = c(rep(2000, 6)), 
                                   fit = c(rep("good", 3), rep("BAD", 3))))

bad_models1 <- list_param1 |> dplyr::filter(fit == "BAD")
bad_models2 <- list_param2 |> dplyr::filter(fit == "BAD")

## This is the function to generate the output 
text_badModels <- function(x) {
  if(length(unique(x$model_name)) == 1) {
    glue::glue("The model {unique(x$model_name)} is very very BAD.")
  } else { 
    glue::glue("The models {glue::glue_collapse( unique(x$model_name), ', ', last = ' and ')} are very very BAD")  
  }
}

text_badModels(bad_models2)
list_param2 <- as.data.frame(cbind(param_name = c("tmin", "a", "b", "tmax", "a", "b", "tmed", "a", "b"),
                param_est = c(27, 1, 4, 38, 5, 6, 25, 1,1), 
                para_se = c(1, 0.01, 0.2, 500, 0.1, 2, 200, 0.1, 2),
                model_name = c(rep("briere1", 3), rep("brier2", 3), rep("brier4", 3)),
                model_AIC = c(rep(2000, 9)), 
                fit = c(rep("good", 3), rep("BAD", 3), rep("BAD", 3))))

list_param1 <- as.data.frame(cbind(param_name = c("tmin", "a", "b", "tmax", "a", "b"),
                                   param_est = c(27, 1, 4, 38, 5, 6), 
                                   para_se = c(1, 0.01, 0.2, 500, 0.1, 2),
                                   model_name = c(rep("briere1", 3), rep("brier2", 3)),
                                   model_AIC = c(rep(2000, 6)), 
                                   fit = c(rep("good", 3), rep("BAD", 3))))

bad_models1 <- list_param1 |> dplyr::filter(fit == "BAD")
bad_models2 <- list_param2 |> dplyr::filter(fit == "BAD")

text_badModels <- function(x) {

  if(length(unique(x$model_name)) == 1) {
    glue::glue("The model {unique(x$model_name)} is very very BAD.")

  } else { 

    glue::glue("The models {glue::glue_collapse( unique(x$model_name), ', ', last = ' and ')} are very very BAD")

  }
}

text_badModels(bad_models1)
text_badModels(bad_models2)

[dario-ssm]

With the new modifications of the function, there are alternatives to assess the model fitting and uncertainty, I close this issue although it may be useful in the future.