From c875f53c5657c4be5d1b8cc78bfed81bb471e521 Mon Sep 17 00:00:00 2001 From: Gavin Rhys Lloyd Date: Mon, 10 Aug 2020 10:31:30 +0100 Subject: [PATCH 1/9] fix for https://github.com/computational-metabolomics/struct/issues/18 (#19) - incorrect use of `$assay` replaced with `$data` for DatasetExperiment objects - specify SummarizedExperiment package as source of `rowData` and `colData` functions --- R/DatasetExperiment_class.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/DatasetExperiment_class.R b/R/DatasetExperiment_class.R index afe47e0..c082528 100644 --- a/R/DatasetExperiment_class.R +++ b/R/DatasetExperiment_class.R @@ -145,9 +145,9 @@ setMethod (f = 'as.SummarizedExperiment', signature = 'DatasetExperiment', definition = function(obj) { out=SummarizedExperiment( - assays=list(t(obj$assay)), - colData=rowData(obj), - rowData=colData(obj), + assays=list(t(obj$data)), + colData=SummarizedExperiment::rowData(obj), + rowData=SummarizedExperiment::colData(obj), metadata=list( 'name'=obj$name, 'description'=obj$description, From 00ec47a578863c8129314981f2ba74220c7a1716 Mon Sep 17 00:00:00 2001 From: Gavin Rhys Lloyd Date: Tue, 6 Oct 2020 09:20:27 +0100 Subject: [PATCH 2/9] fix for #20 (#21) data now gets passed through as intended when model_seq is being used. Allows seq_in to be used at the nth step in a sequence --- R/model_list_class.R | 23 +++++++++++++++-------- 1 file changed, 15 insertions(+), 8 deletions(-) diff --git a/R/model_list_class.R b/R/model_list_class.R index 1996589..182b922 100644 --- a/R/model_list_class.R +++ b/R/model_list_class.R @@ -42,7 +42,7 @@ setMethod(f = "model_train", signature = c("model_seq","DatasetExperiment"), definition = function(M,D) { # for each model in the list - S = D # for first in list the input D is the data object + # for first in list the input D is the data object for (i in seq_len(length(M))) { if (M[i]@seq_in != 'data') { # apply transformation @@ -52,9 +52,9 @@ setMethod(f = "model_train", } # train the model on the output of the previous model - M[i] = model_train(M[i],S) + M[i] = model_train(M[i],D) # apply the model to the output of the previous model - M[i] = model_predict(M[i],S) + M[i] = model_predict(M[i],D) # set the output of this model as the input for the next model S = predicted(M[i]) @@ -78,15 +78,22 @@ setMethod(f = "model_train", setMethod(f = "model_predict", signature = c("model_seq",'DatasetExperiment'), definition = function(M,D) { - S = D # for the first model the input use the input data + # for the first model the input use the input data + S=D L = length(M) # number of models for (i in seq_len(L)) { # apply the model the output of the previous model - M[i] = model_predict(M[i],S) - # keep the previous output - penultimate = S - # set the output of this model as the input to the next + M[i] = model_predict(M[i],D) + + # get the output of this model S = predicted(M[i]) + if (is(S,'DatasetExperiment')) { + # keep the previous output + penultimate = D + # update data for the next model + D = S + # otherwise the previous data output is used + } } # if regression, reverse the processing to get predictions From c5e53fee12a4c5bedf0cb450596204792225c460 Mon Sep 17 00:00:00 2001 From: Gavin Rhys Lloyd Date: Fri, 9 Oct 2020 10:43:14 +0100 Subject: [PATCH 3/9] fix for #20 (#23) data now gets passed through as intended when model_seq is being used. Allows seq_in to be used at the nth step in a sequence From ed5833449d27318cd88127dd343074e6863db1fb Mon Sep 17 00:00:00 2001 From: Gavin Rhys Lloyd Date: Fri, 9 Oct 2020 12:13:21 +0100 Subject: [PATCH 4/9] Issue 22 seq in (#24) * add seq_in generics * add seq_in methods - added methods for models to get.set seq_in - added checks for valid input/output names to seq_in and predicted_name methods * update documentation * use correct input param id * update documentation - use of input_1 instead of value_1 fixed in examples - corrected rdname for seq_in --- DESCRIPTION | 4 ++-- NAMESPACE | 3 +++ R/generics.R | 29 ++++++++++++++++++++++++++-- R/model_class.R | 44 ++++++++++++++++++++++++++++++++++++++++++- man/model.Rd | 18 ++++++++++++++++++ man/predicted_name.Rd | 3 +-- man/seq_in.Rd | 34 +++++++++++++++++++++++++++++++++ 7 files changed, 128 insertions(+), 7 deletions(-) create mode 100644 man/seq_in.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 428635d..07a2b2b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: struct Type: Package Title: Statistics in R Using Class-based Templates -Version: 1.1.0 +Version: 1.1.0 Authors@R: c( person( c("Gavin","Rhys"), @@ -49,7 +49,7 @@ Collate: 'resampler_class.R' 'struct.R' 'struct_templates.R' -RoxygenNote: 7.1.0 +RoxygenNote: 7.1.1 Depends: R (>= 4.0) Suggests: testthat, diff --git a/NAMESPACE b/NAMESPACE index 8e0c26e..e3e5920 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -52,6 +52,7 @@ export(resampler) export(result) export(result_name) export(run) +export(seq_in) export(set_obj_method) export(set_obj_show) export(set_struct_obj) @@ -81,6 +82,7 @@ exportMethods("param_obj<-") exportMethods("param_value<-") exportMethods("predicted_name<-") exportMethods("result_name<-") +exportMethods("seq_in<-") exportMethods("value<-") exportMethods(as.DatasetExperiment) exportMethods(as.SummarizedExperiment) @@ -113,6 +115,7 @@ exportMethods(predicted_name) exportMethods(result) exportMethods(result_name) exportMethods(run) +exportMethods(seq_in) exportMethods(stato_definition) exportMethods(stato_id) exportMethods(stato_name) diff --git a/R/generics.R b/R/generics.R index 0b8301d..f78c1c4 100644 --- a/R/generics.R +++ b/R/generics.R @@ -330,8 +330,7 @@ setGeneric("model_reverse",function(M,D)standardGeneric("model_reverse")) #' @return #' \describe{ #' \item{\code{predicted_name}}{returns the name of the predicted output} -#' \item{\code{predicted_name<-}}{sets the name of the predicted output and -#' returns the modified object} +#' \item{\code{predicted_name<-}}{sets the name of the predicted output} #' } #' @rdname predicted_name #' @examples @@ -345,6 +344,32 @@ setGeneric("predicted_name",function(M)standardGeneric("predicted_name")) setGeneric("predicted_name<-", function(M,value)standardGeneric("predicted_name<-")) +#' Sequence input +#' +#' get/set the input parameter replaced by the output of the previous model in +#' a model sequence. Default is "data" which passes the output as the data input +#' for methods such as \code{model_train} and \code{model_apply}. +#' @param M a model object +#' @param value name of an output for this model +#' @return +#' \describe{ +#' \item{\code{seq_in}}{returns the name of the input parameter replaced +#' when used in a model sequence} +#' \item{\code{seq_in<-}}{sets the name of the input parameter replaced +#' when used in a model sequence} +#' } +#' @rdname seq_in +#' @examples +#' M = example_model() +#' seq_in(M) +#' seq_in(M) = 'value_1' +#' @export +setGeneric("seq_in",function(M)standardGeneric("seq_in")) + +#' @rdname seq_in +setGeneric("seq_in<-", + function(M,value)standardGeneric("seq_in<-")) + #' Prediction output #' #' returns the prediction output for a model_ This is supplied as input to the diff --git a/R/model_class.R b/R/model_class.R index 61da2af..600fe4f 100644 --- a/R/model_class.R +++ b/R/model_class.R @@ -151,6 +151,43 @@ setMethod(f = 'predicted', ) +#' @rdname model +#' @export +#' @examples +#' D = DatasetExperiment() +#' M = example_model() +#' seq_in(M) = 'data' +#' @return the id of the input parameter to be replaced by the \code{predicted} +#' output of the previous model in a model sequence. Reserved keyword 'data' +#' means that the input data used by \code{model_train}, \code{model_apply} etc is used. +#' \code{seq_in = 'data'} is the default setting. +setMethod(f = 'seq_in', + signature = c('model'), + definition = function(M) { + return(M@seq_in) + } + +) + +#' @rdname model +#' @export +#' @examples +#' M = example_model() +#' seq_in(M) = 'value_1' +#' @return the modified model object +setMethod(f = 'seq_in<-', + signature = c('model','character'), + definition = function(M,value) { + if (value %in% param_ids(M) | value=='data') { + M@seq_in = value + } else { + stop(paste0('"', value, '" is not a valid input parameter id for', + ' a '), class(M), ' object.') + } + return(M) + } +) + #' @rdname model #' @export #' @examples @@ -173,7 +210,12 @@ setMethod(f = 'predicted_name', setMethod(f = 'predicted_name<-', signature = c('model','character'), definition = function(M,value) { - M@predicted = value + if (value %in% output_ids(M)) { + M@predicted = value + } else { + stop(paste0('"', value, '" is not a valid output id for', + ' a '), class(M), ' object.') + } return(M) } ) diff --git a/man/model.Rd b/man/model.Rd index 166df2a..cf5024e 100644 --- a/man/model.Rd +++ b/man/model.Rd @@ -7,6 +7,8 @@ \alias{model_apply,model,DatasetExperiment-method} \alias{model_reverse,model,DatasetExperiment-method} \alias{predicted,model-method} +\alias{seq_in,model-method} +\alias{seq_in<-,model,character-method} \alias{predicted_name,model-method} \alias{predicted_name<-,model,character-method} \title{model class} @@ -28,6 +30,10 @@ model( \S4method{predicted}{model}(M) +\S4method{seq_in}{model}(M) + +\S4method{seq_in}{model,character}(M) <- value + \S4method{predicted_name}{model}(M) \S4method{predicted_name}{model,character}(M) <- value @@ -60,6 +66,13 @@ dataset dataset object with the reverse model applied the predicted output, as specified by predicted_name +the id of the input parameter to be replaced by the \code{predicted} +output of the previous model in a model sequence. Reserved keyword 'data' +means that the input data used by \code{model_train}, \code{model_apply} etc is used. +\code{seq_in = 'data'} is the default setting. + +the modified model object + the id of the output returned by predicted() the modified model object @@ -111,6 +124,11 @@ M = example_model() M = model_train(M,D) M = model_predict(M,D) p = predicted(M) +D = DatasetExperiment() +M = example_model() +seq_in(M) = 'data' +M = example_model() +seq_in(M) = 'value_1' M = example_model() predicted_name(M) M = example_model() diff --git a/man/predicted_name.Rd b/man/predicted_name.Rd index bf96f95..03ab1d9 100644 --- a/man/predicted_name.Rd +++ b/man/predicted_name.Rd @@ -17,8 +17,7 @@ predicted_name(M) <- value \value{ \describe{ \item{\code{predicted_name}}{returns the name of the predicted output} -\item{\code{predicted_name<-}}{sets the name of the predicted output and -returns the modified object} +\item{\code{predicted_name<-}}{sets the name of the predicted output} } } \description{ diff --git a/man/seq_in.Rd b/man/seq_in.Rd new file mode 100644 index 0000000..70e23ec --- /dev/null +++ b/man/seq_in.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/generics.R +\name{seq_in} +\alias{seq_in} +\alias{seq_in<-} +\title{Sequence input} +\usage{ +seq_in(M) + +seq_in(M) <- value +} +\arguments{ +\item{M}{a model object} + +\item{value}{name of an output for this model} +} +\value{ +\describe{ +\item{\code{seq_in}}{returns the name of the input parameter replaced +when used in a model sequence} +\item{\code{seq_in<-}}{sets the name of the input parameter replaced +when used in a model sequence} +} +} +\description{ +get/set the input parameter replaced by the output of the previous model in +a model sequence. Default is "data" which passes the output as the data input +for methods such as \code{model_train} and \code{model_apply}. +} +\examples{ +M = example_model() +seq_in(M) +seq_in(M) = 'value_1' +} From 41307a09642332afbc5eb86bf026e92a8ba21b65 Mon Sep 17 00:00:00 2001 From: Gavin Rhys Lloyd Date: Mon, 12 Oct 2020 10:35:45 +0100 Subject: [PATCH 5/9] add as.code method (#25) * add as.code method produces a string of text that can be used to recreate the model/sequence/iterator * use correct input parameter names cmd check fails if examples dont run --- NAMESPACE | 2 ++ R/generics.R | 22 +++++++++++- R/iterator_class.R | 39 +++++++++++++++++++++ R/model_class.R | 82 +++++++++++++++++++++++++++++++++++++++++++- R/model_list_class.R | 24 ++++++++++++- man/as.code.Rd | 49 ++++++++++++++++++++++++++ 6 files changed, 215 insertions(+), 3 deletions(-) create mode 100644 man/as.code.Rd diff --git a/NAMESPACE b/NAMESPACE index e3e5920..8d1d4ab 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -8,6 +8,7 @@ export("param_value<-") export(DatasetExperiment) export(as.DatasetExperiment) export(as.SummarizedExperiment) +export(as.code) export(as_data_frame) export(calculate) export(chart) @@ -86,6 +87,7 @@ exportMethods("seq_in<-") exportMethods("value<-") exportMethods(as.DatasetExperiment) exportMethods(as.SummarizedExperiment) +exportMethods(as.code) exportMethods(calculate) exportMethods(chart_names) exportMethods(chart_plot) diff --git a/R/generics.R b/R/generics.R index f78c1c4..7b705a4 100644 --- a/R/generics.R +++ b/R/generics.R @@ -602,6 +602,23 @@ setGeneric("as.SummarizedExperiment",function(obj)standardGeneric("as.Summarized #' @export setGeneric("as.DatasetExperiment",function(obj)standardGeneric("as.DatasetExperiment")) +#' Convert to code +#' +#' Prints a block of code that can be used to replicate the input object. +#' +#' @param M a struct model, model_seq or iterator object +#' @param start text prepended to the code. Default is "M = " +#' @param mode "compact" will use the least amount of lines, "expanded" will +#' put each object and input on a new line. "neat" will produce an output +#' somewhere between "compact" and "extended". +#' @return A string of code to reproduce the input object. +#' @export +#' @rdname as.code +#' @examples +#' M = example_model(value_1 = 10) +#' as.code(M) +setGeneric('as.code',function(M,start='M = ',mode='compact')standrdGeneric("as.code")) + #' convert to data.frame #' #' Most often used with univariate statistics to gather all the different outputs in a consistent format. @@ -610,4 +627,7 @@ setGeneric("as.DatasetExperiment",function(obj)standardGeneric("as.DatasetExperi #' @param ... other inputs passed through this function #' @return a data.frame containing outputs from an object #' @export -setGeneric("as_data_frame",function(M,...)standardGeneric("as_data_frame")) \ No newline at end of file +setGeneric("as_data_frame",function(M,...)standardGeneric("as_data_frame")) + + + diff --git a/R/iterator_class.R b/R/iterator_class.R index e4fdfd5..9fa322e 100644 --- a/R/iterator_class.R +++ b/R/iterator_class.R @@ -239,3 +239,42 @@ setMethod(f = 'show', cat('\n') } ) + +#' @rdname as.code +#' @export +#' @examples +#' M = example_model() +#' as.code(M) +#' @return a string of code to reproduce the iterator +setMethod(f = 'as.code', + signature = c('iterator'), + definition = function(M,start='M = ',mode='compact') { + str=.as_code(M,start,mode) + # get models + m=models(M) + # if iterator then multiply + str=paste0(str,' * \n') + if (is(m,'model_seq') & length(m) > 1) { + if (mode=='expanded') { + str=paste0(str,paste0(paste0(rep(' ',nchar(start)),collapse=''),'(\n')) + str=paste0(str,as.code(m,start=paste0(paste0(rep(' ',nchar(start)+2),collapse='')),mode)) + } else { + str=paste0(str,as.code(m,start=paste0(paste0(rep(' ',nchar(start)),collapse=''),'('),mode)) + } + if (mode != 'compact') { + str=paste0(str,'\n',paste0(rep(' ',nchar(start)),collapse='')) + } + + str=paste0(str,')') + } else { + str=paste0(str,as.code(m,start=paste0(rep(' ',nchar(start)),collapse=''),mode)) + } + + return(str) + } +) + + + + + diff --git a/R/model_class.R b/R/model_class.R index 600fe4f..8a28014 100644 --- a/R/model_class.R +++ b/R/model_class.R @@ -55,7 +55,7 @@ model = function(predicted=character(0),seq_in='data',seq_fcn=function(x){return prototype = list( seq_in = 'data', seq_fcn=function(x){return(x)} - ) + ) ) #' @rdname model @@ -231,3 +231,83 @@ setMethod(f = "show", ) +#' @rdname as.code +#' @export +#' @examples +#' M = example_model() +#' as.code(M) +#' @return a string of code to reproduce the model +setMethod(f = 'as.code', + signature = c('model'), + definition = function(M,start = 'M = ',mode = 'compact') { + .as_code(M,start,mode) + } +) + + + +.as_code = function(M,start='M = ',mode = 'compact') { + + if (!(mode %in% c('compact','neat','expanded','full'))) { + stop(paste0('unknown option "', mode , '" for as.code()')) + } + str=start + # model object name + str=paste0(str,class(M)[1],'(') + + # parameters + P = param_ids(M) + + # add seq_in if not equal to data + if (is(M,'model')) { + if (M@seq_in != 'data' | mode=='full') { + P=c(P,'seq_in') + } + } + # add predicted if its not the default + if (is(M,'model')) { + N=new_struct(class(M)[1]) + if (predicted_name(N) != predicted_name(M) | mode=='full') { + P=c(P,'predicted') + } + } + + if (mode != "compact") { + str=paste0(str,'\n') + indent=nchar(start)+2 + } else { + indent=(nchar(start)+1)+nchar(class(M)[1]) + } + + for (p in seq_len(length(P))) { + if (p>1 | mode!="compact") { + str=paste0(str,paste0(rep(' ',indent),collapse='')) + } + + if (P[p]=='seq_in') { + str=paste0(str,P[p], ' = "', seq_in(M), '"') + } else if (P[p]=='predicted') { + str=paste0(str,P[p], ' = "', predicted_name(M), '"') + } else if (class(param_value(M,P[p]))=='character') { + str=paste0(str,P[p], ' = "', as.character(param_value(M,P[p])), '"') + } else { + str=paste0(str,P[p], ' = ', as.character(param_value(M,P[p]))) + } + + + if (p==length(P)) { + if (mode=='expanded') { + str=paste0(str,'\n',paste0(rep(' ',indent-2),collapse='')) + } + + + str=paste0(str,')') + + + } else { + str=paste0(str,',\n') + } + } + + return(str) +} \ No newline at end of file diff --git a/R/model_list_class.R b/R/model_list_class.R index 182b922..cbeea67 100644 --- a/R/model_list_class.R +++ b/R/model_list_class.R @@ -321,4 +321,26 @@ setMethod(f = "model_apply", } ) - +#' @rdname as.code +#' @export +#' @examples +#' M = example_model() +#' as.code(M) +#' @return a string of code to reproduce the model sequence +setMethod(f = 'as.code', + signature = c('model_seq'), + definition = function(M,start='M = ',mode='compact') { + str='' + for (i in seq_len(length(M))) { + if (i==1) { + str=paste0(str,as.code(M[i],start=start,mode=mode)) + } else { + str=paste0(str,as.code(M[i],start=paste0(rep(' ',nchar(start)),collapse=''),mode)) + } + if (i Date: Wed, 14 Oct 2020 08:54:04 +0100 Subject: [PATCH 6/9] Issue 27 citations (#29) * add citations and libraries methods for #27 - these methods scan over all inherited objects and generate a complte ist of citations/libraries - a citations slot has been added to struct_class * use bibtex for citations The citations slot is now a list of bibentry objects to provide a more formalised method for storing citations and make them easer to use with bibliography packages etc. --- NAMESPACE | 4 + R/DatasetExperiment_class.R | 255 ++++++++++++++++++------------------ R/example_objects.R | 29 ++-- R/generics.R | 30 +++++ R/struct_class.R | 140 ++++++++++++++++++-- man/citations.Rd | 28 ++++ man/libraries.Rd | 27 ++++ man/struct_class-class.Rd | 2 + man/struct_class.Rd | 5 +- 9 files changed, 373 insertions(+), 147 deletions(-) create mode 100644 man/citations.Rd create mode 100644 man/libraries.Rd diff --git a/NAMESPACE b/NAMESPACE index 8d1d4ab..965e258 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -14,6 +14,7 @@ export(calculate) export(chart) export(chart_names) export(chart_plot) +export(citations) export(entity) export(entity_stato) export(enum) @@ -25,6 +26,7 @@ export(iris_DatasetExperiment) export(is_output) export(is_param) export(iterator) +export(libraries) export(max_length) export(metric) export(model) @@ -91,11 +93,13 @@ exportMethods(as.code) exportMethods(calculate) exportMethods(chart_names) exportMethods(chart_plot) +exportMethods(citations) exportMethods(evaluate) exportMethods(export_xlsx) exportMethods(is_output) exportMethods(is_param) exportMethods(length) +exportMethods(libraries) exportMethods(max_length) exportMethods(model_apply) exportMethods(model_predict) diff --git a/R/DatasetExperiment_class.R b/R/DatasetExperiment_class.R index c082528..d35f238 100644 --- a/R/DatasetExperiment_class.R +++ b/R/DatasetExperiment_class.R @@ -31,106 +31,107 @@ #' @return DatasetExperiment #' @rdname struct_DatasetExperiment DatasetExperiment = function( - data=data.frame(), - sample_meta=data.frame(), - variable_meta=data.frame(), - ...){ - - # convert data set to list - assays=list(data) - - # sample_meta - - out=.DatasetExperiment(SummarizedExperiment( - assays=assays, - colData=variable_meta, - rowData=sample_meta), - ...) + data=data.frame(), + sample_meta=data.frame(), + variable_meta=data.frame(), + ...){ - return(out) + # convert data set to list + assays=list(data) + + # sample_meta + + out=.DatasetExperiment(SummarizedExperiment( + assays=assays, + colData=variable_meta, + rowData=sample_meta), + ...) + + return(out) } .DatasetExperiment <- setClass( - "DatasetExperiment", - contains = c("struct_class","SummarizedExperiment") + "DatasetExperiment", + contains = c("struct_class","SummarizedExperiment"), + prototype=list('libraries'='SummarizedExperiment') ) #' @rdname struct_DatasetExperiment #' @export setMethod(f = "$", - signature = c("DatasetExperiment"), - definition = function(x,name) { - - s = c('data','sample_meta','variable_meta') - - if (name %in% s) { - if (name == 'data') { - if (length(assays(x))==0) { - value=NULL - } else { - value = assay(x,1) - } - } else if (name == 'sample_meta') { - value = S4Vectors::DataFrame(rowData(x)) - } else if (name == 'variable_meta') { - value = S4Vectors::DataFrame(colData(x)) - } - - if (name %in% s) { - # convert to data.frame if using the original struct definitions - value=as.data.frame(value) - } - - return(value) - + signature = c("DatasetExperiment"), + definition = function(x,name) { + + s = c('data','sample_meta','variable_meta') + + if (name %in% s) { + if (name == 'data') { + if (length(assays(x))==0) { + value=NULL } else { - # for name,description etc - return(callNextMethod()) + value = assay(x,1) } - + } else if (name == 'sample_meta') { + value = S4Vectors::DataFrame(rowData(x)) + } else if (name == 'variable_meta') { + value = S4Vectors::DataFrame(colData(x)) + } + + if (name %in% s) { + # convert to data.frame if using the original struct definitions + value=as.data.frame(value) + } + + return(value) + + } else { + # for name,description etc + return(callNextMethod()) } + + } ) #' @rdname struct_DatasetExperiment #' @export setMethod(f = "$<-", - signature(x = 'DatasetExperiment'), - definition = function(x,name,value) { - s = c('data','sample_meta','variable_meta') - if (name %in% s) { - if (name %in% c('data')) { - assay(x,1) = value - } else if (name %in% c('sample_meta')) { - rowData(x) = S4Vectors::DataFrame(value) - } else if (name %in% c('sample_meta')) { - colData(x) = S4Vectors::DataFrame(value) - } - return(x) - } else { - callNextMethod() - } + signature(x = 'DatasetExperiment'), + definition = function(x,name,value) { + s = c('data','sample_meta','variable_meta') + if (name %in% s) { + if (name %in% c('data')) { + assay(x,1) = value + } else if (name %in% c('sample_meta')) { + rowData(x) = S4Vectors::DataFrame(value) + } else if (name %in% c('sample_meta')) { + colData(x) = S4Vectors::DataFrame(value) + } + return(x) + } else { + callNextMethod() } + } ) setMethod(f = 'show', - signature = c('DatasetExperiment'), - definition = function(object) { - - # print struct generic info - callNextMethod() - - # number of assays - nms <- length(assays(object)) - if (is.null(nms)) { - # if null then no assays yet - cat('data: 0 rows x 0 columns\n',sep='') - } else { - cat('data: ',nrow(object$data),' rows x ', ncol(object$data),' columns\n',sep='') - } - cat('sample_meta: ',nrow(object$sample_meta),' rows x ', ncol(object$sample_meta),' columns\n',sep='') - cat('variable_meta: ',nrow(object$variable_meta),' rows x ', ncol(object$variable_meta),' columns\n',sep='') + signature = c('DatasetExperiment'), + definition = function(object) { + + # print struct generic info + callNextMethod() + + # number of assays + nms <- length(assays(object)) + if (is.null(nms)) { + # if null then no assays yet + cat('data: 0 rows x 0 columns\n',sep='') + } else { + cat('data: ',nrow(object$data),' rows x ', ncol(object$data),' columns\n',sep='') } + cat('sample_meta: ',nrow(object$sample_meta),' rows x ', ncol(object$sample_meta),' columns\n',sep='') + cat('variable_meta: ',nrow(object$variable_meta),' rows x ', ncol(object$variable_meta),' columns\n',sep='') + } ) #' Convert a DatasetExperiment to SummarizedExperiment @@ -142,21 +143,21 @@ setMethod(f = 'show', #' @return a SummarizedExperiment object #' @export setMethod (f = 'as.SummarizedExperiment', - signature = 'DatasetExperiment', - definition = function(obj) { - out=SummarizedExperiment( - assays=list(t(obj$data)), - colData=SummarizedExperiment::rowData(obj), - rowData=SummarizedExperiment::colData(obj), - metadata=list( - 'name'=obj$name, - 'description'=obj$description, - 'type'=obj$type, - 'libraries'=obj$libraries) - ) - - return(out) - } + signature = 'DatasetExperiment', + definition = function(obj) { + out=SummarizedExperiment( + assays=list(t(obj$data)), + colData=SummarizedExperiment::rowData(obj), + rowData=SummarizedExperiment::colData(obj), + metadata=list( + 'name'=obj$name, + 'description'=obj$description, + 'type'=obj$type, + 'libraries'=obj$libraries) + ) + + return(out) + } ) @@ -169,20 +170,20 @@ setMethod (f = 'as.SummarizedExperiment', #' @return a DatasetExperiment object #' @export setMethod (f = 'as.DatasetExperiment', - signature = 'SummarizedExperiment', - definition = function(obj) { - out=DatasetExperiment( - data=as.data.frame(t(assay(obj))), - variable_meta=as.data.frame(rowData(obj)), - sample_meta=as.data.frame(colData(obj)), - name=as.character(metadata(obj)$name), - description=as.character(metadata(obj)$description), - type=as.character(metadata(obj)$type), - libraries=as.character(metadata(obj)$libraries) - ) - - return(out) - } + signature = 'SummarizedExperiment', + definition = function(obj) { + out=DatasetExperiment( + data=as.data.frame(t(assay(obj))), + variable_meta=as.data.frame(rowData(obj)), + sample_meta=as.data.frame(colData(obj)), + name=as.character(metadata(obj)$name), + description=as.character(metadata(obj)$description), + type=as.character(metadata(obj)$type), + libraries=as.character(metadata(obj)$libraries) + ) + + return(out) + } ) @@ -202,26 +203,26 @@ setMethod (f = 'as.DatasetExperiment', #' } #' @export setMethod(f = "export_xlsx", - signature = c("DatasetExperiment"), - definition = function(object,outfile,transpose = TRUE) { - - # check for openxlsx - if (!requireNamespace('openxlsx', quietly = TRUE)) { - stop('package "openxlsx" was not found. Please install it to use "export.xlsx()".') - } - - - if (transpose) { - X = as.data.frame(t(object$data)) - } else { - X = object$data - } - - OUT = list( - 'data' = X, - 'sample_meta' = object$sample_meta, - 'variable_meta' = object$variable_meta - ) - openxlsx::write.xlsx(OUT,file = outfile,rowNames = TRUE,colNames = TRUE) + signature = c("DatasetExperiment"), + definition = function(object,outfile,transpose = TRUE) { + + # check for openxlsx + if (!requireNamespace('openxlsx', quietly = TRUE)) { + stop('package "openxlsx" was not found. Please install it to use "export.xlsx()".') } + + + if (transpose) { + X = as.data.frame(t(object$data)) + } else { + X = object$data + } + + OUT = list( + 'data' = X, + 'sample_meta' = object$sample_meta, + 'variable_meta' = object$variable_meta + ) + openxlsx::write.xlsx(OUT,file = outfile,rowNames = TRUE,colNames = TRUE) + } ) diff --git a/R/example_objects.R b/R/example_objects.R index 971a696..9abfa1f 100644 --- a/R/example_objects.R +++ b/R/example_objects.R @@ -8,20 +8,31 @@ #' @examples #' D = iris_DatasetExperiment() iris_DatasetExperiment = function () { - iris = datasets::iris - DatasetExperiment( - name="Fisher's Iris dataset", - description=paste0( + iris = datasets::iris + DatasetExperiment( + name="Fisher's Iris dataset", + description=paste0( "This famous (Fisher's or Anderson's) iris data set gives ", "the measurements in centimeters of the variables sepal length and ", "width and petal length and width, respectively, for 50 flowers from ", "each of 3 species of iris. The species are Iris setosa, versicolor, ", "and virginica."), - data = iris[, 1:4], - sample_meta = iris[, -(1:4), drop = FALSE], - variable_meta=data.frame('feature_id'=colnames(iris[,1:4])) - ) - } + data = iris[, 1:4], + sample_meta = iris[, -(1:4), drop = FALSE], + variable_meta=data.frame('feature_id'=colnames(iris[,1:4])), + citations=list(bibentry( + bibtype = "article", + author = as.person("FISHER, R. A"), + title = "The use of multiple measurments in taxonomic problems", + journal = "Annals of Eugenics", + volume = 7, + number = 2, + pages = "179-188", + doi = "10.1111/j.1469-1809.1936.tb02137.x", + year = 1936 + )) + ) +} #' Example model #' diff --git a/R/generics.R b/R/generics.R index 7b705a4..a71c669 100644 --- a/R/generics.R +++ b/R/generics.R @@ -630,4 +630,34 @@ setGeneric('as.code',function(M,start='M = ',mode='compact')standrdGeneric("as.c setGeneric("as_data_frame",function(M,...)standardGeneric("as_data_frame")) +#' Citations for an object +#' +#' All \code{struct} objects have a "citations" slot, which is a character array of +#' references relevant to the object. The \code{citations} method gathers +#' citations from an object and all \code{struct} objects that it inherits to generate +#' a complete list. +#' @param obj a struct object +#' @return a character array of citations +#' @examples +#' D = iris_DatasetExperiment() +#' D$citations # the list specifically defined for this object +#' citations(D) # the list for this object and all inherited ones +#' @rdname citations +#' @export +setGeneric("citations",function(obj)standardGeneric("citations")) + +#' Libraries for an object +#' +#' All \code{struct} objects have a "libraries" slot, which is a character array of +#' libraries required to use the object. The \code{libraries} method gathers +#' libraries from an object and all \code{struct} objects that it inherits to generate +#' a complete list. +#' @param obj a struct object +#' @return a character array of R packages needed by the object +#' @examples +#' M = example_model() +#' libraries(M) +#' @rdname libraries +#' @export +setGeneric("libraries",function(obj)standardGeneric("libraries")) diff --git a/R/struct_class.R b/R/struct_class.R index f1dd287..80392cb 100644 --- a/R/struct_class.R +++ b/R/struct_class.R @@ -13,6 +13,8 @@ #' \item{\code{description}}{\code{character()} A longer description of the struct object and what it does} #' \item{\code{type}}{\code{character()} A keyword that describes the type of struct object} #' \item{\code{libraries}}{\code{character()} A (read only) list of R packages used by this struct object} +#' \item{\code{citations}}{\code{list of bibentry} A (read only) list of citations relevant to this struct object, +#' in Bibtex format.} #' } #' #' @section Private slots: @@ -41,8 +43,12 @@ description = "character", type = "character", libraries = 'character', + citations = 'list', .params='character', .outputs='character' + ), + prototype = list( + 'citations'=suppressWarnings(list(citation('struct'))) ) ) @@ -53,12 +59,27 @@ #' @param name the name of the object #' @param description a description of the object #' @param type the type of the struct object +#' @param citations a list of citations for the object in "bibentry" format #' @return a struct_class object #' @export struct_class = function( name=character(0), description=character(0), - type=character(0)) { + type=character(0), + citations=list()) { + + # if Bibtex is provided convert to a list + if (is(citations,'bibentry')){ + citations=list(citations) + } + + # check all citations are Bibtex + if (length(citations>0)) { + ok=lapply(citations,is,class='bibentry') + if (!(all(citations))){ + stop('all citations must be in "bibentry" format') + } + } # new object out = .struct_class( @@ -102,7 +123,7 @@ setMethod(f = "$", } # check for other struct slots - valid=c('name','description','type','libraries') + valid=c('name','description','type','libraries','citations') if (name %in% valid) { out = slot(x,name) return(out) @@ -145,15 +166,24 @@ setMethod(f = "$<-", } # check for other slots - valid=c('name','description','type') # do not allow setting of libraries + valid=c('name','description','type') + # do not allow setting of libraries or citations if (name %in% valid) { + # check citation is Bibtex + if (name=='citations') { + ok=lapply(value,is,class='bibentry') + if (!all(unlist(ok))) { + error(paste0('All citations must be "bibentry" objects')) + } + } + slot(x,name) = value return(x) } # if we havent returned value by now, then we're not going to stop(paste0(name,' is not a valid param, output or column name for this DatasetExperiment using $')) - + } ) @@ -200,20 +230,28 @@ setMethod(f = "show", signature = c("struct_class"), definition = function(object) { n=nchar(paste0('A "', class(object),'" object')) + + if (length(object@description) > 1) { + # add bullets to description if more than one item + object@description=paste0('\U2022',' ', object$description) + } + # strip newlines from description, we'll add our own + object@description=gsub("[\r\n]",'',object@description) cat( 'A "', class(object),'" object','\n', rep('-',n),'\n', 'name: ', object$name,'\n', - 'description: ', paste0(strwrap(object$description,width=65,exdent = 15),collapse='\n'),'\n', + 'description: ', paste0(strwrap(object$description,width=95,exdent = 17),collapse='\n'),'\n', sep = '' ) + if (length(object@.params>0) & !is(object,'entity')) { cat('input params: ', paste(object@.params,collapse=', '),'\n') } if (length(object@.outputs>0) & !is(object,'entity')) { cat('outputs: ', paste(object@.outputs,collapse=', '),'\n') } - + } ) @@ -255,7 +293,7 @@ set_struct_obj = function( prototype[['.params']]=names(params) prototype[['.outputs']]=names(outputs) - ## create class definition as assign to the chosen environment + ## create class definition as assign to the chosen environment assign(paste0('.',class_name),setClass( Class = class_name, @@ -302,7 +340,7 @@ set_struct_obj = function( #') set_obj_method = function(class_name, method_name, definition, where = topenv(parent.frame()), signature=c(class_name,'DatasetExperiment')) { - setMethod(f = method_name, + setMethod(f = method_name, signature = signature, definition = definition, where = where) @@ -355,7 +393,7 @@ populate_slots=function(obj,...) { L=list(...) for (k in L) { if (is_param(obj,names(k))) { - param_value(obj,names(k)) = k[[1]] + param_value(obj,names(k)) = k[[1]] } } @@ -384,7 +422,7 @@ new_struct = function(class, ...) { if (!is(obj,'struct_class')){ stop(paste0('struct_class is only for objects derived from struct_class. Got object of type "',class(obj),'"')) } - + # update values L=list(...) for (k in seq_len(length(L))) { @@ -393,3 +431,85 @@ new_struct = function(class, ...) { return(obj) } + + + +#' @rdname citations +#' @export +setMethod(f = "citations", + signature = c("struct_class"), + definition = function(obj) { + if (is(obj,'DatasetExperiment')) { + cit=D$citations + } else { + cit=list() + } + + # citations for libraries + lib = .extended_list_by_slot(obj,'libraries') + lib = lapply(lib,function(x){ + # citations for library + A = suppressWarnings(citation(x)) + # convert to strings + #B=.list_of_citations_as_strings(A) + return(A) + }) + + cit = c(cit,lib) + + # citations as strings + out = .extended_list_by_slot(obj,'citations') + cit=c(cit,out) + + # remove duplicates + cit=cit[!(duplicated(cit))] + return(cit) + } +) + +#' @rdname libraries +#' @export +setMethod(f = "libraries", + signature = c("struct_class"), + definition = function(obj) { + lib=.extended_list_by_slot(obj,'libraries') + lib=lib[!(duplicated(lib))] + return(lib) + } +) + + + + +.extended_list_by_slot = function(obj,slotname) { + # returns a unique list of values for slots in this object + # and all the ones in inherits + cit=list() + # get the objects this object extends + ex = extends(class(obj)[1]) + # for each one, if its a struct class grab the citations + for (k in seq_along(ex)) { + if (extends(ex[[k]],'struct_class')) { + X = new_struct(ex[k]) + S=slot(X,slotname) + cit=c(cit,S) + } + } + return(cit) +} + + + + +.list_of_citations_as_strings = function(L) { + + B=lapply(L,function(x){ + str=capture.output(print(x,style='textVersion')) + str=paste0(str,collapse='') + return(str) + } + ) + + C=unlist(B) + return(C) +} \ No newline at end of file diff --git a/man/citations.Rd b/man/citations.Rd new file mode 100644 index 0000000..d194b44 --- /dev/null +++ b/man/citations.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/generics.R, R/struct_class.R +\name{citations} +\alias{citations} +\alias{citations,struct_class-method} +\title{Citations for an object} +\usage{ +citations(obj) + +\S4method{citations}{struct_class}(obj) +} +\arguments{ +\item{obj}{a struct object} +} +\value{ +a character array of citations +} +\description{ +All \code{struct} objects have a "citations" slot, which is a character array of +references relevant to the object. The \code{citations} method gathers +citations from an object and all \code{struct} objects that it inherits to generate +a complete list. +} +\examples{ +D = iris_DatasetExperiment() +D$citations # the list specifically defined for this object +citations(D) # the list for this object and all inherited ones +} diff --git a/man/libraries.Rd b/man/libraries.Rd new file mode 100644 index 0000000..0db5c81 --- /dev/null +++ b/man/libraries.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/generics.R, R/struct_class.R +\name{libraries} +\alias{libraries} +\alias{libraries,struct_class-method} +\title{Libraries for an object} +\usage{ +libraries(obj) + +\S4method{libraries}{struct_class}(obj) +} +\arguments{ +\item{obj}{a struct object} +} +\value{ +a character array of R packages needed by the object +} +\description{ +All \code{struct} objects have a "libraries" slot, which is a character array of +libraries required to use the object. The \code{libraries} method gathers +libraries from an object and all \code{struct} objects that it inherits to generate +a complete list. +} +\examples{ +M = example_model() +libraries(M) +} diff --git a/man/struct_class-class.Rd b/man/struct_class-class.Rd index 1f6e8f1..0e566d7 100644 --- a/man/struct_class-class.Rd +++ b/man/struct_class-class.Rd @@ -23,6 +23,8 @@ users building workflows. \item{\code{description}}{\code{character()} A longer description of the struct object and what it does} \item{\code{type}}{\code{character()} A keyword that describes the type of struct object} \item{\code{libraries}}{\code{character()} A (read only) list of R packages used by this struct object} + \item{\code{citations}}{\code{list of bibentry} A (read only) list of citations relevant to this struct object, + in Bibtex format.} } } diff --git a/man/struct_class.Rd b/man/struct_class.Rd index c9e4a54..de0e1ca 100644 --- a/man/struct_class.Rd +++ b/man/struct_class.Rd @@ -7,7 +7,8 @@ struct_class( name = character(0), description = character(0), - type = character(0) + type = character(0), + citations = list() ) } \arguments{ @@ -16,6 +17,8 @@ struct_class( \item{description}{a description of the object} \item{type}{the type of the struct object} + +\item{citations}{a list of citations for the object in "bibentry" format} } \value{ a struct_class object From 7eb8d08caeeffd290039be6dbe26c00df6a3f348 Mon Sep 17 00:00:00 2001 From: Gavin Rhys Lloyd Date: Mon, 4 Jan 2021 15:41:13 +0000 Subject: [PATCH 7/9] merge 3_12 into dev (#34) * Release 3.12 (#31) * fix for https://github.com/computational-metabolomics/struct/issues/18 (#19) - incorrect use of `$assay` replaced with `$data` for DatasetExperiment objects - specify SummarizedExperiment package as source of `rowData` and `colData` functions * fix for #20 (#21) data now gets passed through as intended when model_seq is being used. Allows seq_in to be used at the nth step in a sequence * fix for #20 (#23) data now gets passed through as intended when model_seq is being used. Allows seq_in to be used at the nth step in a sequence * Issue 22 seq in (#24) * add seq_in generics * add seq_in methods - added methods for models to get.set seq_in - added checks for valid input/output names to seq_in and predicted_name methods * update documentation * use correct input param id * update documentation - use of input_1 instead of value_1 fixed in examples - corrected rdname for seq_in * add as.code method (#25) * add as.code method produces a string of text that can be used to recreate the model/sequence/iterator * use correct input parameter names cmd check fails if examples dont run * Issue 27 citations (#29) * add citations and libraries methods for #27 - these methods scan over all inherited objects and generate a complte ist of citations/libraries - a citations slot has been added to struct_class * use bibtex for citations The citations slot is now a list of bibentry objects to provide a more formalised method for storing citations and make them easer to use with bibliography packages etc. * update imports for utils package * fix various cmd and bioc check issues - add importFrom utils citation to namespace - replace incorrect use of "error" with "stop" - use first index of class() output in messages * Update NEWS * version bump * fix typo in documentation * Release_3_12 (#32) better alignment of bullets * update news, version bump * replace class() with is() allows assignment of entities as 'ANY' * bump x.y.z version to even y prior to creation of RELEASE_3_12 branch * bump x.y.z version to odd y following creation of RELEASE_3_12 branch Co-authored-by: Nitesh Turaga --- DESCRIPTION | 134 +++--- NAMESPACE | 4 + NEWS | 13 + R/entity_class.R | 8 +- R/enum_class.R | 2 +- R/model_class.R | 624 +++++++++++++-------------- R/struct.R | 2 +- R/struct_class.R | 1050 +++++++++++++++++++++++----------------------- man/struct.Rd | 2 +- 9 files changed, 942 insertions(+), 897 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 07a2b2b..a35149b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,67 +1,67 @@ -Package: struct -Type: Package -Title: Statistics in R Using Class-based Templates -Version: 1.1.0 -Authors@R: c( - person( - c("Gavin","Rhys"), - "Lloyd", - role=c("aut","cre"), - email="g.r.lloyd@bham.ac.uk"), - person( - c("Ralf","Johannes", "Maria"), - "Weber", - role=c("aut"), - email="r.j.weber@bham.ac.uk") - ) -Description: Defines and includes a set of class-based templates for developing - and implementing data processing and analysis workflows, with a strong - emphasis on statistics and machine learning. The templates can be used and - where needed extended to 'wrap' tools and methods from other packages into a - common standardised structure to allow for effective and fast integration. - Model objects can be combined into sequences, and sequences nested in - iterators using overloaded operators to simplify and improve readability of - the code. STATistics Ontology (STATO) has been integrated and implemented - to provide standardised definitions for methods, inputs and outputs wrapped - using the class-based templates. -License: GPL-3 -Encoding: UTF-8 -LazyData: true -Collate: - 'generics.R' - 'struct_class.R' - 'parameter_class.R' - 'chart_class.R' - 'stato_class.R' - 'DatasetExperiment_class.R' - 'entity_class.R' - 'entity_stato_class.R' - 'enum_class.R' - 'enum_stato_class.R' - 'output_class.R' - 'model_class.R' - 'example_objects.R' - 'model_list_class.R' - 'metric_class.R' - 'iterator_class.R' - 'optimiser_class.R' - 'preprocess_class.R' - 'resampler_class.R' - 'struct.R' - 'struct_templates.R' -RoxygenNote: 7.1.1 -Depends: R (>= 4.0) -Suggests: - testthat, - rstudioapi, - rmarkdown, - covr, - BiocStyle, - openxlsx, - ggplot2, - magick -VignetteBuilder: knitr -Imports: methods, ontologyIndex, - datasets, graphics, stats, utils, knitr, - SummarizedExperiment, S4Vectors -biocViews: WorkflowStep +Package: struct +Type: Package +Title: Statistics in R Using Class-based Templates +Version: 1.3.0 +Authors@R: c( + person( + c("Gavin","Rhys"), + "Lloyd", + role=c("aut","cre"), + email="g.r.lloyd@bham.ac.uk"), + person( + c("Ralf","Johannes", "Maria"), + "Weber", + role=c("aut"), + email="r.j.weber@bham.ac.uk") + ) +Description: Defines and includes a set of class-based templates for developing + and implementing data processing and analysis workflows, with a strong + emphasis on statistics and machine learning. The templates can be used and + where needed extended to 'wrap' tools and methods from other packages into a + common standardised structure to allow for effective and fast integration. + Model objects can be combined into sequences, and sequences nested in + iterators using overloaded operators to simplify and improve readability of + the code. STATistics Ontology (STATO) has been integrated and implemented + to provide standardised definitions for methods, inputs and outputs wrapped + using the class-based templates. +License: GPL-3 +Encoding: UTF-8 +LazyData: true +Collate: + 'generics.R' + 'struct_class.R' + 'parameter_class.R' + 'chart_class.R' + 'stato_class.R' + 'DatasetExperiment_class.R' + 'entity_class.R' + 'entity_stato_class.R' + 'enum_class.R' + 'enum_stato_class.R' + 'output_class.R' + 'model_class.R' + 'example_objects.R' + 'model_list_class.R' + 'metric_class.R' + 'iterator_class.R' + 'optimiser_class.R' + 'preprocess_class.R' + 'resampler_class.R' + 'struct.R' + 'struct_templates.R' +RoxygenNote: 7.1.1 +Depends: R (>= 4.0) +Suggests: + testthat, + rstudioapi, + rmarkdown, + covr, + BiocStyle, + openxlsx, + ggplot2, + magick +VignetteBuilder: knitr +Imports: methods, ontologyIndex, + datasets, graphics, stats, utils, knitr, + SummarizedExperiment, S4Vectors +biocViews: WorkflowStep \ No newline at end of file diff --git a/NAMESPACE b/NAMESPACE index 965e258..705521a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -135,4 +135,8 @@ importFrom(graphics,plot) importFrom(knitr,purl) importFrom(ontologyIndex,get_ontology) importFrom(stats,runif) +importFrom(utils,as.person) +importFrom(utils,bibentry) +importFrom(utils,capture.output) +importFrom(utils,citation) importFrom(utils,file.edit) diff --git a/NEWS b/NEWS index f93848e..387b3c4 100644 --- a/NEWS +++ b/NEWS @@ -1,3 +1,16 @@ +Changes in 1.1.2 ++ improved 'show' output for objects ++ allow ANY for entities +Changes in 1.1.1 ++ added citations slot to struct classes ++ added corresponding citations method ++ added method to get/set seq_in slot ++ as.SummarizedExepriment now works correctly ++ using seq_in now works for sequences with more than 2 steps + +Changes in 1.0.0 ++ Biconductor 3.11 release + Changes in 0.99.10 + update vignettes + update documentation diff --git a/R/entity_class.R b/R/entity_class.R index 4d8356f..f8fdc4e 100644 --- a/R/entity_class.R +++ b/R/entity_class.R @@ -58,7 +58,13 @@ entity = function(name, description=character(0), type='character', ), validity = function(object) { check_length = length(value(object)) <= max_length(object) - check_type = class(value(object))[1] %in% object$type + check_type = any( + unlist( + lapply(object$type,function(x){ + is(value(object),x) + }) + ) + ) check_max_length = length(max_length(object)) == 1 msg = TRUE if (!check_length) { diff --git a/R/enum_class.R b/R/enum_class.R index eb66a5c..b5deb0d 100644 --- a/R/enum_class.R +++ b/R/enum_class.R @@ -84,7 +84,7 @@ setMethod(f = 'show', definition = function(object) { callNextMethod() - cat('allowed: ',paste0(object@allowed,collapse=', ')) + cat('allowed: ',paste0(object@allowed,collapse=', ')) cat('\n') } ) diff --git a/R/model_class.R b/R/model_class.R index 8a28014..0f8bfdf 100644 --- a/R/model_class.R +++ b/R/model_class.R @@ -1,313 +1,313 @@ -#' model class -#' -#' A class for models that can be trained/applied to datasets e.g. PCA, PLS etc. -#' Also used for preprocessing steps that require application to test sets. -#' not intended to be called directly, this class should be inherited to provide -#' functionality for method-specific classes. -#' -#' @section \code{predicted} slot: -#' The "predicted" slot is a slots for use by users to control the flow of model -#' sequences. The \code{predicted()} function is used to return a default output and -#' from a model. Typically it is a DatasetExperiment object that is passed directly -#' into the next model in a sequence as the data for that model. -#' -#' @section \code{seq_in} slot: -#' In a sequence of models (see model_seq) the "predicted" slot is connected to the -#' DatasetExperiment input of the next model. \code{seq_in} can be used to control -#' flow and connect the "predicted" output to the input parameter of the next model. -#' Default is the keyword 'data', and can otherwise be replaced by any input slot -#' from the model. The slot \code{seq_fcn} can be used to apply a transformation to -#' the output before it is used as an input. This allows you to e.g. convert between types, -#' extract a single column from a data.frame etc. -#' -#' -#' @export model -#' @param M A struct model object -#' @param D A DatasetExperiment object -#' @param value The value to assign -#' @param predicted The name of an output slot to return when using \code{predicted()} (see details) -#' @param seq_in the name of an output slot to connect with the "predicted" output -#' of another model (see details) -#' @param seq_fcn a function to apply to seq_in before inputting into the next model. -#' Typically used to extract a single column, or convert from factor to char etc. -#' @include generics.R parameter_class.R output_class.R -#' @examples -#' M = model() -#' @param ... named slots and their values. -#' @rdname model -model = function(predicted=character(0),seq_in='data',seq_fcn=function(x){return(x)},...) { - # new object - out = .model(predicted = predicted, - seq_in = seq_in, - seq_fcn = seq_fcn, - ...) - return(out) -} - -.model<-setClass( - "model", - contains = c('struct_class'), - slots = c( - predicted = 'character', - seq_in = 'character', - seq_fcn = 'function' - ), - prototype = list( - seq_in = 'data', - seq_fcn=function(x){return(x)} - ) -) - -#' @rdname model -#' @export -#' @examples -#' D = DatasetExperiment() -#' M = model() -#' M = model_train(M,D) -#' @return trained model object -setMethod(f = "model_train", - signature = c("model","DatasetExperiment"), - definition = function(M,D) { - warning('no training implemented for this model') - return(M) - } -) - -#' @rdname model -#' @export -#' @examples -#' D = DatasetExperiment() -#' M = model() -#' M = model_train(M,D) -#' M = model_predict(M,D) -#' @return model object with test set results -setMethod(f = "model_predict", - signature = c("model","DatasetExperiment"), - definition = function(M,D) { - return(M) - } -) - -#' @rdname model -#' @export -#' @examples -#' D = DatasetExperiment() -#' M = model() -#' M = model_apply(M,D) -#' @return trained model object -setMethod(f = "model_apply", - signature = c("model","DatasetExperiment"), - definition = function(M,D) { - M = model_train(M,D) - M = model_predict(M,D) - return(M) - } -) - -#' @rdname model -#' @export -#' @examples -#' D = DatasetExperiment() -#' M = model() -#' M = model_train(M,D) -#' M = model_predict(M,D) -#' M = model_reverse(M,D) -#' @return dataset dataset object with the reverse model applied -setMethod(f = "model_reverse", - signature = c("model","DatasetExperiment"), - definition = function(M,D) { - return(D) - } -) - -#' @rdname model -#' @export -#' @examples -#' D = DatasetExperiment() -#' M = example_model() -#' M = model_train(M,D) -#' M = model_predict(M,D) -#' p = predicted(M) -#' @return the predicted output, as specified by predicted_name -setMethod(f = 'predicted', - signature = c('model'), - definition = function(M) { - if (length(predicted_name(M))==0) { - warning('"predicted" has not been set') - return(NA) - } - if (is.na(predicted_name(M))) { - warning('"predicted" is set to NA') - return(NA) - } - if (is.null(predicted_name(M))) { - warning('"predicted" is set to NULL') - return(NA) - - } - # we can try to return the slot - return(output_value(M,predicted_name(M))) - } - -) - -#' @rdname model -#' @export -#' @examples -#' D = DatasetExperiment() -#' M = example_model() -#' seq_in(M) = 'data' -#' @return the id of the input parameter to be replaced by the \code{predicted} -#' output of the previous model in a model sequence. Reserved keyword 'data' -#' means that the input data used by \code{model_train}, \code{model_apply} etc is used. -#' \code{seq_in = 'data'} is the default setting. -setMethod(f = 'seq_in', - signature = c('model'), - definition = function(M) { - return(M@seq_in) - } - -) - -#' @rdname model -#' @export -#' @examples -#' M = example_model() -#' seq_in(M) = 'value_1' -#' @return the modified model object -setMethod(f = 'seq_in<-', - signature = c('model','character'), - definition = function(M,value) { - if (value %in% param_ids(M) | value=='data') { - M@seq_in = value - } else { - stop(paste0('"', value, '" is not a valid input parameter id for', - ' a '), class(M), ' object.') - } - return(M) - } -) - -#' @rdname model -#' @export -#' @examples -#' M = example_model() -#' predicted_name(M) -#' @return the id of the output returned by predicted() -setMethod(f = 'predicted_name', - signature = c('model'), - definition = function(M) { - return(M@predicted) - } -) - -#' @rdname model -#' @export -#' @examples -#' M = example_model() -#' predicted_name(M) = 'result_2' -#' @return the modified model object -setMethod(f = 'predicted_name<-', - signature = c('model','character'), - definition = function(M,value) { - if (value %in% output_ids(M)) { - M@predicted = value - } else { - stop(paste0('"', value, '" is not a valid output id for', - ' a '), class(M), ' object.') - } - return(M) - } -) - -setMethod(f = "show", - signature = c("model"), - definition = function(object) { - callNextMethod() - cat('predicted: ',predicted_name(object),'\n',sep = '') - cat('seq_in: ',object@seq_in, '\n',sep = '') - cat('\n') - } -) - - -#' @rdname as.code -#' @export -#' @examples -#' M = example_model() -#' as.code(M) -#' @return a string of code to reproduce the model -setMethod(f = 'as.code', - signature = c('model'), - definition = function(M,start = 'M = ',mode = 'compact') { - .as_code(M,start,mode) - } -) - - - -.as_code = function(M,start='M = ',mode = 'compact') { - - if (!(mode %in% c('compact','neat','expanded','full'))) { - stop(paste0('unknown option "', mode , '" for as.code()')) - } - str=start - # model object name - str=paste0(str,class(M)[1],'(') - - # parameters - P = param_ids(M) - - # add seq_in if not equal to data - if (is(M,'model')) { - if (M@seq_in != 'data' | mode=='full') { - P=c(P,'seq_in') - } - } - # add predicted if its not the default - if (is(M,'model')) { - N=new_struct(class(M)[1]) - if (predicted_name(N) != predicted_name(M) | mode=='full') { - P=c(P,'predicted') - } - } - - if (mode != "compact") { - str=paste0(str,'\n') - indent=nchar(start)+2 - } else { - indent=(nchar(start)+1)+nchar(class(M)[1]) - } - - for (p in seq_len(length(P))) { - if (p>1 | mode!="compact") { - str=paste0(str,paste0(rep(' ',indent),collapse='')) - } - - if (P[p]=='seq_in') { - str=paste0(str,P[p], ' = "', seq_in(M), '"') - } else if (P[p]=='predicted') { - str=paste0(str,P[p], ' = "', predicted_name(M), '"') - } else if (class(param_value(M,P[p]))=='character') { - str=paste0(str,P[p], ' = "', as.character(param_value(M,P[p])), '"') - } else { - str=paste0(str,P[p], ' = ', as.character(param_value(M,P[p]))) - } - - - if (p==length(P)) { - if (mode=='expanded') { - str=paste0(str,'\n',paste0(rep(' ',indent-2),collapse='')) - } - - - str=paste0(str,')') - - - } else { - str=paste0(str,',\n') - } - } - - return(str) +#' model class +#' +#' A class for models that can be trained/applied to datasets e.g. PCA, PLS etc. +#' Also used for preprocessing steps that require application to test sets. +#' not intended to be called directly, this class should be inherited to provide +#' functionality for method-specific classes. +#' +#' @section \code{predicted} slot: +#' The "predicted" slot is a slots for use by users to control the flow of model +#' sequences. The \code{predicted()} function is used to return a default output and +#' from a model. Typically it is a DatasetExperiment object that is passed directly +#' into the next model in a sequence as the data for that model. +#' +#' @section \code{seq_in} slot: +#' In a sequence of models (see model_seq) the "predicted" slot is connected to the +#' DatasetExperiment input of the next model. \code{seq_in} can be used to control +#' flow and connect the "predicted" output to the input parameter of the next model. +#' Default is the keyword 'data', and can otherwise be replaced by any input slot +#' from the model. The slot \code{seq_fcn} can be used to apply a transformation to +#' the output before it is used as an input. This allows you to e.g. convert between types, +#' extract a single column from a data.frame etc. +#' +#' +#' @export model +#' @param M A struct model object +#' @param D A DatasetExperiment object +#' @param value The value to assign +#' @param predicted The name of an output slot to return when using \code{predicted()} (see details) +#' @param seq_in the name of an output slot to connect with the "predicted" output +#' of another model (see details) +#' @param seq_fcn a function to apply to seq_in before inputting into the next model. +#' Typically used to extract a single column, or convert from factor to char etc. +#' @include generics.R parameter_class.R output_class.R +#' @examples +#' M = model() +#' @param ... named slots and their values. +#' @rdname model +model = function(predicted=character(0),seq_in='data',seq_fcn=function(x){return(x)},...) { + # new object + out = .model(predicted = predicted, + seq_in = seq_in, + seq_fcn = seq_fcn, + ...) + return(out) +} + +.model<-setClass( + "model", + contains = c('struct_class'), + slots = c( + predicted = 'character', + seq_in = 'character', + seq_fcn = 'function' + ), + prototype = list( + seq_in = 'data', + seq_fcn=function(x){return(x)} + ) +) + +#' @rdname model +#' @export +#' @examples +#' D = DatasetExperiment() +#' M = model() +#' M = model_train(M,D) +#' @return trained model object +setMethod(f = "model_train", + signature = c("model","DatasetExperiment"), + definition = function(M,D) { + warning('no training implemented for this model') + return(M) + } +) + +#' @rdname model +#' @export +#' @examples +#' D = DatasetExperiment() +#' M = model() +#' M = model_train(M,D) +#' M = model_predict(M,D) +#' @return model object with test set results +setMethod(f = "model_predict", + signature = c("model","DatasetExperiment"), + definition = function(M,D) { + return(M) + } +) + +#' @rdname model +#' @export +#' @examples +#' D = DatasetExperiment() +#' M = model() +#' M = model_apply(M,D) +#' @return trained model object +setMethod(f = "model_apply", + signature = c("model","DatasetExperiment"), + definition = function(M,D) { + M = model_train(M,D) + M = model_predict(M,D) + return(M) + } +) + +#' @rdname model +#' @export +#' @examples +#' D = DatasetExperiment() +#' M = model() +#' M = model_train(M,D) +#' M = model_predict(M,D) +#' M = model_reverse(M,D) +#' @return dataset dataset object with the reverse model applied +setMethod(f = "model_reverse", + signature = c("model","DatasetExperiment"), + definition = function(M,D) { + return(D) + } +) + +#' @rdname model +#' @export +#' @examples +#' D = DatasetExperiment() +#' M = example_model() +#' M = model_train(M,D) +#' M = model_predict(M,D) +#' p = predicted(M) +#' @return the predicted output, as specified by predicted_name +setMethod(f = 'predicted', + signature = c('model'), + definition = function(M) { + if (length(predicted_name(M))==0) { + warning('"predicted" has not been set') + return(NA) + } + if (is.na(predicted_name(M))) { + warning('"predicted" is set to NA') + return(NA) + } + if (is.null(predicted_name(M))) { + warning('"predicted" is set to NULL') + return(NA) + + } + # we can try to return the slot + return(output_value(M,predicted_name(M))) + } + +) + +#' @rdname model +#' @export +#' @examples +#' D = DatasetExperiment() +#' M = example_model() +#' seq_in(M) = 'data' +#' @return the id of the input parameter to be replaced by the \code{predicted} +#' output of the previous model in a model sequence. Reserved keyword 'data' +#' means that the input data used by \code{model_train}, \code{model_apply} etc is used. +#' \code{seq_in = 'data'} is the default setting. +setMethod(f = 'seq_in', + signature = c('model'), + definition = function(M) { + return(M@seq_in) + } + +) + +#' @rdname model +#' @export +#' @examples +#' M = example_model() +#' seq_in(M) = 'value_1' +#' @return the modified model object +setMethod(f = 'seq_in<-', + signature = c('model','character'), + definition = function(M,value) { + if (value %in% param_ids(M) | value=='data') { + M@seq_in = value + } else { + stop(paste0('"', value, '" is not a valid input parameter id for', + ' a '), class(M)[1], ' object.') + } + return(M) + } +) + +#' @rdname model +#' @export +#' @examples +#' M = example_model() +#' predicted_name(M) +#' @return the id of the output returned by predicted() +setMethod(f = 'predicted_name', + signature = c('model'), + definition = function(M) { + return(M@predicted) + } +) + +#' @rdname model +#' @export +#' @examples +#' M = example_model() +#' predicted_name(M) = 'result_2' +#' @return the modified model object +setMethod(f = 'predicted_name<-', + signature = c('model','character'), + definition = function(M,value) { + if (value %in% output_ids(M)) { + M@predicted = value + } else { + stop(paste0('"', value, '" is not a valid output id for', + ' a '), class(M), ' object.') + } + return(M) + } +) + +setMethod(f = "show", + signature = c("model"), + definition = function(object) { + callNextMethod() + cat('predicted: ',predicted_name(object),'\n',sep = '') + cat('seq_in: ',object@seq_in, '\n',sep = '') + cat('\n') + } +) + + +#' @rdname as.code +#' @export +#' @examples +#' M = example_model() +#' as.code(M) +#' @return a string of code to reproduce the model +setMethod(f = 'as.code', + signature = c('model'), + definition = function(M,start = 'M = ',mode = 'compact') { + .as_code(M,start,mode) + } +) + + + +.as_code = function(M,start='M = ',mode = 'compact') { + + if (!(mode %in% c('compact','neat','expanded','full'))) { + stop(paste0('unknown option "', mode , '" for as.code()')) + } + str=start + # model object name + str=paste0(str,class(M)[1],'(') + + # parameters + P = param_ids(M) + + # add seq_in if not equal to data + if (is(M,'model')) { + if (M@seq_in != 'data' | mode=='full') { + P=c(P,'seq_in') + } + } + # add predicted if its not the default + if (is(M,'model')) { + N=new_struct(class(M)[1]) + if (predicted_name(N) != predicted_name(M) | mode=='full') { + P=c(P,'predicted') + } + } + + if (mode != "compact") { + str=paste0(str,'\n') + indent=nchar(start)+2 + } else { + indent=(nchar(start)+1)+nchar(class(M)[1]) + } + + for (p in seq_len(length(P))) { + if (p>1 | mode!="compact") { + str=paste0(str,paste0(rep(' ',indent),collapse='')) + } + + if (P[p]=='seq_in') { + str=paste0(str,P[p], ' = "', seq_in(M), '"') + } else if (P[p]=='predicted') { + str=paste0(str,P[p], ' = "', predicted_name(M), '"') + } else if (is(param_value(M,P[p]),'character')) { + str=paste0(str,P[p], ' = "', as.character(param_value(M,P[p])), '"') + } else { + str=paste0(str,P[p], ' = ', as.character(param_value(M,P[p]))) + } + + + if (p==length(P)) { + if (mode=='expanded') { + str=paste0(str,'\n',paste0(rep(' ',indent-2),collapse='')) + } + + + str=paste0(str,')') + + + } else { + str=paste0(str,',\n') + } + } + + return(str) } \ No newline at end of file diff --git a/R/struct.R b/R/struct.R index a2d2218..276f639 100644 --- a/R/struct.R +++ b/R/struct.R @@ -3,7 +3,7 @@ #' This package defines classes (templates) for developing statistical workflows. #' These classes can be extended using other packages, making #' it easier to combine methods from different packages into a robust workflow. -#' Integreation with STATO: the statistical methods ontology +#' Integration with STATO: the statistical methods ontology #' (\url{https://www.ebi.ac.uk/ols/ontologies/stato}) provides standardised definitions #' for many statistical methods. #' diff --git a/R/struct_class.R b/R/struct_class.R index 80392cb..5bfee0b 100644 --- a/R/struct_class.R +++ b/R/struct_class.R @@ -1,515 +1,537 @@ -#' \code{struct_class} object definition -#' -#' Defines the struct class base template. This class is inherited by other objects -#' and not intended for direct use. It defines slots and methods common to all -#' \pkg{struct} objects. -#' -#' @section Public slots: -#' Public slots can be accessed using shorthand $ notation and are intended for -#' users building workflows. -#' -#' \describe{ -#' \item{\code{name}}{\code{character()} A short descriptive name of the struct object} -#' \item{\code{description}}{\code{character()} A longer description of the struct object and what it does} -#' \item{\code{type}}{\code{character()} A keyword that describes the type of struct object} -#' \item{\code{libraries}}{\code{character()} A (read only) list of R packages used by this struct object} -#' \item{\code{citations}}{\code{list of bibentry} A (read only) list of citations relevant to this struct object, -#' in Bibtex format.} -#' } -#' -#' @section Private slots: -#' Private slots are not readily accessible to users and are intended for developers -#' creating their own struct objects. Any slot not listed within `.params` or -#' `.outputs` is considered a private slot. -#' -#' \describe{ -#' \item{\code{.params}}{\code{character()} A list of additional slot names that can be get/set by the user -#' for a specific struct object. These are used as input parameters for different methods.} -#' \item{\code{.outputs}}{\code{character()} a list of additional slot names that can be get by the user. These are -#' used to store the results of a method.} -#' } -#' -#' -#' @import methods -#' @include generics.R -#' @return Returns a \pkg{struct} object -#' @examples -#' S = struct_class(name = 'Example',description = 'An example object') -#' @export -.struct_class<-setClass( - "struct_class", - slots = c( - name = 'character', - description = "character", - type = "character", - libraries = 'character', - citations = 'list', - .params='character', - .outputs='character' - ), - prototype = list( - 'citations'=suppressWarnings(list(citation('struct'))) - ) -) - -#' Constructor for struct_class objects -#' -#' Creates a new \linkS4class{struct_class} object and populates the slots. Not intended -#' for direct use. -#' @param name the name of the object -#' @param description a description of the object -#' @param type the type of the struct object -#' @param citations a list of citations for the object in "bibentry" format -#' @return a struct_class object -#' @export -struct_class = function( - name=character(0), - description=character(0), - type=character(0), - citations=list()) { - - # if Bibtex is provided convert to a list - if (is(citations,'bibentry')){ - citations=list(citations) - } - - # check all citations are Bibtex - if (length(citations>0)) { - ok=lapply(citations,is,class='bibentry') - if (!(all(citations))){ - stop('all citations must be in "bibentry" format') - } - } - - # new object - out = .struct_class( - name=name, - description=description, - type=type - ) - - return(out) -} - - -#' Get/set parameter or output values -#' -#' Dollar syntax can be used to as a shortcut for getting/setting input parameter -#' and output values for struct objects. -#' @return Parameter/output value -#' @param x An object derived from struct_class -#' @param name The name of the slot to access -#' @examples -#' M = example_model() -#' M$value_1 = 10 -#' M$value_1 # 10 -#' @export -setMethod(f = "$", - signature = c("struct_class"), - definition = function(x,name) { - - # check for param - w = is_param(x,name) - if (w) { - out = param_value(x,name) - return(out) - } - - # check for output - w = is_output(x,name) - if (w) { - out = output_value(x,name) - return(out) - } - - # check for other struct slots - valid=c('name','description','type','libraries','citations') - if (name %in% valid) { - out = slot(x,name) - return(out) - } - - # if we get here then error - stop(paste0('"', name, '" is not valid for this object:', class(x))) - - } -) - -#' Get/set parameter or output values -#' -#' Dollar syntax can be used to as a shortcut for getting/setting input parameter -#' and output values for struct objects. -#' @return Parameter/output value -#' @param x An object derived from struct_class -#' @param name The name of the slot to access -#' @param value The value to assign -#' @examples -#' M = example_model() -#' M$value_1 = 10 -#' M$value_1 # 10 -#' @export -setMethod(f = "$<-", - signature = c("struct_class"), - definition = function(x,name,value) { - - - # check for param - if (is_param(x,name)) { - param_value(x,name) = value - return(x) - } - - # check for output - if (is_output(x,name)) { - output_value(x,name) = value - return(x) - } - - # check for other slots - valid=c('name','description','type') - # do not allow setting of libraries or citations - if (name %in% valid) { - # check citation is Bibtex - if (name=='citations') { - ok=lapply(value,is,class='bibentry') - if (!all(unlist(ok))) { - error(paste0('All citations must be "bibentry" objects')) - } - } - - slot(x,name) = value - return(x) - } - - # if we havent returned value by now, then we're not going to - stop(paste0(name,' is not a valid param, output or column name for this DatasetExperiment using $')) - - } -) - -#' @describeIn chart_names -#' @export -setMethod(f = "chart_names", - signature = c("struct_class"), - definition = function(obj,ret = 'char') { - if (ret == 'char') { - OUT = character(0) - } else if (ret == 'obj') { - OUT = list() - } else { - stop('not a valid ret option. Try "char" or "obj"') - } - x = showMethods(f = chart_plot,classes = class(obj)[1],printTo = FALSE) - if (x[2] == '') { - } else { - - for (i in 2:length(x)) { - a = strsplit(x[i],'\"')[[1]] - if (length(a)>0) { - a = a[seq(2, length(a), by = 2)] - a = a[-which(a == class(obj)[1])] - if (length(a)>0) { - if (a == 'chart') { - } else if (extends(a,'chart')) { - if (ret == 'char') { - OUT = c(OUT,a) - } else - OUT[[length(OUT)+1]] = eval(parse(text = paste0(a, - '()'))) - } - } - } - } - } - return(OUT) - } -) - - -setMethod(f = "show", - signature = c("struct_class"), - definition = function(object) { - n=nchar(paste0('A "', class(object),'" object')) - - if (length(object@description) > 1) { - # add bullets to description if more than one item - object@description=paste0('\U2022',' ', object$description) - } - # strip newlines from description, we'll add our own - object@description=gsub("[\r\n]",'',object@description) - cat( - 'A "', class(object),'" object','\n', - rep('-',n),'\n', - 'name: ', object$name,'\n', - 'description: ', paste0(strwrap(object$description,width=95,exdent = 17),collapse='\n'),'\n', - sep = '' - ) - - if (length(object@.params>0) & !is(object,'entity')) { - cat('input params: ', paste(object@.params,collapse=', '),'\n') - } - if (length(object@.outputs>0) & !is(object,'entity')) { - cat('outputs: ', paste(object@.outputs,collapse=', '),'\n') - } - - } -) - - -#' define a new struct object -#' -#' a helper function to create new struct objects -#' @export -#' @param class_name the name of the new class to create -#' @param struct_obj the struct obj to inherit e.g. 'model', 'metric' etc -#' @param stato TRUE (default) or FALSE to inherit the stato class -#' @param params a named character vector of input parameters where each -#' element specifies the type of value that will be in the slot e.g. c(example = 'character') -#' @param outputs a named character vector of outputs where each -#' element specifies the type of value that will be in the slot e.g. c(example = 'character') -#' @param private a named character vector of private slots where each -#' element specifies the type of value that will be in the slot e.g. c(example = 'character'). -#' These are intended for internal use by the object and generally not available to the user. -#' @param prototype a named list with initial values for slots. -#' @return a new class definition. to create a new object from this class use X = new_class_name() -set_struct_obj = function( - class_name, - struct_obj, - stato = TRUE, - params = character(0), - outputs = character(0), - private = character(0), - prototype = list()) { - - # inherit stato if stato = TRUE - if (stato) { - struct_obj = c(struct_obj,'stato') - } - - ## list of slots to create - slots = c(params,outputs,private) - - ## add .params and .outputs to prototype - prototype[['.params']]=names(params) - prototype[['.outputs']]=names(outputs) - - ## create class definition as assign to the chosen environment - - assign(paste0('.',class_name),setClass( - Class = class_name, - contains = struct_obj, - slots = slots, - prototype = prototype, - where = topenv(parent.frame()) - ), - topenv(parent.frame())) - - assign(class_name,function(...){ - # new object - out = eval(parse(text=paste0('new_struct("',class_name,'",...)'))) - return(out) - }, - topenv(parent.frame()) - ) - -} - - -#' update method for a struct object -#' -#' a helper function to update methods for a struct object -#' @export -#' @param class_name the name of the to update the method for -#' @param method_name the name of the method to update. Must be an existing method for the object. -#' @param definition the function to replace the method with. This function will be used when the method is called on the object. -#' @param where the environment to create the object in. default where = topenv(parent.frame()) -#' @param signature a list of classes that this object requires as inputs. Default is c(class_name,'DatasetExperiment') -#' @return a method is created in the specified environment -#' @examples -#' set_struct_obj( -#' class_name = 'add_two_inputs', -#' struct_obj = 'model', -#' stato = FALSE, -#' params = c(input_1 = 'numeric', input_2 = 'numeric'), -#' outputs = c(result = 'numeric'), -#' prototype = list( -#' input_1 = 0, -#' input_2 = 0, -#' name = 'Add two inputs', -#' description = 'example class that adds two values together') -#') -set_obj_method = function(class_name, method_name, definition, where = topenv(parent.frame()), signature=c(class_name,'DatasetExperiment')) { - - setMethod(f = method_name, - signature = signature, - definition = definition, - where = where) - -} - -# ' update show method for a struct object -#' -#' a helper function to update the show method for a struct object -#' @export -#' @param class_name the name of the to update the method for -#' @param extra_string a function that returns an extra string using the input object as an input e.g. function(object){return = 'extra_string'} -#' @param where the environment to create the object in. default where = topenv(parent.frame()) -#' @return a method is created in the specified environment -#' @examples -#' # create an example object first -#' set_struct_obj( -#' class_name = 'add_two_inputs', -#' struct_obj = 'model', -#' stato = FALSE, -#' params = c(input_1 = 'numeric', input_2 = 'numeric'), -#' outputs = c(result = 'numeric'), -#' prototype = list( -#' input_1 = 0, -#' input_2 = 0, -#' name = 'Add two inputs', -#' description = 'example class that adds two values together') -#') -#' -#' # now update the method -#' set_obj_show( -#' class_name = 'add_two_inputs', -#' extra_string = function(object) {return('The extra text')} -#' ) -#' -set_obj_show = function(class_name, extra_string,where = topenv(parent.frame())) { - - setMethod(f = 'show', - signature = c(class_name), - definition = function(object) { - callNextMethod() # force the default output - # add extra info - cat(extra_string(object)) - }, - where = where - ) -} - -populate_slots=function(obj,...) { - L=list(...) - for (k in L) { - if (is_param(obj,names(k))) { - param_value(obj,names(k)) = k[[1]] - } - - } -} - - -#' Generate a \pkg{struct} object from a Class -#' -#' This function creates a newly allocated object from the class identified by -#' the first argument. It works almost identically to \code{new} but is specific -#' to objects from the \pkg{struct} package and ensures that \code{entity} slots have -#' their values assigned correctly. This function is usually called by class -#' constructors and not used directly. -#' -#' @param class The class of struct object to create -#' @param ... named slots and values to assign -#' @return An object derived from struct_class -#' @examples -#' S = new_struct('struct_class') -#' @export -new_struct = function(class, ...) { - # new default object - obj=new(class) - - # check if struct_class - if (!is(obj,'struct_class')){ - stop(paste0('struct_class is only for objects derived from struct_class. Got object of type "',class(obj),'"')) - } - - # update values - L=list(...) - for (k in seq_len(length(L))) { - param_value(obj,names(L)[k])=L[[k]] - } - - return(obj) -} - - - -#' @rdname citations -#' @export -setMethod(f = "citations", - signature = c("struct_class"), - definition = function(obj) { - if (is(obj,'DatasetExperiment')) { - cit=D$citations - } else { - cit=list() - } - - # citations for libraries - lib = .extended_list_by_slot(obj,'libraries') - lib = lapply(lib,function(x){ - # citations for library - A = suppressWarnings(citation(x)) - # convert to strings - #B=.list_of_citations_as_strings(A) - return(A) - }) - - cit = c(cit,lib) - - # citations as strings - out = .extended_list_by_slot(obj,'citations') - cit=c(cit,out) - - # remove duplicates - cit=cit[!(duplicated(cit))] - return(cit) - } -) - -#' @rdname libraries -#' @export -setMethod(f = "libraries", - signature = c("struct_class"), - definition = function(obj) { - lib=.extended_list_by_slot(obj,'libraries') - lib=lib[!(duplicated(lib))] - return(lib) - } -) - - - - -.extended_list_by_slot = function(obj,slotname) { - # returns a unique list of values for slots in this object - # and all the ones in inherits - cit=list() - # get the objects this object extends - ex = extends(class(obj)[1]) - # for each one, if its a struct class grab the citations - for (k in seq_along(ex)) { - if (extends(ex[[k]],'struct_class')) { - X = new_struct(ex[k]) - S=slot(X,slotname) - cit=c(cit,S) - } - } - return(cit) -} - - - - -.list_of_citations_as_strings = function(L) { - - B=lapply(L,function(x){ - str=capture.output(print(x,style='textVersion')) - str=paste0(str,collapse='') - return(str) - } - ) - - C=unlist(B) - return(C) +#' \code{struct_class} object definition +#' +#' Defines the struct class base template. This class is inherited by other objects +#' and not intended for direct use. It defines slots and methods common to all +#' \pkg{struct} objects. +#' +#' @section Public slots: +#' Public slots can be accessed using shorthand $ notation and are intended for +#' users building workflows. +#' +#' \describe{ +#' \item{\code{name}}{\code{character()} A short descriptive name of the struct object} +#' \item{\code{description}}{\code{character()} A longer description of the struct object and what it does} +#' \item{\code{type}}{\code{character()} A keyword that describes the type of struct object} +#' \item{\code{libraries}}{\code{character()} A (read only) list of R packages used by this struct object} +#' \item{\code{citations}}{\code{list of bibentry} A (read only) list of citations relevant to this struct object, +#' in Bibtex format.} +#' } +#' +#' @section Private slots: +#' Private slots are not readily accessible to users and are intended for developers +#' creating their own struct objects. Any slot not listed within `.params` or +#' `.outputs` is considered a private slot. +#' +#' \describe{ +#' \item{\code{.params}}{\code{character()} A list of additional slot names that can be get/set by the user +#' for a specific struct object. These are used as input parameters for different methods.} +#' \item{\code{.outputs}}{\code{character()} a list of additional slot names that can be get by the user. These are +#' used to store the results of a method.} +#' } +#' +#' +#' @import methods +#' @include generics.R +#' @return Returns a \pkg{struct} object +#' @examples +#' S = struct_class(name = 'Example',description = 'An example object') +#' @export +.struct_class<-setClass( + "struct_class", + slots = c( + name = 'character', + description = "character", + type = "character", + libraries = 'character', + citations = 'list', + .params='character', + .outputs='character' + ), + prototype = list( + 'citations'=suppressWarnings(list(citation('struct'))) + ) +) + +#' Constructor for struct_class objects +#' +#' Creates a new \linkS4class{struct_class} object and populates the slots. Not intended +#' for direct use. +#' @param name the name of the object +#' @param description a description of the object +#' @param type the type of the struct object +#' @param citations a list of citations for the object in "bibentry" format +#' @return a struct_class object +#' @export +struct_class = function( + name=character(0), + description=character(0), + type=character(0), + citations=list()) { + + # if Bibtex is provided convert to a list + if (is(citations,'bibentry')){ + citations=list(citations) + } + + # check all citations are Bibtex + if (length(citations>0)) { + ok=lapply(citations,is,class='bibentry') + if (!(all(citations))){ + stop('all citations must be in "bibentry" format') + } + } + + # new object + out = .struct_class( + name=name, + description=description, + type=type + ) + + return(out) +} + + +#' Get/set parameter or output values +#' +#' Dollar syntax can be used to as a shortcut for getting/setting input parameter +#' and output values for struct objects. +#' @return Parameter/output value +#' @param x An object derived from struct_class +#' @param name The name of the slot to access +#' @examples +#' M = example_model() +#' M$value_1 = 10 +#' M$value_1 # 10 +#' @export +setMethod(f = "$", + signature = c("struct_class"), + definition = function(x,name) { + + # check for param + w = is_param(x,name) + if (w) { + out = param_value(x,name) + return(out) + } + + # check for output + w = is_output(x,name) + if (w) { + out = output_value(x,name) + return(out) + } + + # check for other struct slots + valid=c('name','description','type','libraries','citations') + if (name %in% valid) { + out = slot(x,name) + return(out) + } + + # if we get here then error + stop(paste0('"', name, '" is not valid for this object:', class(x)[1])) + + } +) + +#' Get/set parameter or output values +#' +#' Dollar syntax can be used to as a shortcut for getting/setting input parameter +#' and output values for struct objects. +#' @return Parameter/output value +#' @param x An object derived from struct_class +#' @param name The name of the slot to access +#' @param value The value to assign +#' @examples +#' M = example_model() +#' M$value_1 = 10 +#' M$value_1 # 10 +#' @export +setMethod(f = "$<-", + signature = c("struct_class"), + definition = function(x,name,value) { + + + # check for param + if (is_param(x,name)) { + param_value(x,name) = value + return(x) + } + + # check for output + if (is_output(x,name)) { + output_value(x,name) = value + return(x) + } + + # check for other slots + valid=c('name','description','type') + # do not allow setting of libraries or citations + if (name %in% valid) { + # check citation is Bibtex + if (name=='citations') { + ok=lapply(value,is,class='bibentry') + if (!all(unlist(ok))) { + stop(paste0('All citations must be "bibentry" objects')) + } + } + + slot(x,name) = value + return(x) + } + + # if we havent returned value by now, then we're not going to + stop(paste0(name,' is not a valid param, output or column name for this DatasetExperiment using $')) + + } +) + +#' @describeIn chart_names +#' @export +setMethod(f = "chart_names", + signature = c("struct_class"), + definition = function(obj,ret = 'char') { + if (ret == 'char') { + OUT = character(0) + } else if (ret == 'obj') { + OUT = list() + } else { + stop('not a valid ret option. Try "char" or "obj"') + } + x = showMethods(f = chart_plot,classes = class(obj)[1],printTo = FALSE) + if (x[2] == '') { + } else { + + for (i in 2:length(x)) { + a = strsplit(x[i],'\"')[[1]] + if (length(a)>0) { + a = a[seq(2, length(a), by = 2)] + a = a[-which(a == class(obj)[1])] + if (length(a)>0) { + if (a == 'chart') { + } else if (extends(a,'chart')) { + if (ret == 'char') { + OUT = c(OUT,a) + } else + OUT[[length(OUT)+1]] = eval(parse(text = paste0(a, + '()'))) + } + } + } + } + } + return(OUT) + } +) + + +setMethod(f = "show", + signature = c("struct_class"), + definition = function(object) { + n=nchar(paste0('A "', class(object),'" object')) + + if (length(object@description) > 1) { + + nmes=names(object$description) + if (is.null(nmes)) { + # add bullets to description if more than one item + object@description=paste0('\U2022',' ', object$description) + } else { + nmes=paste0(nmes,':') + padding=max(nchar(nmes)) + padding=strrep(' ',padding) + + for (k in seq_along(nmes)) { + nme=sub(strrep(' ',nchar(nmes[k])),nmes[k],padding) + object@description[k]=paste0(nme,' ',object@description[k]) + } + # add name to description if more than one item + object@description=paste0('\U2022',' ', object$description) + } + } + # strip newlines from description, we'll add our own + object@description=gsub("[\r\n]",'',object@description) + if (length(object$description)>1) { + pad='\n ' + } else { + pad='\n' + } + + cat( + 'A "', class(object),'" object','\n', + rep('-',n),'\n', + 'name: ', object$name,'\n', + 'description: ', paste0(strwrap(object$description,width=95,exdent = 17),collapse=pad),'\n', + sep = '' + ) + + if (length(object@.params>0) & !is(object,'entity')) { + cat('input params: ', paste(object@.params,collapse=', '),'\n') + } + if (length(object@.outputs>0) & !is(object,'entity')) { + cat('outputs: ', paste(object@.outputs,collapse=', '),'\n') + } + + } +) + + +#' define a new struct object +#' +#' a helper function to create new struct objects +#' @export +#' @param class_name the name of the new class to create +#' @param struct_obj the struct obj to inherit e.g. 'model', 'metric' etc +#' @param stato TRUE (default) or FALSE to inherit the stato class +#' @param params a named character vector of input parameters where each +#' element specifies the type of value that will be in the slot e.g. c(example = 'character') +#' @param outputs a named character vector of outputs where each +#' element specifies the type of value that will be in the slot e.g. c(example = 'character') +#' @param private a named character vector of private slots where each +#' element specifies the type of value that will be in the slot e.g. c(example = 'character'). +#' These are intended for internal use by the object and generally not available to the user. +#' @param prototype a named list with initial values for slots. +#' @return a new class definition. to create a new object from this class use X = new_class_name() +set_struct_obj = function( + class_name, + struct_obj, + stato = TRUE, + params = character(0), + outputs = character(0), + private = character(0), + prototype = list()) { + + # inherit stato if stato = TRUE + if (stato) { + struct_obj = c(struct_obj,'stato') + } + + ## list of slots to create + slots = c(params,outputs,private) + + ## add .params and .outputs to prototype + prototype[['.params']]=names(params) + prototype[['.outputs']]=names(outputs) + + ## create class definition as assign to the chosen environment + + assign(paste0('.',class_name),setClass( + Class = class_name, + contains = struct_obj, + slots = slots, + prototype = prototype, + where = topenv(parent.frame()) + ), + topenv(parent.frame())) + + assign(class_name,function(...){ + # new object + out = eval(parse(text=paste0('new_struct("',class_name,'",...)'))) + return(out) + }, + topenv(parent.frame()) + ) + +} + + +#' update method for a struct object +#' +#' a helper function to update methods for a struct object +#' @export +#' @param class_name the name of the to update the method for +#' @param method_name the name of the method to update. Must be an existing method for the object. +#' @param definition the function to replace the method with. This function will be used when the method is called on the object. +#' @param where the environment to create the object in. default where = topenv(parent.frame()) +#' @param signature a list of classes that this object requires as inputs. Default is c(class_name,'DatasetExperiment') +#' @return a method is created in the specified environment +#' @examples +#' set_struct_obj( +#' class_name = 'add_two_inputs', +#' struct_obj = 'model', +#' stato = FALSE, +#' params = c(input_1 = 'numeric', input_2 = 'numeric'), +#' outputs = c(result = 'numeric'), +#' prototype = list( +#' input_1 = 0, +#' input_2 = 0, +#' name = 'Add two inputs', +#' description = 'example class that adds two values together') +#') +set_obj_method = function(class_name, method_name, definition, where = topenv(parent.frame()), signature=c(class_name,'DatasetExperiment')) { + + setMethod(f = method_name, + signature = signature, + definition = definition, + where = where) + +} + +# ' update show method for a struct object +#' +#' a helper function to update the show method for a struct object +#' @export +#' @param class_name the name of the to update the method for +#' @param extra_string a function that returns an extra string using the input object as an input e.g. function(object){return = 'extra_string'} +#' @param where the environment to create the object in. default where = topenv(parent.frame()) +#' @return a method is created in the specified environment +#' @examples +#' # create an example object first +#' set_struct_obj( +#' class_name = 'add_two_inputs', +#' struct_obj = 'model', +#' stato = FALSE, +#' params = c(input_1 = 'numeric', input_2 = 'numeric'), +#' outputs = c(result = 'numeric'), +#' prototype = list( +#' input_1 = 0, +#' input_2 = 0, +#' name = 'Add two inputs', +#' description = 'example class that adds two values together') +#') +#' +#' # now update the method +#' set_obj_show( +#' class_name = 'add_two_inputs', +#' extra_string = function(object) {return('The extra text')} +#' ) +#' +set_obj_show = function(class_name, extra_string,where = topenv(parent.frame())) { + + setMethod(f = 'show', + signature = c(class_name), + definition = function(object) { + callNextMethod() # force the default output + # add extra info + cat(extra_string(object)) + }, + where = where + ) +} + +populate_slots=function(obj,...) { + L=list(...) + for (k in L) { + if (is_param(obj,names(k))) { + param_value(obj,names(k)) = k[[1]] + } + + } +} + + +#' Generate a \pkg{struct} object from a Class +#' +#' This function creates a newly allocated object from the class identified by +#' the first argument. It works almost identically to \code{new} but is specific +#' to objects from the \pkg{struct} package and ensures that \code{entity} slots have +#' their values assigned correctly. This function is usually called by class +#' constructors and not used directly. +#' +#' @param class The class of struct object to create +#' @param ... named slots and values to assign +#' @return An object derived from struct_class +#' @examples +#' S = new_struct('struct_class') +#' @export +new_struct = function(class, ...) { + # new default object + obj=new(class) + + # check if struct_class + if (!is(obj,'struct_class')){ + stop(paste0('struct_class is only for objects derived from struct_class. Got object of type "',class(obj),'"')) + } + + # update values + L=list(...) + for (k in seq_len(length(L))) { + param_value(obj,names(L)[k])=L[[k]] + } + + return(obj) +} + + + +#' @rdname citations +#' @importFrom utils capture.output bibentry as.person citation +#' @export +setMethod(f = "citations", + signature = c("struct_class"), + definition = function(obj) { + if (is(obj,'DatasetExperiment')) { + cit=obj$citations + } else { + cit=list() + } + + # citations for libraries + lib = .extended_list_by_slot(obj,'libraries') + lib = lapply(lib,function(x){ + # citations for library + A = suppressWarnings(citation(x)) + # convert to strings + #B=.list_of_citations_as_strings(A) + return(A) + }) + + cit = c(cit,lib) + + # citations as strings + out = .extended_list_by_slot(obj,'citations') + cit=c(cit,out) + + # remove duplicates + cit=cit[!(duplicated(cit))] + return(cit) + } +) + +#' @rdname libraries +#' @export +setMethod(f = "libraries", + signature = c("struct_class"), + definition = function(obj) { + lib=.extended_list_by_slot(obj,'libraries') + lib=lib[!(duplicated(lib))] + return(lib) + } +) + + + + +.extended_list_by_slot = function(obj,slotname) { + # returns a unique list of values for slots in this object + # and all the ones in inherits + cit=list() + # get the objects this object extends + ex = extends(class(obj)[1]) + # for each one, if its a struct class grab the citations + for (k in seq_along(ex)) { + if (extends(ex[[k]],'struct_class')) { + X = new_struct(ex[k]) + S=slot(X,slotname) + cit=c(cit,S) + } + } + return(cit) +} + + + + +.list_of_citations_as_strings = function(L) { + + B=lapply(L,function(x){ + str=capture.output(print(x,style='textVersion')) + str=paste0(str,collapse='') + return(str) + } + ) + + C=unlist(B) + return(C) } \ No newline at end of file diff --git a/man/struct.Rd b/man/struct.Rd index 61f6aad..29c60ad 100644 --- a/man/struct.Rd +++ b/man/struct.Rd @@ -8,7 +8,7 @@ This package defines classes (templates) for developing statistical workflows. These classes can be extended using other packages, making it easier to combine methods from different packages into a robust workflow. -Integreation with STATO: the statistical methods ontology +Integration with STATO: the statistical methods ontology (\url{https://www.ebi.ac.uk/ols/ontologies/stato}) provides standardised definitions for many statistical methods. } From 0ce1380a9a405905b0bc5ff7fcc11ae848b39032 Mon Sep 17 00:00:00 2001 From: Gavin Rhys Lloyd Date: Mon, 4 Jan 2021 15:50:18 +0000 Subject: [PATCH 8/9] fix missing newline --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index a35149b..5bfd512 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -64,4 +64,4 @@ VignetteBuilder: knitr Imports: methods, ontologyIndex, datasets, graphics, stats, utils, knitr, SummarizedExperiment, S4Vectors -biocViews: WorkflowStep \ No newline at end of file +biocViews: WorkflowStep From 42d67cd842aad73952cf57673ab10bddcc782a46 Mon Sep 17 00:00:00 2001 From: Gavin Rhys Lloyd Date: Mon, 4 Jan 2021 15:57:16 +0000 Subject: [PATCH 9/9] GitHub actions (#35) * replace travis/appveyor with actions * add imports for utils import functions specifically for citations * remove travis and appveyor --- .github/.gitignore | 1 + .github/ISSUE_TEMPLATE/issue_template.md | 56 +++++ .github/workflows/check-bioc.yml | 270 +++++++++++++++++++++ .travis.yml | 19 -- NAMESPACE | 284 +++++++++++------------ README.rst | 14 +- appveyor.yml | 55 ----- 7 files changed, 473 insertions(+), 226 deletions(-) create mode 100644 .github/.gitignore create mode 100644 .github/ISSUE_TEMPLATE/issue_template.md create mode 100644 .github/workflows/check-bioc.yml delete mode 100644 .travis.yml delete mode 100644 appveyor.yml diff --git a/.github/.gitignore b/.github/.gitignore new file mode 100644 index 0000000..2d19fc7 --- /dev/null +++ b/.github/.gitignore @@ -0,0 +1 @@ +*.html diff --git a/.github/ISSUE_TEMPLATE/issue_template.md b/.github/ISSUE_TEMPLATE/issue_template.md new file mode 100644 index 0000000..6e857c6 --- /dev/null +++ b/.github/ISSUE_TEMPLATE/issue_template.md @@ -0,0 +1,56 @@ +--- +name: Bug report or feature request +about: Describe a bug you've seen or make a case for a new feature +title: "[BUG] Your bug or feature request" +labels: '' +assignees: '' +--- + +Please briefly describe your problem and what output you expect. If you have a question, please don't use this form. Instead, ask on using the appropriate tag(s) including one for this package. + +## Context + +Provide some context for your bug report or feature request. This could be the: + +* link to raw code, example: https://github.com/lcolladotor/osca_LIIGH_UNAM_2020/blob/master/00-template.Rmd#L24-L28 +* link to a commit, example: https://github.com/lcolladotor/osca_LIIGH_UNAM_2020/commit/6aa30b22eda614d932c12997ba611ba582c435d7 +* link to a line of code inside a commit, example: https://github.com/lcolladotor/osca_LIIGH_UNAM_2020/commit/6aa30b22eda614d932c12997ba611ba582c435d7#diff-e265269fe4f17929940e81341b92b116R17 +* link to code from an R package, example: https://github.com/LieberInstitute/spatialLIBD/blob/master/R/run_app.R#L51-L55 + +## Code + +Include the code you ran and comments + +```R +## prompt an error +stop('hola') + +## check the error trace +traceback() +``` + +## Small reproducible example + +If you copy the lines of code that lead to your error, you can then run [`reprex::reprex()`](https://reprex.tidyverse.org/reference/reprex.html) which will create a small website with code you can then easily copy-paste here in a way that will be easy to work with later on. + +```R +## prompt an error +stop('hola') +#> Error in eval(expr, envir, enclos): hola + +## check the error trace +traceback() +#> No traceback available +``` + + +## R session information + +Remember to include your full R session information. + +```R +options(width = 120) +sessioninfo::session_info() +``` + +The output of `sessioninfo::session_info()` includes relevant GitHub installation information and other details that are missed by `sessionInfo()`. diff --git a/.github/workflows/check-bioc.yml b/.github/workflows/check-bioc.yml new file mode 100644 index 0000000..a3e4522 --- /dev/null +++ b/.github/workflows/check-bioc.yml @@ -0,0 +1,270 @@ +## Read more about GitHub actions the features of this GitHub Actions workflow +## at https://lcolladotor.github.io/biocthis/articles/biocthis.html#use_bioc_github_action +## +## For more details, check the biocthis developer notes vignette at +## https://lcolladotor.github.io/biocthis/articles/biocthis_dev_notes.html +## +## You can add this workflow to other packages using: +## > biocthis::use_bioc_github_action() +## +## Using GitHub Actions exposes you to many details about how R packages are +## compiled and installed in several operating system.s +### If you need help, please follow the steps listed at +## https://github.com/r-lib/actions#where-to-find-help +## +## If you found an issue specific to biocthis's GHA workflow, please report it +## with the information that will make it easier for others to help you. +## Thank you! + +## Acronyms: +## * GHA: GitHub Action +## * OS: operating system + +on: + push: + pull_request: + +name: R-CMD-check-bioc + +## These environment variables control whether to run GHA code later on that is +## specific to testthat, covr, and pkgdown. +## +## If you need to clear the cache of packages, update the number inside +## cache-version as discussed at https://github.com/r-lib/actions/issues/86. +## Note that you can always run a GHA test without the cache by using the word +## "/nocache" in the commit message. +env: + has_testthat: 'true' + run_covr: 'true' + run_pkgdown: 'false' + has_RUnit: 'false' + cache-version: 'cache-v1' + +jobs: + build-check: + runs-on: ${{ matrix.config.os }} + name: ${{ matrix.config.os }} (${{ matrix.config.r }}) + container: ${{ matrix.config.cont }} + ## Environment variables unique to this job. + + strategy: + fail-fast: false + matrix: + config: + - { os: ubuntu-latest, r: '4.0', bioc: '3.12', cont: "bioconductor/bioconductor_docker:RELEASE_3_12", rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest" } + - { os: macOS-latest, r: '4.0', bioc: '3.12'} + - { os: windows-latest, r: '4.0', bioc: '3.12'} + env: + R_REMOTES_NO_ERRORS_FROM_WARNINGS: true + RSPM: ${{ matrix.config.rspm }} + NOT_CRAN: true + TZ: UTC + GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + + steps: + + ## Set the R library to the directory matching the + ## R packages cache step further below when running on Docker (Linux). + - name: Set R Library home on Linux + if: runner.os == 'Linux' + run: | + mkdir /__w/_temp/Library + echo ".libPaths('/__w/_temp/Library')" > ~/.Rprofile + + ## Most of these steps are the same as the ones in + ## https://github.com/r-lib/actions/blob/master/examples/check-standard.yaml + ## If they update their steps, we will also need to update ours. + - name: Checkout Repository + uses: actions/checkout@v2 + + ## R is already included in the Bioconductor docker images + - name: Setup R from r-lib + if: runner.os != 'Linux' + uses: r-lib/actions/setup-r@master + with: + r-version: ${{ matrix.config.r }} + + ## pandoc is already included in the Bioconductor docker images + - name: Setup pandoc from r-lib + if: runner.os != 'Linux' + uses: r-lib/actions/setup-pandoc@master + + - name: Query dependencies + run: | + install.packages('remotes') + saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2) + shell: Rscript {0} + + - name: Cache R packages + if: "!contains(github.event.head_commit.message, '/nocache') && runner.os != 'Linux'" + uses: actions/cache@v2 + with: + path: ${{ env.R_LIBS_USER }} + key: ${{ env.cache-version }}-${{ runner.os }}-biocversion-RELEASE_3_12-r-4.0-${{ hashFiles('.github/depends.Rds') }} + restore-keys: ${{ env.cache-version }}-${{ runner.os }}-biocversion-RELEASE_3_12-r-4.0- + + - name: Cache R packages on Linux + if: "!contains(github.event.head_commit.message, '/nocache') && runner.os == 'Linux' " + uses: actions/cache@v2 + with: + path: /home/runner/work/_temp/Library + key: ${{ env.cache-version }}-${{ runner.os }}-biocversion-RELEASE_3_12-r-4.0-${{ hashFiles('.github/depends.Rds') }} + restore-keys: ${{ env.cache-version }}-${{ runner.os }}-biocversion-RELEASE_3_12-r-4.0- + + - name: Install Linux system dependencies + if: runner.os == 'Linux' + run: | + sysreqs=$(Rscript -e 'cat("apt-get update -y && apt-get install -y", paste(gsub("apt-get install -y ", "", remotes::system_requirements("ubuntu", "20.04")), collapse = " "))') + echo $sysreqs + sudo -s eval "$sysreqs" + + - name: Install macOS system dependencies + if: matrix.config.os == 'macOS-latest' + run: | + ## Enable installing XML from source if needed + brew install libxml2 + echo "XML_CONFIG=/usr/local/opt/libxml2/bin/xml2-config" >> $GITHUB_ENV + + ## Required to install magick as noted at + ## https://github.com/r-lib/usethis/commit/f1f1e0d10c1ebc75fd4c18fa7e2de4551fd9978f#diff-9bfee71065492f63457918efcd912cf2 + brew install imagemagick@6 + + ## For textshaping, required by ragg, and required by pkgdown + brew install harfbuzz fribidi + + ## See if this helps get RCurl installed + ## brew uninstall curl + + - name: Install Windows system dependencies + if: runner.os == 'Windows' + run: | + ## Edit below if you have any Windows system dependencies + shell: Rscript {0} + + - name: Install BiocManager + run: | + message(paste('****', Sys.time(), 'installing BiocManager ****')) + remotes::install_cran("BiocManager") + shell: Rscript {0} + + - name: Set BiocVersion + run: | + BiocManager::install(version = "${{ matrix.config.bioc }}", ask = FALSE) + shell: Rscript {0} + + - name: Install dependencies + run: | + ## Try installing the package dependencies in steps. First the local + ## dependencies, then any remaining dependencies to avoid the + ## issues described at + ## https://stat.ethz.ch/pipermail/bioc-devel/2020-April/016675.html + ## https://github.com/r-lib/remotes/issues/296 + ## Ideally, all dependencies should get installed in the first pass. + + ## Temporary for now due to https://github.com/ropensci/RefManageR/issues/79 + remotes::install_github("ropensci/bibtex") + remotes::install_github("ropensci/RefManageR") + remotes::install_github("cboettig/knitcitations") + + ## Pass #1 at installing dependencies + message(paste('****', Sys.time(), 'pass number 1 at installing dependencies: local dependencies ****')) + remotes::install_local(dependencies = TRUE, repos = BiocManager::repositories(), build_vignettes = TRUE, upgrade = TRUE) + + ## Pass #2 at installing dependencies + message(paste('****', Sys.time(), 'pass number 2 at installing dependencies: any remaining dependencies ****')) + remotes::install_local(dependencies = TRUE, repos = BiocManager::repositories(), build_vignettes = TRUE, upgrade = TRUE) + + ## For running the checks + message(paste('****', Sys.time(), 'installing rcmdcheck and BiocCheck ****')) + remotes::install_cran("rcmdcheck") + BiocManager::install("BiocCheck") + shell: Rscript {0} + + - name: Install BiocGenerics + if: env.has_RUnit == 'true' + run: | + ## Install BiocGenerics + BiocManager::install("BiocGenerics") + shell: Rscript {0} + + - name: Install covr + if: github.ref == 'refs/heads/master' && env.run_covr == 'true' && runner.os == 'Linux' + run: | + remotes::install_cran("covr") + shell: Rscript {0} + + - name: Install pkgdown + if: github.ref == 'refs/heads/master' && env.run_pkgdown == 'true' && runner.os == 'Linux' + run: | + remotes::install_cran("pkgdown") + shell: Rscript {0} + + - name: Session info + run: | + options(width = 100) + pkgs <- installed.packages()[, "Package"] + sessioninfo::session_info(pkgs, include_base = TRUE) + shell: Rscript {0} + + - name: Run CMD check + env: + _R_CHECK_CRAN_INCOMING_: false + run: | + rcmdcheck::rcmdcheck( + args = c("--no-build-vignettes", "--no-manual", "--timings"), + build_args = c("--no-manual", "--no-resave-data"), + error_on = "warning", + check_dir = "check" + ) + shell: Rscript {0} + + ## Might need an to add this to the if: && runner.os == 'Linux' + - name: Reveal testthat details + if: env.has_testthat == 'true' + run: find . -name testthat.Rout -exec cat '{}' ';' + + - name: Run RUnit tests + if: env.has_RUnit == 'true' + run: | + BiocGenerics:::testPackage() + shell: Rscript {0} + + - name: Run BiocCheck + run: | + BiocCheck::BiocCheck( + dir('check', 'tar.gz$', full.names = TRUE), + `quit-with-status` = TRUE, + `no-check-R-ver` = TRUE, + `no-check-bioc-help` = TRUE + ) + shell: Rscript {0} + + - name: Test coverage + if: github.ref == 'refs/heads/master' && env.run_covr == 'true' && runner.os == 'Linux' + run: | + covr::codecov() + shell: Rscript {0} + + - name: Install package + if: github.ref == 'refs/heads/master' && env.run_pkgdown == 'true' && runner.os == 'Linux' + run: R CMD INSTALL . + + - name: Deploy package + if: github.ref == 'refs/heads/master' && env.run_pkgdown == 'true' && runner.os == 'Linux' + run: | + git config --local user.email "actions@github.com" + git config --local user.name "GitHub Actions" + Rscript -e "pkgdown::deploy_to_branch(new_process = FALSE)" + shell: bash {0} + ## Note that you need to run pkgdown::deploy_to_branch(new_process = FALSE) + ## at least one locally before this will work. This creates the gh-pages + ## branch (erasing anything you haven't version controlled!) and + ## makes the git history recognizable by pkgdown. + + - name: Upload check results + if: failure() + uses: actions/upload-artifact@master + with: + name: ${{ runner.os }}-biocversion-RELEASE_3_12-r-4.0-results + path: check diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 index e837ae2..0000000 --- a/.travis.yml +++ /dev/null @@ -1,19 +0,0 @@ -language: r -r: bioc-devel -bioc_check: true -cache: - packages: true -sudo: required -warnings_are_errors: false -dist: xenial - -addons: - apt: - update: true - sources: - - sourceline: 'ppa:cran/imagemagick' - packages: - - libmagick++-dev - -after_success: - - Rscript -e 'covr::codecov()' \ No newline at end of file diff --git a/NAMESPACE b/NAMESPACE index 705521a..f58d182 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,142 +1,142 @@ -# Generated by roxygen2: do not edit by hand - -export("output_list<-") -export("output_value<-") -export("param_list<-") -export("param_obj<-") -export("param_value<-") -export(DatasetExperiment) -export(as.DatasetExperiment) -export(as.SummarizedExperiment) -export(as.code) -export(as_data_frame) -export(calculate) -export(chart) -export(chart_names) -export(chart_plot) -export(citations) -export(entity) -export(entity_stato) -export(enum) -export(enum_stato) -export(example_chart) -export(example_iterator) -export(example_model) -export(iris_DatasetExperiment) -export(is_output) -export(is_param) -export(iterator) -export(libraries) -export(max_length) -export(metric) -export(model) -export(model_apply) -export(model_predict) -export(model_reverse) -export(model_seq) -export(model_train) -export(models) -export(new_struct) -export(optimiser) -export(output_ids) -export(output_list) -export(output_name) -export(output_obj) -export(output_value) -export(param_ids) -export(param_list) -export(param_name) -export(param_obj) -export(param_value) -export(predicted) -export(predicted_name) -export(preprocess) -export(resampler) -export(result) -export(result_name) -export(run) -export(seq_in) -export(set_obj_method) -export(set_obj_show) -export(set_struct_obj) -export(stato) -export(stato_definition) -export(stato_id) -export(stato_name) -export(stato_summary) -export(struct_class) -export(struct_template) -export(test_metric) -export(value) -exportClasses(struct_class) -exportMethods("$") -exportMethods("$<-") -exportMethods("*") -exportMethods("+") -exportMethods("[") -exportMethods("[<-") -exportMethods("max_length<-") -exportMethods("models<-") -exportMethods("output_list<-") -exportMethods("output_obj<-") -exportMethods("output_value<-") -exportMethods("param_list<-") -exportMethods("param_obj<-") -exportMethods("param_value<-") -exportMethods("predicted_name<-") -exportMethods("result_name<-") -exportMethods("seq_in<-") -exportMethods("value<-") -exportMethods(as.DatasetExperiment) -exportMethods(as.SummarizedExperiment) -exportMethods(as.code) -exportMethods(calculate) -exportMethods(chart_names) -exportMethods(chart_plot) -exportMethods(citations) -exportMethods(evaluate) -exportMethods(export_xlsx) -exportMethods(is_output) -exportMethods(is_param) -exportMethods(length) -exportMethods(libraries) -exportMethods(max_length) -exportMethods(model_apply) -exportMethods(model_predict) -exportMethods(model_reverse) -exportMethods(model_train) -exportMethods(models) -exportMethods(output_ids) -exportMethods(output_list) -exportMethods(output_name) -exportMethods(output_obj) -exportMethods(output_value) -exportMethods(param_ids) -exportMethods(param_list) -exportMethods(param_name) -exportMethods(param_obj) -exportMethods(param_value) -exportMethods(predicted) -exportMethods(predicted_name) -exportMethods(result) -exportMethods(result_name) -exportMethods(run) -exportMethods(seq_in) -exportMethods(stato_definition) -exportMethods(stato_id) -exportMethods(stato_name) -exportMethods(stato_summary) -exportMethods(value) -import(S4Vectors) -import(SummarizedExperiment) -import(datasets) -import(methods) -importFrom(graphics,plot) -importFrom(knitr,purl) -importFrom(ontologyIndex,get_ontology) -importFrom(stats,runif) -importFrom(utils,as.person) -importFrom(utils,bibentry) -importFrom(utils,capture.output) -importFrom(utils,citation) -importFrom(utils,file.edit) +# Generated by roxygen2: do not edit by hand + +export("output_list<-") +export("output_value<-") +export("param_list<-") +export("param_obj<-") +export("param_value<-") +export(DatasetExperiment) +export(as.DatasetExperiment) +export(as.SummarizedExperiment) +export(as.code) +export(as_data_frame) +export(calculate) +export(chart) +export(chart_names) +export(chart_plot) +export(citations) +export(entity) +export(entity_stato) +export(enum) +export(enum_stato) +export(example_chart) +export(example_iterator) +export(example_model) +export(iris_DatasetExperiment) +export(is_output) +export(is_param) +export(iterator) +export(libraries) +export(max_length) +export(metric) +export(model) +export(model_apply) +export(model_predict) +export(model_reverse) +export(model_seq) +export(model_train) +export(models) +export(new_struct) +export(optimiser) +export(output_ids) +export(output_list) +export(output_name) +export(output_obj) +export(output_value) +export(param_ids) +export(param_list) +export(param_name) +export(param_obj) +export(param_value) +export(predicted) +export(predicted_name) +export(preprocess) +export(resampler) +export(result) +export(result_name) +export(run) +export(seq_in) +export(set_obj_method) +export(set_obj_show) +export(set_struct_obj) +export(stato) +export(stato_definition) +export(stato_id) +export(stato_name) +export(stato_summary) +export(struct_class) +export(struct_template) +export(test_metric) +export(value) +exportClasses(struct_class) +exportMethods("$") +exportMethods("$<-") +exportMethods("*") +exportMethods("+") +exportMethods("[") +exportMethods("[<-") +exportMethods("max_length<-") +exportMethods("models<-") +exportMethods("output_list<-") +exportMethods("output_obj<-") +exportMethods("output_value<-") +exportMethods("param_list<-") +exportMethods("param_obj<-") +exportMethods("param_value<-") +exportMethods("predicted_name<-") +exportMethods("result_name<-") +exportMethods("seq_in<-") +exportMethods("value<-") +exportMethods(as.DatasetExperiment) +exportMethods(as.SummarizedExperiment) +exportMethods(as.code) +exportMethods(calculate) +exportMethods(chart_names) +exportMethods(chart_plot) +exportMethods(citations) +exportMethods(evaluate) +exportMethods(export_xlsx) +exportMethods(is_output) +exportMethods(is_param) +exportMethods(length) +exportMethods(libraries) +exportMethods(max_length) +exportMethods(model_apply) +exportMethods(model_predict) +exportMethods(model_reverse) +exportMethods(model_train) +exportMethods(models) +exportMethods(output_ids) +exportMethods(output_list) +exportMethods(output_name) +exportMethods(output_obj) +exportMethods(output_value) +exportMethods(param_ids) +exportMethods(param_list) +exportMethods(param_name) +exportMethods(param_obj) +exportMethods(param_value) +exportMethods(predicted) +exportMethods(predicted_name) +exportMethods(result) +exportMethods(result_name) +exportMethods(run) +exportMethods(seq_in) +exportMethods(stato_definition) +exportMethods(stato_id) +exportMethods(stato_name) +exportMethods(stato_summary) +exportMethods(value) +import(S4Vectors) +import(SummarizedExperiment) +import(datasets) +import(methods) +importFrom(graphics,plot) +importFrom(knitr,purl) +importFrom(ontologyIndex,get_ontology) +importFrom(stats,runif) +importFrom(utils,as.person) +importFrom(utils,bibentry) +importFrom(utils,capture.output) +importFrom(utils,citation) +importFrom(utils,file.edit) diff --git a/README.rst b/README.rst index 6b751ad..5e8e1af 100644 --- a/README.rst +++ b/README.rst @@ -2,7 +2,7 @@ STRUCT: STatistics in R Using Class Templates ============================================== -|Git| |Bioconda| |Build Status (Travis)| |License| |Coverage| |AppVeyor| +|Git| |Bioconda| |Build Status| |License| |Coverage| ------------ @@ -32,14 +32,11 @@ References ------------ -.. |Build Status (Travis)| image:: https://img.shields.io/travis/computational-metabolomics/struct/master.svg?label=Travis - :target: https://travis-ci.org/computational-metabolomics/struct - -.. |Build Status (AppVeyor)| image:: https://ci.appveyor.com/api/projects/status/github/computational-metabolomics/struct?branch=master&svg=true - :target: https://ci.appveyor.com/project/computational-metabolomcis/struct +.. |Build Status| image:: https://github.com/computational-metabolomics/structToolbox/workflows/struct/badge.svg + :target: https://github.com/computational-metabolomics/struct/actions .. |Git| image:: https://img.shields.io/badge/repository-GitHub-blue.svg?style=flat&maxAge=3600 - :target: https://github.com/computational-metabolomics/struct + :target: https://github.com/computational-metabolomics/structToolbox .. |Bioconda| image:: https://img.shields.io/badge/install%20with-bioconda-brightgreen.svg?style=flat&maxAge=3600 :target: https://bioconda.github.io/recipes/bioconductor-struct/README.html @@ -49,6 +46,3 @@ References .. |Coverage| image:: https://codecov.io/gh/computational-metabolomics/struct/branch/master/graph/badge.svg :target: https://codecov.io/gh/computational-metabolomics/struct - -.. |AppVeyor| image:: https://ci.appveyor.com/api/projects/status/github/computational-metabolomics/struct?branch=master&svg=true - :target: https://ci.appveyor.com/project/RJMW/struct diff --git a/appveyor.yml b/appveyor.yml deleted file mode 100644 index 096e5c4..0000000 --- a/appveyor.yml +++ /dev/null @@ -1,55 +0,0 @@ -# DO NOT CHANGE the "init" and "install" sections below - -# Download script file from GitHub -init: - ps: | - $ErrorActionPreference = "Stop" - Invoke-WebRequest http://raw.github.com/krlmlr/r-appveyor/master/scripts/appveyor-tool.ps1 -OutFile "..\appveyor-tool.ps1" - Import-Module '..\appveyor-tool.ps1' -install: - ps: Bootstrap - -cache: - #- C:\RLibrary - -environment: - NOT_CRAN: true - # env vars that may need to be set, at least temporarily, from time to time - # see https://github.com/krlmlr/r-appveyor#readme for details - # USE_RTOOLS: true - # R_REMOTES_STANDALONE: true - R_VERSION: devel - BIOC_USE_DEVEL: TRUE - USE_RTOOLS: true - PKGTYPE: both - -# Adapt as necessary starting from here - -build_script: - - travis-tool.sh install_deps - -test_script: - - travis-tool.sh run_tests - -on_failure: - - 7z a failure.zip *.Rcheck\* - - appveyor PushArtifact failure.zip - -artifacts: - - path: '*.Rcheck\**\*.log' - name: Logs - - - path: '*.Rcheck\**\*.out' - name: Logs - - - path: '*.Rcheck\**\*.fail' - name: Logs - - - path: '*.Rcheck\**\*.Rout' - name: Logs - - - path: '\*_*.tar.gz' - name: Bits - - - path: '\*_*.zip' - name: Bits \ No newline at end of file