Nothing
#####################################################################################
## Author: Daniel Sabanes Bove [sabanesd *a*t* roche *.* com]
## Project: Object-oriented implementation of CRM designs
##
## Time-stamp: <[Data-class.R] by DSB Mon 11/05/2015 17:42>
##
## Description:
## Encapsulate the data input in formal classes.
##
## History:
## 29/01/2014 file creation
## 07/02/2014 add cohort indices
###################################################################################
##' @include helpers.R
{}
## ============================================================
## --------------------------------------------------
## Class for general data input
## --------------------------------------------------
##' Class for general data input
##'
##' @slot ID unique patient IDs (integer vector)
##' @slot cohort the cohort indices (sorted values from 0, 1, 2, ...)
##' @slot nObs number of observations
##'
##' @export
##' @keywords classes
.GeneralData <-
setClass(Class="GeneralData",
representation(ID="integer",
cohort="integer",
nObs="integer"),
prototype(ID=integer(),
cohort=integer(),
nObs=0L),
validity=
function(object){
o <- Validate()
o$check(all(! duplicated(object@ID)),
"IDs must be unique")
o$check(all(object@cohort >= 0),
"cohort indices must be non-negative")
o$check(! is.unsorted(object@cohort,
strictly=FALSE),
"cohort indices must be sorted")
for(thisSlot in c("cohort", "ID"))
o$check(identical(object@nObs, length(slot(object, thisSlot))),
paste(thisSlot, "must have length nObs"))
o$result()
})
validObject(.GeneralData())
## ============================================================
## --------------------------------------------------
## Class for the data input
## --------------------------------------------------
##' Class for the data input
##'
##' This class inherits from \code{\linkS4class{GeneralData}}.
##'
##' @slot x the doses for the patients
##' @slot y the vector of toxicity events (0 or 1 integers)
##' @slot doseGrid the vector of all possible doses (sorted), i.e. the dose
##' grid
##' @slot nGrid number of gridpoints
##' @slot xLevel the levels for the doses the patients have been given
##' @slot placebo logical value: if TRUE the first dose level in the grid is
##' considered as PLACEBO
##'
##' @example examples/Data-class.R
##' @export
##' @keywords classes
.Data <-
setClass(Class="Data",
representation(x="numeric",
y="integer",
doseGrid="numeric",
nGrid="integer",
xLevel="integer",
placebo="logical"),
prototype(x=numeric(),
y=integer(),
doseGrid=numeric(),
nGrid=0L,
xLevel=integer(),
placebo=FALSE),
contains="GeneralData",
validity=
function(object){
o <- Validate()
o$check(all(object@y %in% c(0, 1)),
"DLT vector y can only have 0 or 1 values")
if(!object@placebo){
o$check(all(tapply(X=object@x,
INDEX=object@cohort,
FUN=
function(doses){length(unique(doses))}) == 1),
"there must be only one dose level per cohort")
}else{
o$check(all(tapply(X=object@x,
INDEX=object@cohort,
FUN=
function(doses){
doses <- doses[doses != object@doseGrid[1]]
length(unique(doses))}) == 1),
"There must be only one dose level, other than placebo, per cohort. In addition a cohort with only placebo is not allowed")
}
o$check(all(object@x %~% object@doseGrid),
"dose values in x must be from doseGrid (tolerance 1e-10)")
o$check(! is.unsorted(object@doseGrid,
strictly=TRUE),
"doseGrid must be sorted and without duplicate values")
for(thisSlot in c("x", "y"))
o$check(identical(object@nObs, length(slot(object, thisSlot))),
paste(thisSlot, "must have length nObs"))
o$check(identical(object@nGrid, length(object@doseGrid)),
"doseGrid must have length nGrid")
o$check(all.equal(object@x,
object@doseGrid[object@xLevel],
tolerance=1e-10,
check.names=FALSE,
check.attributes=FALSE),
"x must be doseGrid[xLevel] (tolerance 1e-10)")
o$result()
})
validObject(.Data())
##' Initialization function for the "Data" class
##'
##' This is the function for initializing a "Data" class object.
##'
##' Note that \code{ID} and \code{cohort} can be missing, then a warning
##' will be issued and the variables will be filled with default
##' IDs and best guesses, respectively.
##'
##' @param x the doses for the patients
##' @param y the vector of toxicity events (0 or 1 integers). You can also
##' normal numeric vectors, but these will then be converted to integers.
##' @param ID unique patient IDs (integer vector)
##' @param cohort the cohort indices (sorted values from 0, 1, 2, ...)
##' @param doseGrid the vector of all possible doses
##' @param placebo logical value: if TRUE the first dose level in the grid is
##' considered as PLACEBO
##' @param \dots not used
##' @return the initialized \code{\linkS4class{Data}} object
##'
##' @export
##' @keywords programming
Data <- function(x=numeric(),
y=integer(),
ID=integer(),
cohort=integer(),
doseGrid=numeric(),
placebo=FALSE,
...){
## sort the dose grid
doseGrid <- as.numeric(sort(unique(doseGrid)))
## check IDs
if((missing(ID) || length(ID) == 0) && length(x))
{
warning("Used default patient IDs!")
ID <- seq_along(x)
}
## check cohort indices
if((missing(cohort) || length(cohort) == 0) && length(x))
{
warning("Used best guess cohort indices!")
## This is just assuming that consecutive patients
## in the data set are in the same cohort if they
## have the same dose. Note that this could be wrong,
## if two subsequent cohorts are at the same dose.
cohort <- as.integer(c(1, 1 + cumsum(diff(x) != 0)))
}
## then initialize the Data object
## (in this case just putting arguments into slots)
ret <- .Data(x=as.numeric(x),
y=safeInteger(y),
ID=safeInteger(ID),
cohort=safeInteger(cohort),
doseGrid=doseGrid,
nObs=length(x),
nGrid=length(doseGrid),
xLevel=matchTolerance(x=x, table=doseGrid),
placebo=placebo)
return(ret)
}
validObject(Data())
## ============================================================
## --------------------------------------------------
## Subclass with additional biomarker information
## --------------------------------------------------
##' Class for the dual endpoint data input
##'
##' This is a subclass of \code{\linkS4class{Data}}, so contains all
##' slots from \code{\linkS4class{Data}}, and in addition biomarker
##' values.
##'
##' @slot w the continuous vector of biomarker values
##'
##' @example examples/Data-class-DataDual.R
##' @export
##' @keywords classes
.DataDual <-
setClass(Class="DataDual",
representation=
representation(w="numeric"),
contains="Data",
validity=
function(object){
o <- Validate()
o$check(identical(object@nObs, length(object@w)),
"w must have length nObs")
o$result()
})
validObject(.DataDual())
##' Initialization function for the "DataDual" class
##'
##' This is the function for initializing a "DataDual" class object.
##'
##' @param w the continuous vector of biomarker values
##' @param \dots additional parameters from \code{\link{Data}}
##' @return the initialized \code{\linkS4class{DataDual}} object
##'
##' @export
##' @keywords programming
DataDual <- function(w=numeric(),
...)
{
start <- Data(...)
.DataDual(start,
w=w)
}
validObject(DataDual())
## ============================================================
## --------------------------------------------------
## Subclass with additional two parts information
## --------------------------------------------------
##' Class for the data with two study parts
##'
##' This is a subclass of \code{\linkS4class{Data}}, so contains all
##' slots from \code{\linkS4class{Data}}, and in addition information on the two
##' study parts.
##'
##' @slot part integer vector; which part does each of the patients belong to?
##' @slot nextPart integer; what is the part for the next cohort?
##' @slot part1Ladder sorted numeric vector; what is the escalation ladder for
##' part 1? This shall be a subset of the \code{doseGrid}.
##'
##' @example examples/Data-class-DataParts.R
##' @export
##' @keywords classes
.DataParts <-
setClass(Class="DataParts",
representation(part="integer",
nextPart="integer",
part1Ladder="numeric"),
prototype(part=integer(),
nextPart=1L,
part1Ladder=numeric()),
contains="Data",
validity=
function(object){
o <- Validate()
o$check(identical(length(object@part), length(object@x)),
"part and x must have same length")
o$check(all(object@part %in% as.integer(c(1, 2))),
"part must have entries 1 or 2")
o$check(is.scalar(object@nextPart) &&
(object@nextPart %in% as.integer(c(1, 2))),
"nextPart must be scalar 1 or 2")
o$check(all(object@part1Ladder %in% object@doseGrid),
"part1Ladder must have entries from doseGrid")
o$check(! is.unsorted(object@part1Ladder,
strictly=TRUE),
"part1Ladder must be sorted and have unique values")
o$result()
})
validObject(.DataParts())
##' Initialization function for the "DataParts" class
##'
##' This is the function for initializing a \code{\linkS4class{DataParts}}
##' object.
##'
##' @param part which part does each of the patients belong to?
##' @param nextPart what is the part for the next cohort? (1 or 2)
##' @param part1Ladder what is the escalation ladder for
##' part 1?
##' @param \dots additional parameters from \code{\link{Data}}
##' @return the initialized \code{\linkS4class{DataParts}} object
##'
##' @export
##' @keywords programming
DataParts <- function(part=integer(),
nextPart=1L,
part1Ladder=numeric(),
...)
{
start <- Data(...)
.DataParts(start,
part=part,
nextPart=nextPart,
part1Ladder=part1Ladder)
}
validObject(DataParts())
## ============================================================
## --------------------------------------------------
## Subclass with additional data for mixture
## --------------------------------------------------
##' Class for the data with mixture sharing
##'
##' @slot xshare the doses for the share patients
##' @slot yshare the vector of toxicity events (0 or 1 integers) for the share
##' patients
##' @slot nObsshare number of share patients
##'
##' @seealso \code{\linkS4class{LogisticLogNormalMixture}} for the explanation
##' how to use this data class
##' @export
##' @example examples/Model-class-LogisticLogNormalMixture.R
##' @keywords classes
.DataMixture <-
setClass(Class="DataMixture",
representation(xshare="numeric",
yshare="integer",
nObsshare="integer"),
prototype(xshare=numeric(),
yshare=integer(),
nObsshare=0L),
contains="Data",
validity=
function(object){
o <- Validate()
o$check(all(object@yshare %in% c(0, 1)),
"DLT vector yshare can only have 0 or 1 values")
o$check(all(object@xshare %in% object@doseGrid),
"dose values in xshare must be from doseGrid")
for(thisSlot in c("xshare", "yshare"))
o$check(identical(object@nObsshare, length(slot(object, thisSlot))),
paste(thisSlot, "must have length nObs"))
o$result()
})
validObject(.DataMixture())
##' Initialization function for the "DataMixture" class
##'
##' This is the function for initializing a "DataMixture" class object.
##'
##' @param xshare see \code{\linkS4class{DataMixture}}
##' @param yshare see \code{\linkS4class{DataMixture}}
##' @param \dots additional arguments for the underlying Data slots
##'
##' @return the initialized \code{\linkS4class{DataMixture}} object
##'
##' @export
##' @keywords programming
DataMixture <- function(xshare=numeric(),
yshare=integer(),
...){
start <- Data(...)
ret <- .DataMixture(start,
xshare=as.numeric(xshare),
yshare=safeInteger(yshare),
nObsshare=length(xshare))
return(ret)
}
validObject(DataMixture())
## ============================================================
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.