Nothing
dataCheck <- function(time1, event1, Stime, event, names, arg=TRUE) {
if (arg) {Singular <- "Argument"; Plural <- "Arguments";}
else {Singular <- "Variable"; Plural <- "Variables";}
Message <- paste(Singular, " '", names[1], "' is not numeric", sep="");
if ( !is.numeric(time1) ) {return(Message);}
Message <- paste(Singular, " '", names[2], "' must be logical or numeric", sep="");
if ( !( is.logical(event1) | is.numeric(event1) ) ) {return(Message);}
Message <- paste(Singular, " '", names[3], "' is not numeric", sep="");
if ( !is.numeric(Stime) ) {return(Message);}
Message <- paste(Singular, " '", names[4], "' must be logical or numeric", sep="");
if ( !( is.logical(event) | is.numeric(event) ) ) {return(Message);}
Message <- paste(Plural, " '", names[1], "', '", names[2], "', '", names[3], " and '", names[4], "' must have the same length", sep="");
if ( length(time1) != length(event1) | length(time1) != length(Stime) | length(time1) != length(event) ) {return(Message);}
Message <- paste(Singular, " '", names[2], "' must be 0 or 1 if numeric and TRUE or FALSE if logical", sep="");
if ( any( (event1 != 0 & event1 != 1) | (event1 != FALSE & event1 != TRUE) ) ) {return(Message);}
Message <- paste(Singular, " '", names[4], "' must be 0 or 1 if numeric and TRUE or FALSE if logical", sep="");
if ( any( (event != 0 & event != 1) | (event != FALSE & event != TRUE) ) ) {return(Message);}
Message <- paste(Plural, " '", names[1], "' and '", names[3], "' must be greater or equal than 0", sep="");
if ( any(time1 < 0 | Stime < 0) ) {return(Message);}
Message <- paste(Singular, " '", names[3], "' must be greater or equal to ", tolower(Singular), " '", names[1], "'", sep="");
if ( any(Stime < time1) ) {return(Message);}
Message <- paste(Plural, " '", names[3], "' and '", names[1], "' must be equal when ", tolower(Singular), " '", names[2], "' equals 0 or FALSE", sep="");
if ( any(!event1 & Stime != time1) ) {return(Message);}
Message <- paste(Singular, " '", names[4], "' must be equal to 0 or FALSE when ", tolower(Singular), " '", names[2], "' equals 0 or FALSE", sep="");
if ( any(!event1 & event) ) {return(Message);}
Message <- paste("When ", tolower(Plural), " '", names[3], "' and '", names[1], "' are equal and ", tolower(Singular), " '", names[2], "' equals 1 or TRUE, ", tolower(Singular), " '", names[4], "' must equal 1 or TRUE", sep="");
if ( any(time1 == Stime & event1 & !event) ) {return(Message);}
return(NULL);
} # dataCheck
TPCheck <- function(object, s, t) {
if ( !is.survTP(object) ) {return("Argument 'object' must be of class 'survTP'");}
if ( !is.numeric(s) ) {return("Argument 's' is not numeric");}
if ( !is.numeric(t) ) {return("Argument 't' is not numeric");}
if ( !(0 <= s & s <= t) ) {return("'s' and 't' must be positive, and s <= t");}
return(NULL);
} # TPCheck
TPCCheck <- function(object, s, t, x) {
Message <- TPCheck(object, s, t);
if ( !is.null(Message) ) {return(Message);}
if ( !is.numeric(x) ) {return("Argument 'x' is not numeric");}
return(NULL);
} # TPCCheck
TPWindowCheck <- function(h, nh, ncv, window) {
if ( !is.numeric(h) ) {return("Argument 'h' must be numeric");}
if (length(h) < 1 | length(h) > 4) {return("Argument 'h' length must be between 1 and 4");}
if ( any(h <= 0) ) {return("Argument 'h' must be greater than 0");}
if ( !( is.numeric(nh) | is.integer(nh) ) ) {return("Argument 'nh' must be numeric or integer");}
if (nh <= 1) {return("Argument 'nh' must be greater than 1");}
if ( !( is.numeric(ncv) | is.integer(ncv) ) ) {return("Argument 'ncv' must be numeric or integer");}
if (ncv < 10) {return("Argument 'ncv' must be greater or equal than 10");}
window0 <- c("normal", "epanech", "biweight", "triweight");
window1 <- c(window0, "box");
window2 <- c(window1, "tricube", "triangular", "cosine");
if ( !( window %in% window2 ) ) {return("Argument 'window' must be one of 'normal', 'epanech', 'biweight', 'triweight', 'box', 'tricube', 'triangular' or 'cosine'");}
return(NULL);
} # TPWindowCheck
TPCWindowCheck <- function(bw, window, method.weights) {
if ( !( is.character(bw) | is.numeric(bw) ) ) {return("Argument 'bw' must be either a character string or a numeric vector");}
if ( is.character(bw) ) {
if ( !exists(bw, mode="function") ) {return( paste("could not find function '", bw, "'", sep="") );}
}
window0 <- c("normal", "epanech", "biweight", "triweight");
window1 <- c(window0, "box");
window2 <- c(window1, "tricube", "triangular", "cosine");
if (bw %in% c("ALbw", "CVbw", "PBbw") & !( window %in% window0 ) ) {return("Argument 'window' must be one of 'normal', 'epanech', 'biweight' or 'triweight'");}
else if (bw == "dpik" & !( window %in% window1 ) ) {return("Argument 'window' must be one of 'normal', 'epanech', 'biweight', 'triweight' or 'box'");}
if ( !( window %in% window2 ) ) {return("Argument 'window' must be one of 'normal', 'epanech', 'biweight', 'triweight', 'box', 'tricube', 'triangular' or 'cosine'");}
if ( !method.weights %in% c("NW", "LL") ) {return("Argument 'weights' must be one of 'NW' or 'LL'");}
return(NULL);
} # TPCWindowCheck
StateCheck <- function(state.names) {
if (length(state.names) != 3) {return("Argument 'state.names' length must be equal to 3");}
if ( length(state.names) != length( unique(state.names) ) ) {return("Argument 'state.names' must be unique");}
return(NULL);
} # StateCheck
BootCheck <- function(conf, n.boot, conf.level, method.boot) {
if ( !is.logical(conf) ) {return("Argument 'conf' must be logical");}
if ( !( is.numeric(n.boot) | is.integer(n.boot) ) ) {return("Argument 'n.boot' must be numeric or integer");}
if (n.boot <= 1) {return("Argument 'n.boot' must be greater than 1");}
if ( !is.numeric(conf.level) ) {return("Argument 'conf.level' is not numeric");}
if (conf.level < 0 | conf.level > 1) {return("Argument 'conf.level' must be between 0 and 1");}
if ( !( method.boot %in% c("percentile", "basic") ) ) {return("Argument 'method.boot' must be one of 'percentile' or 'basic'");}
return(NULL);
} # BootCheck
CvalCheck <- function(boot.cv, cv.full) {
if ( !is.logical(boot.cv) ) {return("Argument 'boot.cv' must be logical");}
if ( !is.logical(cv.full) ) {return("Argument 'cv.full' must be logical");}
return(NULL);
} # CvalCheck
TPStateBootCheck <- function(object, s, t, state.names, conf, n.boot, conf.level, method.boot) {
Message <- TPCheck(object, s, t);
if ( !is.null(Message) ) {return(Message);}
Message <- StateCheck(state.names);
if ( !is.null(Message) ) {return(Message);}
Message <- BootCheck(conf, n.boot, conf.level, method.boot);
return(Message);
} # TPStateBootCheck
TPWindowStateBootCvalCheck <- function(object, s, t, h, nh, ncv, window, state.names, conf, n.boot, conf.level, method.boot, boot.cv, cv.full) {
Message <- TPCheck(object, s, t);
if ( !is.null(Message) ) {return(Message);}
Message <- TPWindowCheck(h, nh, ncv, window);
if ( !is.null(Message) ) {return(Message);}
Message <- StateCheck(state.names);
if ( !is.null(Message) ) {return(Message);}
Message <- BootCheck(conf, n.boot, conf.level, method.boot);
if ( !is.null(Message) ) {return(Message);}
Message <- CvalCheck(boot.cv, cv.full);
return(Message);
} # TPWindowStateBootCvalCheck
TPCWindowStateBootCheck <- function(object, s, t, x, bw, window, method.weights, state.names, conf, n.boot, conf.level, method.boot) {
Message <- TPCCheck(object, s, t, x);
if ( !is.null(Message) ) {return(Message);}
Message <- TPCWindowCheck(bw, window, method.weights);
if ( !is.null(Message) ) {return(Message);}
Message <- StateCheck(state.names);
if ( !is.null(Message) ) {return(Message);}
Message <- BootCheck(conf, n.boot, conf.level, method.boot);
return(Message);
} # TPCWindowStateBootCheck
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.