Simulated_Data/modified_function.Rmd at main · jdnowacek/Simulated_Data · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
---
title: "Modified make.pop_desc"
output: pdf_document
date: "2023-07-30"
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```

## New version of the make.population.description function

```{r new function}
make.population_description_modified <- function (region = make.region(), density = make.density(),
  covariates = list(), N = numeric(0), fixed.N = TRUE)
{
  if (any(names(covariates) == "")) {
    stop("All elements in the covariate list must be names with the covariate name.",
      call. = FALSE)
  }
  for (cov in seq(along = covariates)) {
    if ("distribution" %in% names(covariates[[cov]]) ||
      is(covariates[[cov]], "data.frame")) {
      covariates[[cov]] <- list(covariates[[cov]])
    }
  }
  cov.names <- names(covariates)
  for (cov in seq(along = covariates)) {
    strat.list <- list()
    for (i in seq(along = covariates[[cov]])) {
      if (is(covariates[[cov]][[i]], "data.frame")) {
        if (!all(c("level", "prob") %in% names(covariates[[cov]][[i]]))) {
          stop("Covariate dataframes must contain the columns 'level' and 'prob'.",
            call. = FALSE)
        }
        if (length(covariates[[cov]]) > 1) {
          stop("Please only supply one covariate dataframe with strata as a column for multi-strata covariate values.",
            call. = FALSE)
        }
        strat.names <- region@strata.name
        if ("strata" %in% names(covariates[[cov]][[i]]) &&
          length(covariates[[cov]]) == 1 && length(strat.names) >
          1) {
          strat.names.check <- unique(covariates[[cov]][[i]]$strata)
          if (any(sort(strat.names) != sort(strat.names.check))) {
            stop(paste("The strata names in the covariate dataframe for ",
              cov.names[cov], " do not match the strata names in the region object.",
              sep = ""), call. = FALSE)
          }
          for (j in seq(along = strat.names)) {
            cov.dataframe <- covariates[[cov]][[i]]
            strat.list[[j]] <- cov.dataframe[cov.dataframe$strata ==
              strat.names[j], c("level", "prob")]
          }
        }
      }
      else if (is(covariates[[cov]][[i]], "list")) {
        params <- switch(covariates[[cov]][[i]]$distribution,
          normal = c("mean", "sd"), poisson = "lambda",
          ztruncpois = "mean", lognormal = c("meanlog",
            "sdlog"))
        if (!all(params %in% names(covariates[[cov]][[i]]))) {
          stop(paste("You have not supplied all the required parameters (",
            paste(params, collapse = ", "), ") for the following covariate distribution: ",
            covariates[[cov]][[i]]$distribution, sep = ""),
            call. = FALSE)
        }
        pvs <- covariates[[cov]][[i]]
        param.vals <- switch(covariates[[cov]][[i]]$distribution,
          normal = list(mean = pvs$mean, sd = pvs$sd),
          poisson = list(lambda = pvs$lambda), ztruncpois = list(mean = pvs$mean),
          lognormal = list(meanlog = pvs$meanlog, sdlog = pvs$sdlog))
        old.format <- list(covariates[[cov]][[i]]$distribution,
          param.vals)
        strat.list[[i]] <- old.format
      }
    }
    if (length(strat.list) > 0) {
      covariates[[cov]] <- strat.list
    }
  }
  pop.description <- new(Class = "Population.Description",
    N = N, density = density, region.obj = region, covariates = covariates,
    gen.by.N = fixed.N)
  return(pop.description)
}

```