billdenney / pknca

Compare cfb0377 ... +2 ... b24805b


@@ -248,6 +248,12 @@
Loading
248 248
  getGroups.PKNCAconc(...)
249 249
}
250 250
251 +
#' @describeIn group_vars.PKNCAconc Get group_vars for a PKNCAdose object
252 +
#' @exportS3Method dplyr::group_vars
253 +
group_vars.PKNCAdose <- function(x) {
254 +
  group_vars.PKNCAconc(x)
255 +
}
256 +
251 257
#' @rdname getData.PKNCAconc
252 258
#' @export
253 259
#' @importFrom nlme getData
@@ -299,7 +305,3 @@
Loading
299 305
#' @rdname print.PKNCAconc
300 306
#' @export
301 307
summary.PKNCAdose <- summary.PKNCAconc
302 -
303 -
#' @rdname split.PKNCAconc
304 -
#' @export
305 -
split.PKNCAdose <- split.PKNCAconc

@@ -228,6 +228,15 @@
Loading
228 228
  data[, grpnames, drop=FALSE]
229 229
}
230 230
231 +
#' Get grouping variables for a PKNCA object
232 +
#'
233 +
#' @param x The PKNCA object
234 +
#' @return A character vector (possibly empty) of the grouping variables
235 +
#' @exportS3Method dplyr::group_vars
236 +
group_vars.PKNCAconc <- function(x) {
237 +
  all.vars(parseFormula(as.formula(x))$groups)
238 +
}
239 +
231 240
#' Extract all the original data from a PKNCAconc or PKNCAdose object
232 241
#' @param object R object to extract the data from.
233 242
#' @export
@@ -318,74 +327,6 @@
Loading
318 327
319 328
#' @rdname print.PKNCAconc
320 329
#' @export
321 -
summary.PKNCAconc <- function(object, n=0, summarize=TRUE, ...)
330 +
summary.PKNCAconc <- function(object, n=0, summarize=TRUE, ...) {
322 331
  print.PKNCAconc(object, n=n, summarize=summarize)
323 -
324 -
#' Divide into groups
325 -
#' 
326 -
#' \code{split.PKNCAconc} divides data into individual groups defined by
327 -
#' \code{\link{getGroups.PKNCAconc}}.
328 -
#' 
329 -
#' @param x the object to split
330 -
#' @param f the groups to use for splitting the object
331 -
#' @param drop logical indicating if levels that do not occur should be 
332 -
#'   dropped.
333 -
#' @param ... Ignored.
334 -
#' @details If \code{x} is \code{NA} then a list with NA as the only
335 -
#'   element and a "groupid" attribute of an empty data.frame is
336 -
#'   returned.
337 -
#' @return A list of objects with an attribute of groupid consisting of 
338 -
#'   a data.frame with columns for each group.
339 -
#' @export
340 -
split.PKNCAconc <- function(x, f=getGroups(x), drop=TRUE, ...) {
341 -
  if (!drop)
342 -
    stop("drop must be TRUE")
343 -
  if (identical(x, NA)) {
344 -
    ret <- list(NA)
345 -
    groupid <- data.frame(NA)[,c()]
346 -
  } else {
347 -
    ## Do the initial separation and extract the groupid information
348 -
    f_new <-
349 -
      as.character(
350 -
        do.call(
351 -
          paste,
352 -
          append(as.list(f), list(sep="\n"))
353 -
        )
354 -
      )
355 -
    ret <- split(x=x$data, f=f_new, drop=drop, sep="\n")
356 -
    groupid <- unique(f)
357 -
    ## reorder the output to align with the input grouping order
358 -
    ret.idx <-
359 -
      factor(
360 -
        names(ret),
361 -
        levels=do.call(paste, append(as.list(groupid), list(sep="\n"))),
362 -
        ordered=TRUE
363 -
      )
364 -
    ret <- ret[order(ret.idx)]
365 -
    ## Reset the data in each split to a "data" element within a list.
366 -
    ret <-
367 -
      lapply(
368 -
        ret,
369 -
        function(y, newclass) {
370 -
          ret <- list(data=y)
371 -
          class(ret) <- newclass
372 -
          ret
373 -
        },
374 -
        newclass=class(x)
375 -
      )
376 -
    ## Add the other features back into the data
377 -
    for (n in setdiff(names(x), "data")) {
378 -
      ret <-
379 -
        lapply(
380 -
          ret,
381 -
          function(x, name, value) {
382 -
            x[[name]] <- value
383 -
            x
384 -
          },
385 -
          name=n, value=x[[n]]
386 -
        )
387 -
    }
388 -
  }
389 -
  attr(ret, "groupid") <- groupid
390 -
  ret
391 332
}

@@ -97,45 +97,54 @@
Loading
97 97
  } else if (missing(intervals)) {
98 98
    ## Generate the intervals for each grouping of concentration and
99 99
    ## dosing.
100 -
    tmp.conc.dose <-
101 -
      merge.splitlist(
102 -
        conc=split(ret$conc),
103 -
        dose=split(ret$dose)
104 -
      )
105 -
    groupid <- attributes(tmp.conc.dose)$groupid
106 -
    rownames(groupid) <- NULL
107 -
    intervals <- data.frame()
108 -
    indep.var.conc <- all.vars(parseFormula(ret$conc)$rhs)
109 -
    indep.var.dose <- all.vars(parseFormula(ret$dose)$rhs)
110 -
    if (identical(indep.var.dose, ".")) {
100 +
    if (identical(all.vars(parseFormula(ret$dose)$rhs), ".")) {
111 101
      stop("Dose times were not given, so intervals must be manually specified.")
112 102
    }
113 -
    for (i in seq_len(nrow(groupid))) {
114 -
      tmp.group <- groupid[i,,drop=FALSE]
115 -
      if (!is.null(tmp.conc.dose[[i]]$conc)) {
116 -
        rownames(tmp.group) <- NULL
103 +
    n_conc_dose <-
104 +
      full_join_PKNCAconc_PKNCAdose(
105 +
        conc=ret$conc,
106 +
        dose=ret$dose
107 +
      )
108 +
    n_conc_dose$data_intervals <- rep(list(NULL), nrow(n_conc_dose))
109 +
    for (idx in seq_len(nrow(n_conc_dose))) {
110 +
      current_conc <- n_conc_dose$data_conc[[idx]]
111 +
      current_dose <- n_conc_dose$data_dose[[idx]]
112 +
      current_group <-
113 +
        n_conc_dose[
114 +
          idx,
115 +
          setdiff(names(n_conc_dose), c("data_conc", "data_dose")),
116 +
          drop=FALSE
117 +
        ]
118 +
      warning_prefix <-
119 +
        if (ncol(current_group) > 0) {
120 +
          paste0(
121 +
            paste(names(current_group), unlist(lapply(current_group, as.character)), sep="=", collapse="; "),
122 +
            ": "
123 +
          )
124 +
        } else {
125 +
          ""
126 +
        }
127 +
      if (!is.null(current_conc)) {
117 128
        generated_intervals <-
118 129
          choose.auc.intervals(
119 -
            tmp.conc.dose[[i]]$conc$data[,indep.var.conc],
120 -
            tmp.conc.dose[[i]]$dose$data[,indep.var.dose],
130 +
            current_conc$time,
131 +
            current_dose$time,
121 132
            options=options
122 133
          )
123 -
        if (nrow(generated_intervals)) {
124 -
          new.intervals <- cbind(tmp.group, generated_intervals)
125 -
          intervals <- rbind(intervals, new.intervals)
134 +
        if (nrow(generated_intervals) > 0) {
135 +
          n_conc_dose$data_intervals[[idx]] <- generated_intervals
126 136
        } else {
127 -
          warning("No intervals generated likely due to limited concentration data for ",
128 -
                  paste(names(tmp.group),
129 -
                        unlist(lapply(tmp.group, as.character)),
130 -
                        sep="=", collapse=", "))
137 +
          warning(warning_prefix, "No intervals generated likely due to limited concentration data")
131 138
        }
132 139
      } else {
133 -
        warning("No intervals generated due to no concentration data for ",
134 -
                paste(names(tmp.group),
135 -
                      unlist(lapply(tmp.group, as.character)),
136 -
                      sep="=", collapse=", "))
140 +
        warning(warning_prefix, "No intervals generated due to no concentration data")
137 141
      }
138 142
    }
143 +
    intervals <-
144 +
      tidyr::unnest(
145 +
        n_conc_dose[, setdiff(names(n_conc_dose), c("data_conc", "data_dose")), drop=FALSE],
146 +
        cols="data_intervals"
147 +
      )
139 148
  }
140 149
  ret$intervals <- check.interval.specification(intervals)
141 150
  ## Assign the class and give it all back to the user.
@@ -168,76 +177,20 @@
Loading
168 177
#' Extract all the original data from a PKNCAconc or PKNCAdose object
169 178
#' @param object R object to extract the data from.
170 179
#' @export
171 -
getData.PKNCAdata <- function(object)
180 +
getData.PKNCAdata <- function(object) {
172 181
  object$data
182 +
}
173 183
174 184
#' @rdname getDataName
175 -
getDataName.PKNCAdata <- function(object)
185 +
getDataName.PKNCAdata <- function(object) {
176 186
  "data"
187 +
}
177 188
178 189
#' Summarize a PKNCAdata object showing important details about the
179 190
#' concentration, dosing, and interval information.
180 191
#' @param object The PKNCAdata object to summarize.
181 192
#' @param ... arguments passed on to \code{\link{print.PKNCAdata}}
182 193
#' @export
183 -
summary.PKNCAdata <- function(object, ...)
194 +
summary.PKNCAdata <- function(object, ...) {
184 195
  print.PKNCAdata(object, summarize=TRUE, ...)
185 -
186 -
#' @rdname split.PKNCAconc
187 -
#' @export
188 -
split.PKNCAdata <- function(x, ...) {
189 -
  interval.group.cols <- intersect(names(x$intervals),
190 -
                                   all.vars(parseFormula(x$conc$formula)$groups))
191 -
  if (length(interval.group.cols) > 0) {
192 -
    # If the intervals need to be split across the groups
193 -
    tmp.interval.split <-
194 -
      split.PKNCAconc(list(data=x$intervals),
195 -
                      f=x$intervals[, interval.group.cols, drop=FALSE])
196 -
    tmp.attr <- attributes(tmp.interval.split)
197 -
    tmp.interval.split <- lapply(tmp.interval.split, function(x) x$data)
198 -
    attributes(tmp.interval.split) <- tmp.attr
199 -
    if (identical(NA, x$dose)) {
200 -
      ret <-
201 -
        merge.splitlist(conc=split.PKNCAconc(x$conc),
202 -
                        intervals=tmp.interval.split)
203 -
      ret <- lapply(X=ret,
204 -
                    FUN=function(x) {
205 -
                      x$dose <- NA
206 -
                      x
207 -
                    })
208 -
    } else {
209 -
      ret <-
210 -
        merge.splitlist(conc=split.PKNCAconc(x$conc),
211 -
                        dose=split.PKNCAdose(x$dose),
212 -
                        intervals=tmp.interval.split)
213 -
    }
214 -
  } else {
215 -
    # If the intervals apply to all groups
216 -
    if (identical(NA, x$dose)) {
217 -
      ret <- lapply(X=split.PKNCAconc(x$conc),
218 -
                    FUN=function(x) {
219 -
                      list(conc=x,
220 -
                           dose=NA)
221 -
                    })
222 -
    } else {
223 -
      ret <-
224 -
        merge.splitlist(conc=split.PKNCAconc(x$conc),
225 -
                        dose=split.PKNCAdose(x$dose))
226 -
    }
227 -
    ret <- lapply(X=ret,
228 -
                  FUN=function(x, intervals) {
229 -
                    x$intervals <- intervals
230 -
                    x
231 -
                  }, intervals=x$intervals)
232 -
  }
233 -
  for (n in setdiff(names(x), c("conc", "dose", "intervals"))) {
234 -
    # Add any other attributes to all the splits (like options)
235 -
    ret <-
236 -
      lapply(ret, function(x, name, value) {
237 -
        x[[name]] <- value
238 -
        x
239 -
      },
240 -
      name=n, value=x[[n]])
241 -
  }
242 -
  ret
243 196
}

@@ -0,0 +1,247 @@
Loading
1 +
#' Combine PKNCAconc and PKNCAdose objects
2 +
#' 
3 +
#' The function is inspired by \code{dplyr::full_join}, but it has different
4 +
#' semantics.
5 +
#' 
6 +
#' @param conc a PKNCAconc object
7 +
#' @param dose a PKNCAdose object or \code{NA}
8 +
#' @return A tibble with columns for the groups, "data_conc" (the concentration
9 +
#'   data), and "data_dose" (the dosing data).  If \code{is.na(dose)},
10 +
#'   "data_dose" will be \code{NA}.
11 +
#' @family Combine PKNCA objects
12 +
#' @keywords Internal
13 +
#' @noRd
14 +
#' @importFrom dplyr full_join
15 +
#' @importFrom tibble tibble
16 +
#' @importFrom tidyr crossing
17 +
full_join_PKNCAconc_PKNCAdose <- function(conc, dose) {
18 +
  stopifnot(inherits(x=conc, what="PKNCAconc"))
19 +
  if (identical(dose, NA)) {
20 +
    message("No dose information provided, calculations requiring dose will return NA.")
21 +
    n_dose <- tibble::tibble(data_dose=list(NA))
22 +
  } else {
23 +
    stopifnot(inherits(x=dose, what="PKNCAdose"))
24 +
    n_dose <- prepare_PKNCAdose(dose)
25 +
  }
26 +
  n_conc <- prepare_PKNCAconc(conc)
27 +
  shared_groups <- intersect(names(n_conc), names(n_dose))
28 +
  if (length(shared_groups) > 0) {
29 +
    dplyr::full_join(n_conc, n_dose, by=shared_groups)
30 +
  } else {
31 +
    tidyr::crossing(n_conc, n_dose)
32 +
  }
33 +
}
34 +
35 +
#' Convert a PKNCAdata object into a data.frame for analysis
36 +
#' 
37 +
#' The function is inspired by \code{dplyr::full_join}, but it has different
38 +
#' semantics.
39 +
#' 
40 +
#' @param x The PKNCAdata object
41 +
#' @return A tibble with columns the grouping variables, "data_conc" for
42 +
#'   concentration data, "data_dose" for dosing data, and "data_intervals" for
43 +
#'   intervals data.
44 +
#' @family Combine PKNCA objects
45 +
#' @keywords Internal
46 +
#' @noRd
47 +
#' @importFrom dplyr full_join
48 +
#' @importFrom tidyr crossing
49 +
full_join_PKNCAdata <- function(x) {
50 +
  conc_dose <- full_join_PKNCAconc_PKNCAdose(x$conc, x$dose)
51 +
  n_i <-
52 +
    prepare_PKNCAintervals(
53 +
      .dat=x$intervals,
54 +
      vars=setdiff(names(conc_dose), c("data_conc", "data_dose", "data_intervals"))
55 +
    )
56 +
  shared_groups <- intersect(names(conc_dose), names(n_i))
57 +
  if (length(shared_groups) > 0) {
58 +
    ret <- dplyr::full_join(conc_dose, n_i, by=shared_groups)
59 +
  } else {
60 +
    ret <- tidyr::crossing(conc_dose, n_i)
61 +
  }
62 +
  ret
63 +
}
64 +
65 +
#' Prepare a PKNCA object and drop unnecessary columns
66 +
#' 
67 +
#' @param .dat The PKNCA object to prepare as a nested tibble
68 +
#' @param ...,.names_sep,.key Ignored
69 +
#' @return A nested tibble with a column named "data_conc" containing the concentration data and a column 
70 +
#' @family Combine PKNCA objects
71 +
#' @keywords Internal
72 +
#' @noRd
73 +
#' @importFrom dplyr grouped_df
74 +
#' @importFrom tidyr nest
75 +
prepare_PKNCA_general <- function(.dat, cols, exclude, group_cols, data_name, insert_if_missing=list()) {
76 +
  check_reserved_column_names(.dat)
77 +
  intermediate_group_cols <-
78 +
    if (length(group_cols) > 0) {
79 +
      paste0("group", seq_along(group_cols))
80 +
    } else {
81 +
      character(0)
82 +
    }
83 +
  data_no_exclude <-
84 +
    as.data.frame(.dat[
85 +
      is.na(normalize_exclude(.dat[[exclude]])),,
86 +
      drop=FALSE
87 +
    ])
88 +
  data_standard <-
89 +
    standardize_column_names(
90 +
      x=data_no_exclude,
91 +
      cols=cols,
92 +
      group_cols=group_cols,
93 +
      insert_if_missing=insert_if_missing
94 +
    )
95 +
  # data_conc is used since it is reserved, and it will be replaced on the next
96 +
  # line.
97 +
  as_nest <- tidyr::nest(data_standard, data_conc=!intermediate_group_cols)
98 +
  names(as_nest)[names(as_nest) %in% "data_conc"] <- data_name
99 +
  ret <- restore_group_col_names(as_nest, group_cols=group_cols)
100 +
  ret
101 +
}
102 +
103 +
prepare_PKNCAconc <- function(.dat) {
104 +
  # Remove rows to be excluded from all calculations
105 +
  # Drop unnecessary column names
106 +
  pformula_conc <- parseFormula(.dat)
107 +
  needed_cols <-
108 +
    list(
109 +
      conc=all.vars(pformula_conc$lhs),
110 +
      time=all.vars(pformula_conc$rhs),
111 +
      volume=.dat$columns$volume,
112 +
      duration=.dat$columns$duration,
113 +
      include_half.life=.dat$columns$include_half.life,
114 +
      exclude_half.life=.dat$columns$exclude_half.life
115 +
    )
116 +
  ret <-
117 +
    prepare_PKNCA_general(
118 +
      .dat=.dat$data,
119 +
      exclude=.dat$exclude,
120 +
      cols=needed_cols,
121 +
      data_name="data_conc",
122 +
      group_cols=all.vars(pformula_conc$groups)
123 +
    )
124 +
  ret
125 +
}
126 +
127 +
#' @describeIn prepare_PKNCAconc Nest a PKNCAdose object
128 +
#' @noRd
129 +
#' @family Combine PKNCA objects
130 +
#' @keywords Internal
131 +
#' @importFrom dplyr grouped_df
132 +
#' @importFrom tidyr nest
133 +
prepare_PKNCAdose <- function(.dat) {
134 +
  pformula_dose <- parseFormula(.dat)
135 +
  dose_col <- all.vars(pformula_dose$lhs)
136 +
  time_col <- all.vars(pformula_dose$rhs)
137 +
  if (length(dose_col) == 0 || dose_col %in% ".") dose_col <- NULL
138 +
  if (time_col %in% ".") time_col <- NULL
139 +
  needed_cols <-
140 +
    list(
141 +
      dose=dose_col,
142 +
      time=time_col,
143 +
      duration=.dat$columns$duration,
144 +
      route=.dat$columns$route
145 +
    )
146 +
  ret <-
147 +
    prepare_PKNCA_general(
148 +
      .dat=.dat$data,
149 +
      exclude=.dat$exclude,
150 +
      cols=needed_cols,
151 +
      data_name="data_dose",
152 +
      group_cols=all.vars(pformula_dose$groups),
153 +
      insert_if_missing=list(dose=NA, time=NA)
154 +
    )
155 +
  ret
156 +
}
157 +
158 +
#' @describeIn prepare_PKNCAconc Nest a PKNCAdose object
159 +
#' @noRd
160 +
#' @family Combine PKNCA objects
161 +
#' @keywords Internal
162 +
#' @importFrom dplyr grouped_df
163 +
#' @importFrom tidyr nest
164 +
#' @importFrom tibble as_tibble tibble
165 +
prepare_PKNCAintervals <- function(.dat, vars=character(0)) {
166 +
  check_reserved_column_names(.dat)
167 +
  .dat <- tibble::as_tibble(.dat)
168 +
  vars <- intersect(vars, names(.dat))
169 +
  if (length(vars) == 0) {
170 +
    as_nest <- tibble::tibble(data_intervals=list(.dat))
171 +
  } else {
172 +
    as_nest <- tidyr::nest(.dat, data_intervals=!vars)
173 +
  }
174 +
  as_nest
175 +
}
176 +
177 +
#' Confirm that PKNCA reserved column names are not in a data.frame
178 +
#'
179 +
#' @param x A data.frame or similar object
180 +
#' @return NULL (generate an error if a reserved name is present)
181 +
#' @keywords Internal
182 +
#' @noRd
183 +
check_reserved_column_names <- function(x) {
184 +
  reserved_names <- c("data_conc", "data_dose", "data_intervals", "data_results")
185 +
  overlap <- intersect(reserved_names, names(x))
186 +
  if (length(overlap) > 0) {
187 +
    msg <-
188 +
      paste(
189 +
        ngettext(length(overlap), msg1="The column", msg2="The columns"),
190 +
        paste0("'", overlap, "'", collapse=", "),
191 +
        ngettext(length(overlap), msg1="is", msg2="are"),
192 +
        "reserved for internal use in PKNCA.  Change the",
193 +
        ngettext(length(overlap), msg1="name", msg2="names"),
194 +
        "and retry."
195 +
      )
196 +
    stop(msg)
197 +
  }
198 +
}
199 +
200 +
#' Standardize column names and drop unnecessary columns from a data.frame or tibble
201 +
#' 
202 +
#' @param x The data.frame or tibble
203 +
#' @param cols A named list where the names are the standardized column names and the values are the original column names
204 +
#' @return A data.frame or tibble with columns cleaned of unlisted columns and with names set to the expected names.
205 +
#' @noRd
206 +
#' @keywords Internal
207 +
standardize_column_names <- function(x, cols, group_cols=NULL, insert_if_missing=list()) {
208 +
  stopifnot("cols must be a list"=is.list(cols))
209 +
  stopifnot("cols must be named"=!is.null(names(cols)))
210 +
  stopifnot("all cols must be named"=!any(names(cols) %in% ""))
211 +
  stopifnot("all original cols names must be names of x"=all(unlist(cols) %in% names(x)))
212 +
  stopifnot("group_cols must be NULL or a character vector"=is.null(group_cols) || is.character(group_cols))
213 +
  if (!is.null(group_cols)) {
214 +
    stopifnot("group_cols must not overlap with other column names"=!any(group_cols %in% unlist(cols)))
215 +
    stopifnot("group_cols must not overlap with standardized column names"=!any(group_cols %in% names(cols)))
216 +
    new_group_cols <- paste0("group", seq_along(group_cols))
217 +
  } else {
218 +
    new_group_cols <- NULL
219 +
  }
220 +
  cols_clean <- cols[!sapply(X=cols, FUN=is.null)]
221 +
  ret <-
222 +
    setNames(
223 +
      # Keep only columns of interest
224 +
      x[, c(group_cols, unlist(cols_clean)), drop=FALSE],
225 +
      nm=c(new_group_cols, names(cols_clean))
226 +
    )
227 +
  for (current_nm in names(insert_if_missing)) {
228 +
    if (!(current_nm %in% names(ret))) {
229 +
      ret[[current_nm]] <- insert_if_missing[[current_nm]]
230 +
    }
231 +
  }
232 +
  ret
233 +
}
234 +
235 +
restore_group_col_names <- function(x, group_cols=NULL) {
236 +
  if (is.null(group_cols)) {
237 +
    return(x)
238 +
  }
239 +
  new_group_cols <- paste0("group", seq_along(group_cols))
240 +
  stopifnot("missing intermediate group_cols names"=all(new_group_cols %in% names(x)))
241 +
  stopifnot(
242 +
    "Intermediate group_cols are out of order"=
243 +
      all(names(x)[names(x) %in% new_group_cols] == new_group_cols)
244 +
  )
245 +
  names(x)[names(x) %in% new_group_cols] <- group_cols
246 +
  x
247 +
}

@@ -57,22 +57,21 @@
Loading
57 57
superposition.PKNCAconc <- function(conc, ...) {
58 58
  ## Split the data by grouping and extract just the concentration and
59 59
  ## time columns
60 -
  tmp.data <- split.PKNCAconc(conc)
61 -
  groupinfo <- attr(tmp.data, 'groupid')
62 -
  tmp.results <-
60 +
  nested_data <- prepare_PKNCAconc(conc)
61 +
  tmp_results <-
63 62
    parallel::mclapply(
64 -
      X=seq_along(tmp.data),
65 -
      FUN=function(x, conc.col, time.col, ...) {
66 -
        cbind(groupinfo[x,,drop=FALSE],
67 -
              superposition.numeric(tmp.data[[x]]$data[[conc.col]],
68 -
                                    tmp.data[[x]]$data[[time.col]],
69 -
                                    ...),
70 -
              row.names=NULL)
71 -
      },
72 -
      conc.col=as.character(parseFormula(conc)$lhs),
73 -
      time.col=as.character(parseFormula(conc)$rhs),
74 -
      ...)
75 -
  dplyr::bind_rows(tmp.results)
63 +
      X=seq_len(nrow(nested_data)),
64 +
      FUN=function(idx) {
65 +
        superposition.numeric(
66 +
          conc=nested_data$data_conc[[idx]]$conc,
67 +
          time=nested_data$data_conc[[idx]]$time,
68 +
          ...
69 +
        )
70 +
      }
71 +
    )
72 +
  # Replace the concentration data with the new results
73 +
  nested_data$data_conc <- tmp_results
74 +
  tidyr::unnest(nested_data, cols="data_conc")
76 75
}
77 76
78 77
#' @rdname superposition

Click to load this diff.
Loading diff...

Click to load this diff.
Loading diff...

Learn more Showing 3 files with coverage changes found.

Changes in R/pk.calc.all.R
-3
+3
Loading file...
New file R/prepare_data.R
New
Loading file...
Changes in R/parseFormula.R
-1
+1
Loading file...
Files Coverage
R 0.31% 96.16%
Project Totals (33 files) 96.16%
Loading