From 0ea7370204b9c127c2d4178899b528a38039c135 Mon Sep 17 00:00:00 2001 From: grlloyd Date: Mon, 14 Oct 2019 10:06:39 +0100 Subject: [PATCH 1/9] convert all methods to models due to changes in base package struct --- NAMESPACE | 2 +- R/HSDEM_class.R | 4 +- R/HSD_class.R | 4 +- R/PLSFC_class.R | 4 +- R/anova_class.R | 6 +- R/blank_filter_class.R | 8 +- R/classical_lsq_class.R | 6 +- R/confounders_clsq_class.R | 16 +-- R/corr_coef_class.R | 4 +- R/d_ratio_filter_class.R | 10 +- R/feature_profile_class.R | 4 +- R/filter_by_name_class.R | 6 +- R/filter_na_count.R | 6 +- R/filter_smeta_class.R | 6 +- R/fisher_exact_class.R | 6 +- R/fold_change_class.R | 10 +- R/fold_change_int_class.R | 8 +- R/forward_selection_by_rank_class.R | 4 +- R/glog_class.R | 4 +- R/hca_class.R | 4 +- R/knn_impute_class.R | 4 +- R/kw_rank_sum_class.R | 4 +- R/log_transform.R | 4 +- R/mixed_effect_class.R | 4 +- R/model_apply_doc.R | 6 +- R/mv_feature_filter_class.R | 4 +- R/mv_sample_filter_class.R | 4 +- R/pairs_filter_class.R | 6 +- R/pqn_norm_method_class.R | 4 +- R/prop_na_class.R | 4 +- R/rsd_filter.R | 4 +- R/sb_corr.R | 4 +- R/sbcms_dataset_class.R | 2 +- R/split_data_class.R | 4 +- R/tSNE_class.R | 4 +- R/ttest_class.R | 6 +- R/vec_norm_class.R | 4 +- R/wilcox_test_class.R | 6 +- man-roxygen/method_apply.R | 2 +- man/ANOVA-class.Rd | 2 +- man/blank_filter-class.Rd | 2 +- man/classical_lsq-class.Rd | 2 +- man/confounders_clsq-class.Rd | 2 +- man/confounders_lsq.barchart-class.Rd | 2 +- man/confounders_lsq.boxplot-class.Rd | 2 +- man/dratio_filter-class.Rd | 2 +- man/filter_by_name-class.Rd | 2 +- man/filter_na_count-class.Rd | 2 +- man/filter_smeta-class.Rd | 2 +- man/fisher_exact-class.Rd | 2 +- man/fold_change-class.Rd | 2 +- man/fold_change_int-class.Rd | 2 +- man/forward_selection_byrank-class.Rd | 2 +- man/fs_line-class.Rd | 2 +- man/method.apply.Rd | 132 ------------------------ man/model.apply.Rd | 132 ++++++++++++++++++++++++ tests/testthat/test-anova.R | 8 +- tests/testthat/test-blank-filter.R | 4 +- tests/testthat/test-confounders-lsq.R | 6 +- tests/testthat/test-filter-by-name.R | 8 +- tests/testthat/test-filter-smeta.R | 4 +- tests/testthat/test-fisher-exact.R | 2 +- tests/testthat/test-glog.R | 2 +- tests/testthat/test-knn-impute.R | 2 +- tests/testthat/test-log-transform.R | 2 +- tests/testthat/test-mixed-effects.R | 4 +- tests/testthat/test-mv-feature-filter.R | 10 +- tests/testthat/test-mv-sample-filter.R | 4 +- tests/testthat/test-pqn-norm.R | 4 +- tests/testthat/test-prop-na.R | 2 +- tests/testthat/test-rsd-filter.R | 4 +- tests/testthat/test-split-data.R | 2 +- tests/testthat/test-ttest.R | 2 +- tests/testthat/test-vec-norm.R | 2 +- 74 files changed, 284 insertions(+), 284 deletions(-) delete mode 100644 man/method.apply.Rd create mode 100644 man/model.apply.Rd diff --git a/NAMESPACE b/NAMESPACE index 8304dd3..13e0b37 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -89,7 +89,7 @@ export(wilcox_p_hist) export(wilcox_test) exportMethods(calculate) exportMethods(chart.plot) -exportMethods(method.apply) +exportMethods(model.apply) exportMethods(model.predict) exportMethods(model.reverse) exportMethods(model.train) diff --git a/R/HSDEM_class.R b/R/HSDEM_class.R index 2923148..9986391 100644 --- a/R/HSDEM_class.R +++ b/R/HSDEM_class.R @@ -12,7 +12,7 @@ #' M = HSDEM() HSDEM<-setClass( "HSDEM", - contains=c('method','stato'), + contains=c('model','stato'), slots=c( # INPUTS params.alpha='entity.stato', @@ -61,7 +61,7 @@ HSDEM<-setClass( #' @export #' @template method_apply -setMethod(f="method.apply", +setMethod(f="model.apply", signature=c("HSDEM",'dataset'), definition=function(M,D) { X=dataset.data(D) diff --git a/R/HSD_class.R b/R/HSD_class.R index 37a8a79..a9d1813 100644 --- a/R/HSD_class.R +++ b/R/HSD_class.R @@ -11,7 +11,7 @@ #' M = HSD() HSD<-setClass( "HSD", - contains=c('method','stato'), + contains=c('model','stato'), slots=c( # INPUTS params.alpha='entity.stato', @@ -71,7 +71,7 @@ HSD<-setClass( #' @export #' @template method_apply -setMethod(f="method.apply", +setMethod(f="model.apply", signature=c("HSD",'dataset'), definition=function(M,D) { X=dataset.data(D) diff --git a/R/PLSFC_class.R b/R/PLSFC_class.R index 16789c5..1e81569 100644 --- a/R/PLSFC_class.R +++ b/R/PLSFC_class.R @@ -21,7 +21,7 @@ PLSFC<-setClass( #' @export #' @template method_apply -setMethod(f="method.apply", +setMethod(f="model.apply", signature=c("PLSFC",'dataset'), definition=function(M,D) { # log transform @@ -59,7 +59,7 @@ setMethod(f="method.apply", for (B in (A+1):(length(L))) { # filter groups to A and B FG=filter_smeta(factor_name=M$factor_name,mode='include',levels=L[c(A,B)]) - FG=method.apply(FG,D) + FG=model.apply(FG,D) # change to ordered factor so that we make use of control group FG$filtered$sample_meta[[M$factor_name]]=ordered(FG$filtered$sample_meta[[M$factor_name]],levels=L[c(A,B)]) diff --git a/R/anova_class.R b/R/anova_class.R index ba3dc53..7cc82f5 100644 --- a/R/anova_class.R +++ b/R/anova_class.R @@ -14,14 +14,14 @@ #' @examples #' D = iris_dataset() #' M = ANOVA(formula=y~Species) -#' M = method.apply(M,D) +#' M = model.apply(M,D) #' #' @include entity_objects.R #' #' @export ANOVA ANOVA<-setClass( "ANOVA", - contains=c('method','stato'), + contains=c('model','stato'), slots=c( # INPUTS params.alpha='entity.stato', @@ -59,7 +59,7 @@ ANOVA<-setClass( #' @export #' @template method_apply -setMethod(f="method.apply", +setMethod(f="model.apply", signature=c("ANOVA",'dataset'), definition=function(M,D) { diff --git a/R/blank_filter_class.R b/R/blank_filter_class.R index 4634bc4..6d3de3e 100644 --- a/R/blank_filter_class.R +++ b/R/blank_filter_class.R @@ -20,12 +20,12 @@ #' factor_name='Species', #' blank_label='setosa', #' qc_label='versicolor') -#' M = method.apply(M,D) +#' M = model.apply(M,D) #' #' @export blank_filter blank_filter<-setClass( "blank_filter", - contains = c('method'), + contains = c('model'), slots=c(params.fold_change='entity', params.blank_label='entity', params.qc_label='entity', @@ -59,7 +59,7 @@ blank_filter<-setClass( #' @export #' @template method_apply -setMethod(f="method.apply", +setMethod(f="model.apply", signature=c("blank_filter","dataset"), definition=function(M,D) { @@ -78,7 +78,7 @@ setMethod(f="method.apply", # remove the blanks. do it this way because pmp doesnt remove from class labels. RB = filter_smeta(mode='exclude',levels=opt$blank_label,factor_name=opt$factor_name) - RB=method.apply(RB,D) + RB=model.apply(RB,D) D=predicted(RB) flags=data.frame(blank_filtered$flags) diff --git a/R/classical_lsq_class.R b/R/classical_lsq_class.R index 351f5f5..464803b 100644 --- a/R/classical_lsq_class.R +++ b/R/classical_lsq_class.R @@ -17,13 +17,13 @@ #' @examples #' D = iris_dataset() #' M = classical_lsq(factor_names = 'Species') -#' M = method.apply(M,D) +#' M = model.apply(M,D) #' #' @export classical_lsq classical_lsq<-setClass( "classical_lsq", - contains='method', + contains='model', slots=c( # INPUTS params.alpha='entity.stato', @@ -73,7 +73,7 @@ classical_lsq<-setClass( #' @export #' @template method_apply -setMethod(f="method.apply", +setMethod(f="model.apply", signature=c("classical_lsq",'dataset'), definition=function(M,D) { diff --git a/R/confounders_clsq_class.R b/R/confounders_clsq_class.R index 2883f3c..dfdd1bc 100644 --- a/R/confounders_clsq_class.R +++ b/R/confounders_clsq_class.R @@ -23,12 +23,12 @@ #' factor_name='class') + # reduce to two group comparison #' confounders_clsq(factor_name = 'class', #' confounding_factors=c('sample_order','batch')) -#' M = method.apply(M,D) +#' M = model.apply(M,D) #' #' @export confounders_clsq confounders_clsq<-setClass( "confounders_clsq", - contains='method', + contains='model', slots=c( # INPUTS params.alpha='entity.stato', @@ -82,7 +82,7 @@ confounders_clsq<-setClass( #' @export #' @template method_apply -setMethod(f="method.apply", +setMethod(f="model.apply", signature=c("confounders_clsq",'dataset'), definition=function(M,D) { @@ -106,7 +106,7 @@ setMethod(f="method.apply", for (k in fn) { if (is.factor(D$sample_meta[,k])) { FF$factor_name=k - FF=method.apply(FF,D) + FF=model.apply(FF,D) excl[,k]=FF$flags$flags } else { excl[,k]=FALSE @@ -122,7 +122,7 @@ setMethod(f="method.apply", } clsq$factor_names=excl - clsq=method.apply(clsq,D) + clsq=model.apply(clsq,D) nm[i]=paste0(fn,collapse='_') temp[,i]=clsq$coefficients[,2] # first coefficient is the intercept, second is the main factor @@ -147,7 +147,7 @@ setMethod(f="method.apply", factor_names=M$confounding_factors L=apply(conf[,2:ncol(conf),drop=FALSE],1,function(x) c(M$factor_name,factor_names[x])) M2=classical_lsq(intercept=TRUE,alpha=M$alpha,mtc=M$mtc,factor_names=L) - M2=method.apply(M2,D) + M2=model.apply(M2,D) M$p_value=data.frame('ttest.p'=pvals[,1],'corrected.p'=M2$p_value[,2]) # MTC already applied names(L)=colnames(D$data) @@ -178,7 +178,7 @@ setMethod(f="method.apply", #' factor_name='class') + # reduce to two group comparison #' confounders_clsq(factor_name = 'class', #' confounding_factors=c('sample_order','batch')) -#' M = method.apply(M,D) +#' M = model.apply(M,D) #' C = C=confounders_lsq.barchart(feature_to_plot=1,threshold=15) #' chart.plot(C,M[3]) #' @@ -254,7 +254,7 @@ setMethod(f="chart.plot", #' factor_name='class') + # reduce to two group comparison #' confounders_clsq(factor_name = 'class', #' confounding_factors=c('sample_order','batch')) -#' M = method.apply(M,D) +#' M = model.apply(M,D) #' C = C=confounders_lsq.boxplot(threshold=15) #' chart.plot(C,M[3]) #' diff --git a/R/corr_coef_class.R b/R/corr_coef_class.R index c4540b8..03bdcc4 100644 --- a/R/corr_coef_class.R +++ b/R/corr_coef_class.R @@ -10,7 +10,7 @@ #' @export corr_coef corr_coef<-setClass( "corr_coef", - contains=c('method'), + contains=c('model'), slots=c( # INPUTS params.alpha='entity.stato', @@ -71,7 +71,7 @@ corr_coef<-setClass( #' @export #' @template method_apply -setMethod(f="method.apply", +setMethod(f="model.apply", signature=c("corr_coef",'dataset'), definition=function(M,D) { diff --git a/R/d_ratio_filter_class.R b/R/d_ratio_filter_class.R index 323c730..9e646d2 100644 --- a/R/d_ratio_filter_class.R +++ b/R/d_ratio_filter_class.R @@ -14,12 +14,12 @@ #' @examples #' D = sbcms_dataset() #' M = dratio_filter(threshold=20,qc_label='QC',factor_name='class') -#' M = method.apply(M,D) +#' M = model.apply(M,D) #' #' @export dratio_filter dratio_filter<-setClass( "dratio_filter", - contains = c('method'), + contains = c('model'), slots=c(params.threshold='entity', params.qc_label='entity', params.factor_name='entity', @@ -63,19 +63,19 @@ dratio_filter<-setClass( #' @export #' @template method_apply -setMethod(f="method.apply", +setMethod(f="model.apply", signature=c("dratio_filter","dataset"), definition=function(M,D) { # median QC samples QC=filter_smeta(mode='include',levels=M$qc_label,factor_name=M$factor_name) - QC = method.apply(QC,D) + QC = model.apply(QC,D) QC = predicted(QC)$data QC=apply(QC,2,mad,na.rm=TRUE) # median samples S=filter_smeta(mode='exclude',levels=M$qc_label,factor_name=M$factor_name) - S = method.apply(S,D) + S = model.apply(S,D) S = predicted(S)$data S=apply(S,2,mad,na.rm=TRUE) diff --git a/R/feature_profile_class.R b/R/feature_profile_class.R index 94cded8..c927c7b 100644 --- a/R/feature_profile_class.R +++ b/R/feature_profile_class.R @@ -57,12 +57,12 @@ setMethod(f="chart.plot", # mean of QCs FT=filter_smeta(mode='include',levels=obj$qc_label,factor_name=obj$qc_column) - FT=method.apply(FT,dobj) + FT=model.apply(FT,dobj) MQC=mean(predicted(FT)$data[,obj$feature_to_plot],na.rm=TRUE) SQC=sd(predicted(FT)$data[,obj$feature_to_plot],na.rm=TRUE) # mean of samples FT=filter_smeta(mode='exclude',levels=obj$qc_label,factor_name=obj$qc_column) - FT=method.apply(FT,dobj) + FT=model.apply(FT,dobj) MS=mean(predicted(FT)$data[,obj$feature_to_plot],na.rm=TRUE) SS=sd(predicted(FT)$data[,obj$feature_to_plot],na.rm=TRUE) diff --git a/R/filter_by_name_class.R b/R/filter_by_name_class.R index 7d9e61f..a566cec 100644 --- a/R/filter_by_name_class.R +++ b/R/filter_by_name_class.R @@ -12,12 +12,12 @@ #' @examples #' D = sbcms_dataset() #' M = filter_by_name(mode='exclude',dimension='variable',names=c(1,2,3)) -#' M = method.apply(M,D) +#' M = model.apply(M,D) #' #' @export filter_by_name filter_by_name<-setClass( "filter_by_name", - contains = c('method'), + contains = c('model'), slots=c(params.mode='entity', params.dimension='enum', params.names='entity', @@ -44,7 +44,7 @@ filter_by_name<-setClass( #' @export #' @template method_apply -setMethod(f="method.apply", +setMethod(f="model.apply", signature=c("filter_by_name","dataset"), definition=function(M,D) { diff --git a/R/filter_na_count.R b/R/filter_na_count.R index 34d4936..97c675e 100644 --- a/R/filter_na_count.R +++ b/R/filter_na_count.R @@ -8,12 +8,12 @@ #' @examples #' D = sbcms_dataset() #' M = filter_na_count(threshold=3,factor_name='class') -#' M = method.apply(M,D) +#' M = model.apply(M,D) #' #' @export filter_na_count filter_na_count<-setClass( "filter_na_count", - contains = c('method'), + contains = c('model'), slots=c(params.threshold='entity', params.factor_name='entity', outputs.filtered='entity', @@ -62,7 +62,7 @@ filter_na_count<-setClass( #' @export #' @template method_apply -setMethod(f="method.apply", +setMethod(f="model.apply", signature=c("filter_na_count","dataset"), definition=function(M,D) { diff --git a/R/filter_smeta_class.R b/R/filter_smeta_class.R index a3fd175..08f05c0 100644 --- a/R/filter_smeta_class.R +++ b/R/filter_smeta_class.R @@ -10,12 +10,12 @@ #' @examples #' D = sbcms_dataset() #' M = filter_smeta(mode='exclude',levels='QC',factor_name='QC') -#' M = method.apply(M,D) +#' M = model.apply(M,D) #' #' @export filter_smeta filter_smeta<-setClass( "filter_smeta", - contains = c('method'), + contains = c('model'), slots=c(params.mode='enum', params.levels='entity', params.factor_name='entity', @@ -48,7 +48,7 @@ filter_smeta<-setClass( #' @export #' @template method_apply -setMethod(f="method.apply", +setMethod(f="model.apply", signature=c("filter_smeta","dataset"), definition=function(M,D) { diff --git a/R/fisher_exact_class.R b/R/fisher_exact_class.R index e17150d..b340ade 100644 --- a/R/fisher_exact_class.R +++ b/R/fisher_exact_class.R @@ -20,14 +20,14 @@ #' #' # apply method #' M = fisher_exact(alpha=0.05,mtc='fdr',factor_name='class',factor_pred=pred) -#' M=method.apply(M,D) +#' M=model.apply(M,D) #' #' @import struct #' @import stats #' @export fisher_exact fisher_exact<-setClass( "fisher_exact", - contains=c('method','stato'), + contains=c('model','stato'), slots=c( # INPUTS params.alpha='entity.stato', @@ -83,7 +83,7 @@ fisher_exact<-setClass( #' @export #' @template method_apply -setMethod(f="method.apply", +setMethod(f="model.apply", signature=c("fisher_exact",'dataset'), definition=function(M,D) { diff --git a/R/fold_change_class.R b/R/fold_change_class.R index 6431df2..d94ada3 100644 --- a/R/fold_change_class.R +++ b/R/fold_change_class.R @@ -6,7 +6,7 @@ #' @examples #' D = sbcms_dataset() #' M = fold_change(factor_name='class') -#' M = method.apply(M,D) +#' M = model.apply(M,D) #' #' @param alpha confidence level to use for intervals #' @param factor_name the sample_meta column to use @@ -21,7 +21,7 @@ #' @export fold_change fold_change<-setClass( "fold_change", - contains=c('method'), + contains=c('model'), slots=c( # INPUTS params.alpha='entity.stato', @@ -86,7 +86,7 @@ fold_change<-setClass( #' @export #' @template method_apply -setMethod(f="method.apply", +setMethod(f="model.apply", signature=c("fold_change",'dataset'), definition=function(M,D) { @@ -127,12 +127,12 @@ setMethod(f="method.apply", for (B in (A+1):(length(L))) { # filter groups to A and B FG=filter_smeta(factor_name=M$factor_name,mode='include',levels=L[c(A,B)]) - FG=method.apply(FG,D) + FG=model.apply(FG,D) # change to ordered factor so that we make use of control group FG$filtered$sample_meta[[M$factor_name]]=ordered(FG$filtered$sample_meta[[M$factor_name]],levels=L[c(A,B)]) # apply t-test TT=ttest(alpha=M$alpha,mtc='none',factor_names=M$factor_name,paired=M$paired,paired_factor=M$sample_name) - TT=method.apply(TT,predicted(FG)) + TT=model.apply(TT,predicted(FG)) # log2(fold change) is the difference in estimate.mean from ttest if (M$paired) { fc=TT$estimates[,1] diff --git a/R/fold_change_int_class.R b/R/fold_change_int_class.R index 9a08d55..7b8c91a 100644 --- a/R/fold_change_int_class.R +++ b/R/fold_change_int_class.R @@ -8,7 +8,7 @@ #' D$data=D$data[,1:10,drop=FALSE] #' M = filter_smeta(mode='exclude',levels='QC',factor_name='class') + #' fold_change_int(factor_name=c('class','batch')) -#' M = method.apply(M,D) +#' M = model.apply(M,D) #' #' @param alpha confidence level to use for intervals #' @param factor_name the sample_meta column to use @@ -21,13 +21,13 @@ #' @export fold_change_int fold_change_int<-setClass( "fold_change_int", - contains=c('method','fold_change'), + contains=c('model','fold_change'), prototype = list(predicted='fold_change') ) #' @export #' @template method_apply -setMethod(f="method.apply", +setMethod(f="model.apply", signature=c("fold_change_int",'dataset'), definition=function(M,D) { @@ -48,7 +48,7 @@ setMethod(f="method.apply", k=length(FF) # interactions for all factors D$sample_meta$interaction=interaction(D$sample_meta[,FF[[k]]]) FC=fold_change(alpha=M$alpha,paired=FALSE,sample_name='NA',factor_name='interaction') - FC=method.apply(FC,D) + FC=model.apply(FC,D) #if (k==1) { M$fold_change=FC$fold_change M$upper_ci=FC$upper_ci diff --git a/R/forward_selection_by_rank_class.R b/R/forward_selection_by_rank_class.R index aa4aa23..d0d127f 100644 --- a/R/forward_selection_by_rank_class.R +++ b/R/forward_selection_by_rank_class.R @@ -20,7 +20,7 @@ #' knn_impute(neighbours=5) + #' glog_transform(qc_label='QC',factor_name='class') + #' filter_smeta(mode='exclude',levels='QC',factor_name='class') -#' P = method.apply(P,D) +#' P = model.apply(P,D) #' D = predicted(P) #' #' # forward selection using a PLSDA model @@ -204,7 +204,7 @@ eval_loess=function(x,X,Y,k=10,p=0.66) #' knn_impute(neighbours=5) + #' glog_transform(qc_label='QC',factor_name='class') + #' filter_smeta(mode='exclude',levels='QC',factor_name='class') -#' P = method.apply(P,D) +#' P = model.apply(P,D) #' D = predicted(P) #' #' # forward selection using a PLSDA model diff --git a/R/glog_class.R b/R/glog_class.R index b66eb0c..d063e8d 100644 --- a/R/glog_class.R +++ b/R/glog_class.R @@ -7,7 +7,7 @@ #' M = glog_transform() glog_transform<-setClass( "glog_transform", - contains = c('method'), + contains = c('model'), slots=c(params.qc_label='entity', params.factor_name='entity', outputs.transformed='entity', @@ -51,7 +51,7 @@ glog_transform<-setClass( #' @export #' @template method_apply -setMethod(f="method.apply", +setMethod(f="model.apply", signature=c("glog_transform","dataset"), definition=function(M,D) { diff --git a/R/hca_class.R b/R/hca_class.R index b062c19..339ca42 100644 --- a/R/hca_class.R +++ b/R/hca_class.R @@ -7,7 +7,7 @@ #' M = HCA() HCA<-setClass( "HCA", - contains=c('method'), + contains=c('model'), slots=c( # INPUTS params.dist_method='enum', @@ -51,7 +51,7 @@ HCA<-setClass( #' @export #' @template method_apply -setMethod(f="method.apply", +setMethod(f="model.apply", signature=c("HCA",'dataset'), definition=function(M,D) { diff --git a/R/knn_impute_class.R b/R/knn_impute_class.R index a3f07ef..ece70ce 100644 --- a/R/knn_impute_class.R +++ b/R/knn_impute_class.R @@ -7,7 +7,7 @@ #' M = knn_impute() knn_impute<-setClass( "knn_impute", - contains = c('method'), + contains = c('model'), slots=c(params.neighbours='entity', params.sample_max='entity', params.feature_max='entity', @@ -44,7 +44,7 @@ knn_impute<-setClass( #' @export #' @template method_apply -setMethod(f="method.apply", +setMethod(f="model.apply", signature=c("knn_impute","dataset"), definition=function(M,D) { diff --git a/R/kw_rank_sum_class.R b/R/kw_rank_sum_class.R index 99a0b0a..50d1c66 100644 --- a/R/kw_rank_sum_class.R +++ b/R/kw_rank_sum_class.R @@ -11,7 +11,7 @@ #' @export kw_rank_sum kw_rank_sum<-setClass( "kw_rank_sum", - contains=c('method'), + contains=c('model'), slots=c( # INPUTS params.alpha='entity.stato', @@ -71,7 +71,7 @@ kw_rank_sum<-setClass( #' @export #' @template method_apply -setMethod(f="method.apply", +setMethod(f="model.apply", signature=c("kw_rank_sum",'dataset'), definition=function(M,D) { diff --git a/R/log_transform.R b/R/log_transform.R index d1f40f7..93b3439 100644 --- a/R/log_transform.R +++ b/R/log_transform.R @@ -6,7 +6,7 @@ #' M = log_transform() log_transform<-setClass( "log_transform", - contains = c('method'), + contains = c('model'), slots=c(params.base='entity', outputs.transformed='entity' ), @@ -31,7 +31,7 @@ log_transform<-setClass( #' @export #' @template method_apply -setMethod(f="method.apply", +setMethod(f="model.apply", signature=c("log_transform","dataset"), definition=function(M,D) { diff --git a/R/mixed_effect_class.R b/R/mixed_effect_class.R index 12c7a69..2258a58 100644 --- a/R/mixed_effect_class.R +++ b/R/mixed_effect_class.R @@ -11,7 +11,7 @@ #' M = mixed_effect() mixed_effect<-setClass( "mixed_effect", - contains=c('method','stato','ANOVA'), # inherits ANOVA + contains=c('model','stato','ANOVA'), # inherits ANOVA prototype = list(name='Mixed effects model', description='Mixed effects model applied to each column of a dataset.', type="univariate", @@ -27,7 +27,7 @@ mixed_effect<-setClass( #' @export #' @template method_apply -setMethod(f="method.apply", +setMethod(f="model.apply", signature=c("mixed_effect",'dataset'), definition=function(M,D) { diff --git a/R/model_apply_doc.R b/R/model_apply_doc.R index bf2c525..10d914a 100644 --- a/R/model_apply_doc.R +++ b/R/model_apply_doc.R @@ -5,7 +5,7 @@ #' @param D another object used by the first #' @return Returns a modified method object #' @examples -#' M=method() -#' method.apply(M,dataset()) -#' @name method.apply +#' M=model() +#' model.apply(M,dataset()) +#' @name model.apply NULL diff --git a/R/mv_feature_filter_class.R b/R/mv_feature_filter_class.R index a2f19b8..597b0f5 100644 --- a/R/mv_feature_filter_class.R +++ b/R/mv_feature_filter_class.R @@ -7,7 +7,7 @@ #' M = mv_feature_filter() mv_feature_filter<-setClass( "mv_feature_filter", - contains = c('method'), + contains = c('model'), slots=c(params.threshold='entity', params.qc_label='entity', params.method='enum', @@ -56,7 +56,7 @@ mv_feature_filter<-setClass( #' @export #' @template method_apply -setMethod(f="method.apply", +setMethod(f="model.apply", signature=c("mv_feature_filter","dataset"), definition=function(M,D) { diff --git a/R/mv_sample_filter_class.R b/R/mv_sample_filter_class.R index 2383e13..c5e3aa0 100644 --- a/R/mv_sample_filter_class.R +++ b/R/mv_sample_filter_class.R @@ -7,7 +7,7 @@ #' C = mv_sample_filter() mv_sample_filter<-setClass( "mv_sample_filter", - contains = c('method'), + contains = c('model'), slots=c(params.mv_threshold='entity', outputs.filtered='entity', outputs.flags='entity' @@ -35,7 +35,7 @@ mv_sample_filter<-setClass( #' @export #' @template method_apply -setMethod(f="method.apply", +setMethod(f="model.apply", signature=c("mv_sample_filter","dataset"), definition=function(M,D) { diff --git a/R/pairs_filter_class.R b/R/pairs_filter_class.R index eb4769d..3367191 100644 --- a/R/pairs_filter_class.R +++ b/R/pairs_filter_class.R @@ -14,7 +14,7 @@ #' @export pairs_filter pairs_filter<-setClass( "pairs_filter", - contains = c('method'), + contains = c('model'), slots=c(params.factor_name='entity', params.fraction='entity', params.sample_id='entity', @@ -50,7 +50,7 @@ pairs_filter<-setClass( #' @export #' @template method_apply -setMethod(f="method.apply", +setMethod(f="model.apply", signature=c("pairs_filter","dataset"), definition=function(M,D) { @@ -88,7 +88,7 @@ setMethod(f="method.apply", M$flags=data.frame(flags=flags) FF=filter_by_name(mode='exclude',dimension='sample',names=as.logical(flags[,1])) - FF=method.apply(FF,D) + FF=model.apply(FF,D) M$filtered=predicted(FF) diff --git a/R/pqn_norm_method_class.R b/R/pqn_norm_method_class.R index cd308fc..8c6b522 100644 --- a/R/pqn_norm_method_class.R +++ b/R/pqn_norm_method_class.R @@ -7,7 +7,7 @@ #' M = pqn_norm() pqn_norm<-setClass( "pqn_norm", - contains = c('method'), + contains = c('model'), slots=c(params.qc_label='entity', params.factor_name='entity', outputs.normalised='entity', @@ -38,7 +38,7 @@ pqn_norm<-setClass( #' @export #' @template method_apply -setMethod(f="method.apply", +setMethod(f="model.apply", signature=c("pqn_norm","dataset"), definition=function(M,D) { diff --git a/R/prop_na_class.R b/R/prop_na_class.R index 15d3c90..85d2157 100644 --- a/R/prop_na_class.R +++ b/R/prop_na_class.R @@ -10,7 +10,7 @@ #' prop_na<-setClass( "prop_na", - contains=c('method'), + contains=c('model'), slots=c( # INPUTS params.alpha='entity.stato', @@ -66,7 +66,7 @@ prop_na<-setClass( #' @export #' @template method_apply -setMethod(f="method.apply", +setMethod(f="model.apply", signature=c("prop_na",'dataset'), definition=function(M,D) { diff --git a/R/rsd_filter.R b/R/rsd_filter.R index 0470a90..fea65e6 100644 --- a/R/rsd_filter.R +++ b/R/rsd_filter.R @@ -8,7 +8,7 @@ #' rsd_filter<-setClass( "rsd_filter", - contains = c('method'), + contains = c('model'), slots=c(params.rsd_threshold='entity', params.qc_label='entity', params.factor_name='entity', @@ -50,7 +50,7 @@ rsd_filter<-setClass( #' @export #' @template method_apply -setMethod(f="method.apply", +setMethod(f="model.apply", signature=c("rsd_filter","dataset"), definition=function(M,D) { diff --git a/R/sb_corr.R b/R/sb_corr.R index 1122241..82c5a32 100644 --- a/R/sb_corr.R +++ b/R/sb_corr.R @@ -6,7 +6,7 @@ #' M = sb_corr() sb_corr<-setClass( "sb_corr", - contains = c('method'), + contains = c('model'), slots=c( params.order_col='entity', params.batch_col='entity', @@ -72,7 +72,7 @@ sb_corr<-setClass( #' @export #' @template method_apply -setMethod(f="method.apply", +setMethod(f="model.apply", signature=c("sb_corr","dataset"), definition=function(M,D) { diff --git a/R/sbcms_dataset_class.R b/R/sbcms_dataset_class.R index 489470d..a3f1342 100644 --- a/R/sbcms_dataset_class.R +++ b/R/sbcms_dataset_class.R @@ -12,7 +12,7 @@ sbcms_dataset=function(filtered=FALSE) { if (filtered) { M = filter_by_name(mode='include',dimension='variable',names=to_filter) - M = method.apply(M,sbcms_corrected) + M = model.apply(M,sbcms_corrected) return(predicted(M)) } else { return(sbcms_corrected) diff --git a/R/split_data_class.R b/R/split_data_class.R index 00ad3d3..f8cbe4e 100644 --- a/R/split_data_class.R +++ b/R/split_data_class.R @@ -7,7 +7,7 @@ #' split_data<-setClass( "split_data", - contains = c('method'), + contains = c('model'), slots=c(params.p='entity', outputs.training='entity', outputs.testing='entity' @@ -38,7 +38,7 @@ split_data<-setClass( #' @export #' @template method_apply -setMethod(f="method.apply", +setMethod(f="model.apply", signature=c("split_data","dataset"), definition=function(M,D) { diff --git a/R/tSNE_class.R b/R/tSNE_class.R index 4088ac9..d8d5e07 100644 --- a/R/tSNE_class.R +++ b/R/tSNE_class.R @@ -8,7 +8,7 @@ #' tSNE<-setClass( "tSNE", - contains=c('method'), + contains=c('model'), slots=c( # INPUTS params.dims='numeric', @@ -40,7 +40,7 @@ tSNE<-setClass( #' @export #' @template method_apply -setMethod(f="method.apply", +setMethod(f="model.apply", signature=c("tSNE",'dataset'), definition=function(M,D) { diff --git a/R/ttest_class.R b/R/ttest_class.R index fc90bc9..be02c04 100644 --- a/R/ttest_class.R +++ b/R/ttest_class.R @@ -10,7 +10,7 @@ #' ttest<-setClass( "ttest", - contains=c('method','stato'), + contains=c('model','stato'), slots=c( # INPUTS params.alpha='entity.stato', @@ -89,7 +89,7 @@ ttest<-setClass( #' @export #' @template method_apply -setMethod(f="method.apply", +setMethod(f="model.apply", signature=c("ttest",'dataset'), definition=function(M,D) { @@ -146,7 +146,7 @@ setMethod(f="method.apply", # check number per class # if less then 2 then remove FF=filter_na_count(threshold=2,factor_name=M$factor_names) - FF=method.apply(FF,D) + FF=model.apply(FF,D) D=predicted(FF) # check equal numbers per class. if not equal then exclude. diff --git a/R/vec_norm_class.R b/R/vec_norm_class.R index aec7785..a56ef65 100644 --- a/R/vec_norm_class.R +++ b/R/vec_norm_class.R @@ -8,7 +8,7 @@ #' vec_norm<-setClass( "vec_norm", - contains = c('method'), + contains = c('model'), slots=c(outputs.normalised='entity', outputs.coeff='entity' ), @@ -31,7 +31,7 @@ vec_norm<-setClass( #' @export #' @template method_apply -setMethod(f="method.apply", +setMethod(f="model.apply", signature=c("vec_norm","dataset"), definition=function(M,D) { diff --git a/R/wilcox_test_class.R b/R/wilcox_test_class.R index ec5767c..9d9dc65 100644 --- a/R/wilcox_test_class.R +++ b/R/wilcox_test_class.R @@ -11,7 +11,7 @@ #' wilcox_test<-setClass( "wilcox_test", - contains=c('method','stato'), + contains=c('model','stato'), slots=c( # INPUTS params.alpha='entity.stato', @@ -85,7 +85,7 @@ wilcox_test<-setClass( #' @export #' @template method_apply -setMethod(f="method.apply", +setMethod(f="model.apply", signature=c("wilcox_test",'dataset'), definition=function(M,D) { @@ -142,7 +142,7 @@ setMethod(f="method.apply", # check number per class # if less then 2 then remove FF=filter_na_count(threshold=2,factor_name=M$factor_names) - FF=method.apply(FF,D) + FF=model.apply(FF,D) D=predicted(FF) # check equal numbers per class. if not equal then exclude. diff --git a/man-roxygen/method_apply.R b/man-roxygen/method_apply.R index 0f01331..1f2abf6 100644 --- a/man-roxygen/method_apply.R +++ b/man-roxygen/method_apply.R @@ -1 +1 @@ -#' @rdname method.apply +#' @rdname model.apply diff --git a/man/ANOVA-class.Rd b/man/ANOVA-class.Rd index c183ae1..98e7fac 100644 --- a/man/ANOVA-class.Rd +++ b/man/ANOVA-class.Rd @@ -21,6 +21,6 @@ Applies ANOVA to each feature in a dataset object. \examples{ D = iris_dataset() M = ANOVA(formula=y~Species) -M = method.apply(M,D) +M = model.apply(M,D) } diff --git a/man/blank_filter-class.Rd b/man/blank_filter-class.Rd index 3d5000f..9d4d93e 100644 --- a/man/blank_filter-class.Rd +++ b/man/blank_filter-class.Rd @@ -31,6 +31,6 @@ M = blank_filter(fold_change=2, factor_name='Species', blank_label='setosa', qc_label='versicolor') -M = method.apply(M,D) +M = model.apply(M,D) } diff --git a/man/classical_lsq-class.Rd b/man/classical_lsq-class.Rd index 598c7a4..d0cbad9 100644 --- a/man/classical_lsq-class.Rd +++ b/man/classical_lsq-class.Rd @@ -26,6 +26,6 @@ data column. \examples{ D = iris_dataset() M = classical_lsq(factor_names = 'Species') -M = method.apply(M,D) +M = model.apply(M,D) } diff --git a/man/confounders_clsq-class.Rd b/man/confounders_clsq-class.Rd index 97d24b2..95694ef 100644 --- a/man/confounders_clsq-class.Rd +++ b/man/confounders_clsq-class.Rd @@ -33,6 +33,6 @@ M = filter_by_name(mode='include',dimension='variable', factor_name='class') + # reduce to two group comparison confounders_clsq(factor_name = 'class', confounding_factors=c('sample_order','batch')) -M = method.apply(M,D) +M = model.apply(M,D) } diff --git a/man/confounders_lsq.barchart-class.Rd b/man/confounders_lsq.barchart-class.Rd index b260ed8..162e86c 100644 --- a/man/confounders_lsq.barchart-class.Rd +++ b/man/confounders_lsq.barchart-class.Rd @@ -24,7 +24,7 @@ M = filter_by_name(mode='include',dimension='variable', factor_name='class') + # reduce to two group comparison confounders_clsq(factor_name = 'class', confounding_factors=c('sample_order','batch')) -M = method.apply(M,D) +M = model.apply(M,D) C = C=confounders_lsq.barchart(feature_to_plot=1,threshold=15) chart.plot(C,M[3]) diff --git a/man/confounders_lsq.boxplot-class.Rd b/man/confounders_lsq.boxplot-class.Rd index aa8d5ce..1c3110d 100644 --- a/man/confounders_lsq.boxplot-class.Rd +++ b/man/confounders_lsq.boxplot-class.Rd @@ -23,7 +23,7 @@ M = filter_by_name(mode='include',dimension='variable', factor_name='class') + # reduce to two group comparison confounders_clsq(factor_name = 'class', confounding_factors=c('sample_order','batch')) -M = method.apply(M,D) +M = model.apply(M,D) C = C=confounders_lsq.boxplot(threshold=15) chart.plot(C,M[3]) diff --git a/man/dratio_filter-class.Rd b/man/dratio_filter-class.Rd index 88edff0..3c4c872 100644 --- a/man/dratio_filter-class.Rd +++ b/man/dratio_filter-class.Rd @@ -23,6 +23,6 @@ sample variance. \examples{ D = sbcms_dataset() M = dratio_filter(threshold=20,qc_label='QC',factor_name='class') -M = method.apply(M,D) +M = model.apply(M,D) } diff --git a/man/filter_by_name-class.Rd b/man/filter_by_name-class.Rd index 1f0c1f7..62fda6f 100644 --- a/man/filter_by_name-class.Rd +++ b/man/filter_by_name-class.Rd @@ -21,6 +21,6 @@ a filter to subsample a dataset object based on sample or feature labels. \examples{ D = sbcms_dataset() M = filter_by_name(mode='exclude',dimension='variable',names=c(1,2,3)) -M = method.apply(M,D) +M = model.apply(M,D) } diff --git a/man/filter_na_count-class.Rd b/man/filter_na_count-class.Rd index 84c5ce5..00c0bcc 100644 --- a/man/filter_na_count-class.Rd +++ b/man/filter_na_count-class.Rd @@ -16,6 +16,6 @@ Filters features by the number of NA per class \examples{ D = sbcms_dataset() M = filter_na_count(threshold=3,factor_name='class') -M = method.apply(M,D) +M = model.apply(M,D) } diff --git a/man/filter_smeta-class.Rd b/man/filter_smeta-class.Rd index 476914d..0c30d39 100644 --- a/man/filter_smeta-class.Rd +++ b/man/filter_smeta-class.Rd @@ -19,6 +19,6 @@ A filter to subset a dataset object based on sample meta data. \examples{ D = sbcms_dataset() M = filter_smeta(mode='exclude',levels='QC',factor_name='QC') -M = method.apply(M,D) +M = model.apply(M,D) } diff --git a/man/fisher_exact-class.Rd b/man/fisher_exact-class.Rd index d3a9f9b..f9df43f 100644 --- a/man/fisher_exact-class.Rd +++ b/man/fisher_exact-class.Rd @@ -30,6 +30,6 @@ pred=as.data.frame(pred) # apply method M = fisher_exact(alpha=0.05,mtc='fdr',factor_name='class',factor_pred=pred) -M=method.apply(M,D) +M=model.apply(M,D) } diff --git a/man/fold_change-class.Rd b/man/fold_change-class.Rd index e20bef9..9e329ce 100644 --- a/man/fold_change-class.Rd +++ b/man/fold_change-class.Rd @@ -26,6 +26,6 @@ a log transform and t-test. \examples{ D = sbcms_dataset() M = fold_change(factor_name='class') -M = method.apply(M,D) +M = model.apply(M,D) } diff --git a/man/fold_change_int-class.Rd b/man/fold_change_int-class.Rd index 0b8c13c..460fa5b 100644 --- a/man/fold_change_int-class.Rd +++ b/man/fold_change_int-class.Rd @@ -24,6 +24,6 @@ D = sbcms_dataset() D$data=D$data[,1:10,drop=FALSE] M = filter_smeta(mode='exclude',levels='QC',factor_name='class') + fold_change_int(factor_name=c('class','batch')) -M = method.apply(M,D) +M = model.apply(M,D) } diff --git a/man/forward_selection_byrank-class.Rd b/man/forward_selection_byrank-class.Rd index fa2d7c1..a223102 100644 --- a/man/forward_selection_byrank-class.Rd +++ b/man/forward_selection_byrank-class.Rd @@ -31,7 +31,7 @@ P = pqn_norm(qc_label='QC',factor_name='class') + knn_impute(neighbours=5) + glog_transform(qc_label='QC',factor_name='class') + filter_smeta(mode='exclude',levels='QC',factor_name='class') -P = method.apply(P,D) +P = model.apply(P,D) D = predicted(P) # forward selection using a PLSDA model diff --git a/man/fs_line-class.Rd b/man/fs_line-class.Rd index 33a6a42..503c575 100644 --- a/man/fs_line-class.Rd +++ b/man/fs_line-class.Rd @@ -18,7 +18,7 @@ P = pqn_norm(qc_label='QC',factor_name='class') + knn_impute(neighbours=5) + glog_transform(qc_label='QC',factor_name='class') + filter_smeta(mode='exclude',levels='QC',factor_name='class') -P = method.apply(P,D) +P = model.apply(P,D) D = predicted(P) # forward selection using a PLSDA model diff --git a/man/method.apply.Rd b/man/method.apply.Rd deleted file mode 100644 index 6cb8c64..0000000 --- a/man/method.apply.Rd +++ /dev/null @@ -1,132 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/anova_class.R, R/HSD_class.R, -% R/mixed_effect_class.R, R/HSDEM_class.R, R/fold_change_class.R, -% R/PLSFC_class.R, R/blank_filter_class.R, R/classical_lsq_class.R, -% R/confounders_clsq_class.R, R/corr_coef_class.R, R/d_ratio_filter_class.R, -% R/filter_by_name_class.R, R/filter_na_count.R, R/filter_smeta_class.R, -% R/fisher_exact_class.R, R/fold_change_int_class.R, R/glog_class.R, -% R/hca_class.R, R/knn_impute_class.R, R/kw_rank_sum_class.R, -% R/log_transform.R, R/model_apply_doc.R, R/mv_feature_filter_class.R, -% R/mv_sample_filter_class.R, R/pairs_filter_class.R, -% R/pqn_norm_method_class.R, R/prop_na_class.R, R/rsd_filter.R, R/sb_corr.R, -% R/split_data_class.R, R/tSNE_class.R, R/ttest_class.R, R/vec_norm_class.R, -% R/wilcox_test_class.R -\docType{methods} -\name{method.apply,ANOVA,dataset-method} -\alias{method.apply,ANOVA,dataset-method} -\alias{method.apply,HSD,dataset-method} -\alias{method.apply,mixed_effect,dataset-method} -\alias{method.apply,HSDEM,dataset-method} -\alias{method.apply,fold_change,dataset-method} -\alias{method.apply,PLSFC,dataset-method} -\alias{method.apply,blank_filter,dataset-method} -\alias{method.apply,classical_lsq,dataset-method} -\alias{method.apply,confounders_clsq,dataset-method} -\alias{method.apply,corr_coef,dataset-method} -\alias{method.apply,dratio_filter,dataset-method} -\alias{method.apply,filter_by_name,dataset-method} -\alias{method.apply,filter_na_count,dataset-method} -\alias{method.apply,filter_smeta,dataset-method} -\alias{method.apply,fisher_exact,dataset-method} -\alias{method.apply,fold_change_int,dataset-method} -\alias{method.apply,glog_transform,dataset-method} -\alias{method.apply,HCA,dataset-method} -\alias{method.apply,knn_impute,dataset-method} -\alias{method.apply,kw_rank_sum,dataset-method} -\alias{method.apply,log_transform,dataset-method} -\alias{method.apply} -\alias{method.apply,mv_feature_filter,dataset-method} -\alias{method.apply,mv_sample_filter,dataset-method} -\alias{method.apply,pairs_filter,dataset-method} -\alias{method.apply,pqn_norm,dataset-method} -\alias{method.apply,prop_na,dataset-method} -\alias{method.apply,rsd_filter,dataset-method} -\alias{method.apply,sb_corr,dataset-method} -\alias{method.apply,split_data,dataset-method} -\alias{method.apply,tSNE,dataset-method} -\alias{method.apply,ttest,dataset-method} -\alias{method.apply,vec_norm,dataset-method} -\alias{method.apply,wilcox_test,dataset-method} -\title{Apply method} -\usage{ -\S4method{method.apply}{ANOVA,dataset}(M, D) - -\S4method{method.apply}{HSD,dataset}(M, D) - -\S4method{method.apply}{mixed_effect,dataset}(M, D) - -\S4method{method.apply}{HSDEM,dataset}(M, D) - -\S4method{method.apply}{fold_change,dataset}(M, D) - -\S4method{method.apply}{PLSFC,dataset}(M, D) - -\S4method{method.apply}{blank_filter,dataset}(M, D) - -\S4method{method.apply}{classical_lsq,dataset}(M, D) - -\S4method{method.apply}{confounders_clsq,dataset}(M, D) - -\S4method{method.apply}{corr_coef,dataset}(M, D) - -\S4method{method.apply}{dratio_filter,dataset}(M, D) - -\S4method{method.apply}{filter_by_name,dataset}(M, D) - -\S4method{method.apply}{filter_na_count,dataset}(M, D) - -\S4method{method.apply}{filter_smeta,dataset}(M, D) - -\S4method{method.apply}{fisher_exact,dataset}(M, D) - -\S4method{method.apply}{fold_change_int,dataset}(M, D) - -\S4method{method.apply}{glog_transform,dataset}(M, D) - -\S4method{method.apply}{HCA,dataset}(M, D) - -\S4method{method.apply}{knn_impute,dataset}(M, D) - -\S4method{method.apply}{kw_rank_sum,dataset}(M, D) - -\S4method{method.apply}{log_transform,dataset}(M, D) - -\S4method{method.apply}{mv_feature_filter,dataset}(M, D) - -\S4method{method.apply}{mv_sample_filter,dataset}(M, D) - -\S4method{method.apply}{pairs_filter,dataset}(M, D) - -\S4method{method.apply}{pqn_norm,dataset}(M, D) - -\S4method{method.apply}{prop_na,dataset}(M, D) - -\S4method{method.apply}{rsd_filter,dataset}(M, D) - -\S4method{method.apply}{sb_corr,dataset}(M, D) - -\S4method{method.apply}{split_data,dataset}(M, D) - -\S4method{method.apply}{tSNE,dataset}(M, D) - -\S4method{method.apply}{ttest,dataset}(M, D) - -\S4method{method.apply}{vec_norm,dataset}(M, D) - -\S4method{method.apply}{wilcox_test,dataset}(M, D) -} -\arguments{ -\item{M}{a method object} - -\item{D}{another object used by the first} -} -\value{ -Returns a modified method object -} -\description{ -Applies method to the input dataset -} -\examples{ -M=method() -method.apply(M,dataset()) -} diff --git a/man/model.apply.Rd b/man/model.apply.Rd new file mode 100644 index 0000000..b18b13c --- /dev/null +++ b/man/model.apply.Rd @@ -0,0 +1,132 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/anova_class.R, R/HSD_class.R, +% R/mixed_effect_class.R, R/HSDEM_class.R, R/fold_change_class.R, +% R/PLSFC_class.R, R/blank_filter_class.R, R/classical_lsq_class.R, +% R/confounders_clsq_class.R, R/corr_coef_class.R, R/d_ratio_filter_class.R, +% R/filter_by_name_class.R, R/filter_na_count.R, R/filter_smeta_class.R, +% R/fisher_exact_class.R, R/fold_change_int_class.R, R/glog_class.R, +% R/hca_class.R, R/knn_impute_class.R, R/kw_rank_sum_class.R, +% R/log_transform.R, R/model_apply_doc.R, R/mv_feature_filter_class.R, +% R/mv_sample_filter_class.R, R/pairs_filter_class.R, +% R/pqn_norm_method_class.R, R/prop_na_class.R, R/rsd_filter.R, R/sb_corr.R, +% R/split_data_class.R, R/tSNE_class.R, R/ttest_class.R, R/vec_norm_class.R, +% R/wilcox_test_class.R +\docType{methods} +\name{model.apply,ANOVA,dataset-method} +\alias{model.apply,ANOVA,dataset-method} +\alias{model.apply,HSD,dataset-method} +\alias{model.apply,mixed_effect,dataset-method} +\alias{model.apply,HSDEM,dataset-method} +\alias{model.apply,fold_change,dataset-method} +\alias{model.apply,PLSFC,dataset-method} +\alias{model.apply,blank_filter,dataset-method} +\alias{model.apply,classical_lsq,dataset-method} +\alias{model.apply,confounders_clsq,dataset-method} +\alias{model.apply,corr_coef,dataset-method} +\alias{model.apply,dratio_filter,dataset-method} +\alias{model.apply,filter_by_name,dataset-method} +\alias{model.apply,filter_na_count,dataset-method} +\alias{model.apply,filter_smeta,dataset-method} +\alias{model.apply,fisher_exact,dataset-method} +\alias{model.apply,fold_change_int,dataset-method} +\alias{model.apply,glog_transform,dataset-method} +\alias{model.apply,HCA,dataset-method} +\alias{model.apply,knn_impute,dataset-method} +\alias{model.apply,kw_rank_sum,dataset-method} +\alias{model.apply,log_transform,dataset-method} +\alias{model.apply} +\alias{model.apply,mv_feature_filter,dataset-method} +\alias{model.apply,mv_sample_filter,dataset-method} +\alias{model.apply,pairs_filter,dataset-method} +\alias{model.apply,pqn_norm,dataset-method} +\alias{model.apply,prop_na,dataset-method} +\alias{model.apply,rsd_filter,dataset-method} +\alias{model.apply,sb_corr,dataset-method} +\alias{model.apply,split_data,dataset-method} +\alias{model.apply,tSNE,dataset-method} +\alias{model.apply,ttest,dataset-method} +\alias{model.apply,vec_norm,dataset-method} +\alias{model.apply,wilcox_test,dataset-method} +\title{Apply method} +\usage{ +\S4method{model.apply}{ANOVA,dataset}(M, D) + +\S4method{model.apply}{HSD,dataset}(M, D) + +\S4method{model.apply}{mixed_effect,dataset}(M, D) + +\S4method{model.apply}{HSDEM,dataset}(M, D) + +\S4method{model.apply}{fold_change,dataset}(M, D) + +\S4method{model.apply}{PLSFC,dataset}(M, D) + +\S4method{model.apply}{blank_filter,dataset}(M, D) + +\S4method{model.apply}{classical_lsq,dataset}(M, D) + +\S4method{model.apply}{confounders_clsq,dataset}(M, D) + +\S4method{model.apply}{corr_coef,dataset}(M, D) + +\S4method{model.apply}{dratio_filter,dataset}(M, D) + +\S4method{model.apply}{filter_by_name,dataset}(M, D) + +\S4method{model.apply}{filter_na_count,dataset}(M, D) + +\S4method{model.apply}{filter_smeta,dataset}(M, D) + +\S4method{model.apply}{fisher_exact,dataset}(M, D) + +\S4method{model.apply}{fold_change_int,dataset}(M, D) + +\S4method{model.apply}{glog_transform,dataset}(M, D) + +\S4method{model.apply}{HCA,dataset}(M, D) + +\S4method{model.apply}{knn_impute,dataset}(M, D) + +\S4method{model.apply}{kw_rank_sum,dataset}(M, D) + +\S4method{model.apply}{log_transform,dataset}(M, D) + +\S4method{model.apply}{mv_feature_filter,dataset}(M, D) + +\S4method{model.apply}{mv_sample_filter,dataset}(M, D) + +\S4method{model.apply}{pairs_filter,dataset}(M, D) + +\S4method{model.apply}{pqn_norm,dataset}(M, D) + +\S4method{model.apply}{prop_na,dataset}(M, D) + +\S4method{model.apply}{rsd_filter,dataset}(M, D) + +\S4method{model.apply}{sb_corr,dataset}(M, D) + +\S4method{model.apply}{split_data,dataset}(M, D) + +\S4method{model.apply}{tSNE,dataset}(M, D) + +\S4method{model.apply}{ttest,dataset}(M, D) + +\S4method{model.apply}{vec_norm,dataset}(M, D) + +\S4method{model.apply}{wilcox_test,dataset}(M, D) +} +\arguments{ +\item{M}{a method object} + +\item{D}{another object used by the first} +} +\value{ +Returns a modified method object +} +\description{ +Applies method to the input dataset +} +\examples{ +M=model() +model.apply(M,dataset()) +} diff --git a/tests/testthat/test-anova.R b/tests/testthat/test-anova.R index fa49b4e..5dd3903 100644 --- a/tests/testthat/test-anova.R +++ b/tests/testthat/test-anova.R @@ -4,7 +4,7 @@ test_that('anova 1way',{ D=iris_dataset() # method ME=ANOVA(formula=y~Species) - ME=method.apply(ME,D) + ME=model.apply(ME,D) # expect all true expect_true(all(ME$significant[,1])) @@ -17,7 +17,7 @@ test_that('anova 2way',{ D$sample_meta$fake_news=sample(D$sample_meta$Species,150,replace=FALSE) # method ME=ANOVA(formula=y~Species*fake_news) - ME=method.apply(ME,D) + ME=model.apply(ME,D) # expect all true expect_true(all(ME$significant[,1])) @@ -30,7 +30,7 @@ test_that('hsd 1 factor',{ D=iris_dataset() # method ME=HSD(formula=y~Species) - ME=method.apply(ME,D) + ME=model.apply(ME,D) # expect all true expect_true(all(ME$significant[,1])) @@ -44,7 +44,7 @@ test_that('hsd 2 factors',{ D$sample_meta$fake_news=sample(D$sample_meta$Species,150,replace=FALSE) # method ME=HSD(formula=y~Species*fake_news) - ME=method.apply(ME,D) + ME=model.apply(ME,D) # expect all true expect_true(all(ME$significant[,1])) }) diff --git a/tests/testthat/test-blank-filter.R b/tests/testthat/test-blank-filter.R index f29b684..9ac3770 100644 --- a/tests/testthat/test-blank-filter.R +++ b/tests/testthat/test-blank-filter.R @@ -6,7 +6,7 @@ test_that('blank filter',{ # method M = blank_filter(blank_label='versicolor',qc_label='virginica',fold_change=1,factor_name='Species') # apply - M=method.apply(M,D) + M=model.apply(M,D) expect_true(all(M$flags$blank_flags==1)) expect_true(all(M$flags$blank_fraction_flags==1)) }) @@ -18,7 +18,7 @@ test_that('blank filter histogram',{ # method M = blank_filter(blank_label='versicolor',qc_label='virginica',fold_change=1,factor_name='Species') # apply - M=method.apply(M,D) + M=model.apply(M,D) # chart C = blank_filter.hist() gg=chart.plot(C,M) diff --git a/tests/testthat/test-confounders-lsq.R b/tests/testthat/test-confounders-lsq.R index 46d9775..675228a 100644 --- a/tests/testthat/test-confounders-lsq.R +++ b/tests/testthat/test-confounders-lsq.R @@ -6,7 +6,7 @@ test_that('confounders lsq',{ D$sample_meta$Rnd=sample(D$sample_meta$Species,150) # random effect # method ME=confounders_clsq(factor_name='Species',confounding_factors='Rnd',threshold=0.15) - ME=method.apply(ME,D) + ME=model.apply(ME,D) # expect all true expect_true(all(as.matrix(ME$significant))) @@ -21,7 +21,7 @@ test_that('confounders lsq barchart',{ D$sample_meta$Rnd=sample(D$sample_meta$Species,150) # random effect # method ME=confounders_clsq(factor_name='Species',confounding_factors='Rnd',threshold=0.15) - ME=method.apply(ME,D) + ME=model.apply(ME,D) # chart C=confounders_lsq.barchart(feature_to_plot='Petal.Length') gg=chart.plot(C,ME) @@ -38,7 +38,7 @@ test_that('confounders lsq boxplot',{ D$sample_meta$Rnd=sample(D$sample_meta$Species,150) # random effect # method ME=confounders_clsq(factor_name='Species',confounding_factors='Rnd',threshold=0.15) - ME=method.apply(ME,D) + ME=model.apply(ME,D) # chart C=confounders_lsq.boxplot() gg=chart.plot(C,ME) diff --git a/tests/testthat/test-filter-by-name.R b/tests/testthat/test-filter-by-name.R index fc0c978..fac6a54 100644 --- a/tests/testthat/test-filter-by-name.R +++ b/tests/testthat/test-filter-by-name.R @@ -6,7 +6,7 @@ test_that('filter by name, exclude samples',{ # method M = filter_by_name(mode='exclude',dimension='sample',names=c('1','2','3')) # apply - M=method.apply(M,D) + M=model.apply(M,D) expect_equal(nrow(M$filtered$data),147) }) @@ -17,7 +17,7 @@ test_that('filter by name, include samples',{ # method M = filter_by_name(mode='include',dimension='sample',names=c('1','2','3')) # apply - M=method.apply(M,D) + M=model.apply(M,D) expect_equal(nrow(M$filtered$data),3) }) @@ -28,7 +28,7 @@ test_that('filter by name, exclude variables',{ # method M = filter_by_name(mode='exclude',dimension='variable',names=c('Petal.Width','Petal.Length')) # apply - M=method.apply(M,D) + M=model.apply(M,D) expect_equal(ncol(M$filtered$data),2) }) @@ -39,6 +39,6 @@ test_that('filter by name, include variables',{ # method M = filter_by_name(mode='include',dimension='variable',names=c('Petal.Width','Petal.Length')) # apply - M=method.apply(M,D) + M=model.apply(M,D) expect_equal(ncol(M$filtered$data),2) }) diff --git a/tests/testthat/test-filter-smeta.R b/tests/testthat/test-filter-smeta.R index 280470e..3c04a21 100644 --- a/tests/testthat/test-filter-smeta.R +++ b/tests/testthat/test-filter-smeta.R @@ -6,7 +6,7 @@ test_that('filter smeta include',{ # method M = filter_smeta(mode='include',levels='versicolor',factor_name='Species') # apply - M = method.apply(M,D) + M = model.apply(M,D) expect_equal(nrow(M$filtered$data),50) }) @@ -17,6 +17,6 @@ test_that('filter smeta exclude',{ # method M = filter_smeta(mode='exclude',levels='versicolor',factor_name='Species') # apply - M = method.apply(M,D) + M = model.apply(M,D) expect_equal(nrow(M$filtered$data),100) }) diff --git a/tests/testthat/test-fisher-exact.R b/tests/testthat/test-fisher-exact.R index 5a1abe4..e8df12c 100644 --- a/tests/testthat/test-fisher-exact.R +++ b/tests/testthat/test-fisher-exact.R @@ -10,6 +10,6 @@ test_that('ttest',{ # method M = fisher_exact(factor_name='Species',factor_pred=pred) # apply - M = method.apply(M,D) + M = model.apply(M,D) expect_true(all(M$significant)) }) diff --git a/tests/testthat/test-glog.R b/tests/testthat/test-glog.R index 466fd9e..f4d53e5 100644 --- a/tests/testthat/test-glog.R +++ b/tests/testthat/test-glog.R @@ -6,6 +6,6 @@ test_that('glog',{ # method M = glog_transform(qc_label='setosa',factor_name='Species') # apply - M = method.apply(M,D) + M = model.apply(M,D) expect_equal(M$transformed$data[1,1],2.31,tolerance=0.05) }) diff --git a/tests/testthat/test-knn-impute.R b/tests/testthat/test-knn-impute.R index 9ffe153..ea5659b 100644 --- a/tests/testthat/test-knn-impute.R +++ b/tests/testthat/test-knn-impute.R @@ -7,7 +7,7 @@ test_that('knn impute',{ # method M = knn_impute(neighbours=5) # apply - M = method.apply(M,D) + M = model.apply(M,D) # expect_equal(M$imputed$data[5,1],5.2,tolerance=0.001) # an imputed value expect_equal(M$imputed$data[5,1],1.12,tolerance=0.001) # an imputed value }) diff --git a/tests/testthat/test-log-transform.R b/tests/testthat/test-log-transform.R index 65e1304..2d5c42d 100644 --- a/tests/testthat/test-log-transform.R +++ b/tests/testthat/test-log-transform.R @@ -6,6 +6,6 @@ test_that('log',{ # method M = log_transform() # apply - M = method.apply(M,D) + M = model.apply(M,D) expect_equal(M$transformed$data[1,1],0.707,tolerance=0.001) }) diff --git a/tests/testthat/test-mixed-effects.R b/tests/testthat/test-mixed-effects.R index 099d09b..d7a37a6 100644 --- a/tests/testthat/test-mixed-effects.R +++ b/tests/testthat/test-mixed-effects.R @@ -7,7 +7,7 @@ test_that('mixed effects',{ D$sample_meta$Rnd=rnorm(150) # random effect # method ME=mixed_effect(formula=y~Species+Error(Rnd/Species)) - ME=method.apply(ME,D) + ME=model.apply(ME,D) # expect all true expect_true(all(ME$significant[,1])) @@ -22,7 +22,7 @@ test_that('hsdem',{ D$sample_meta$Rnd=rnorm(150) # random effect # method ME=HSDEM(formula=y~Species+Error(Rnd/Species)) - ME=method.apply(ME,D) + ME=model.apply(ME,D) # expect all true expect_true(all(ME$significant[,1])) diff --git a/tests/testthat/test-mv-feature-filter.R b/tests/testthat/test-mv-feature-filter.R index 2436bfb..a482afe 100644 --- a/tests/testthat/test-mv-feature-filter.R +++ b/tests/testthat/test-mv-feature-filter.R @@ -7,7 +7,7 @@ test_that('pmp mv_feature within_all',{ # filter FF=mv_feature_filter(qc_label='versicolor',method='within_all',factor_name='Species') - FF=method.apply(FF,D) + FF=model.apply(FF,D) expect_equal(ncol(FF$filtered$data),3) }) @@ -19,7 +19,7 @@ test_that('pmp mv_feature within_one',{ # filter FF=mv_feature_filter(qc_label='versicolor',method='within_one',factor_name='Species') - FF=method.apply(FF,D) + FF=model.apply(FF,D) expect_equal(ncol(FF$filtered$data),3) }) @@ -31,7 +31,7 @@ test_that('pmp mv_feature across',{ # filter FF=mv_feature_filter(qc_label='versicolor',method='across',factor_name='Species') - FF=method.apply(FF,D) + FF=model.apply(FF,D) expect_equal(ncol(FF$filtered$data),3) }) @@ -43,7 +43,7 @@ test_that('pmp mv_feature qc',{ # filter FF=mv_feature_filter(qc_label='versicolor',method='QC',factor_name='Species') - FF=method.apply(FF,D) + FF=model.apply(FF,D) expect_equal(ncol(FF$filtered$data),3) }) @@ -59,7 +59,7 @@ test_that('pmp mv_feature_plot', { # filter FF=mv_feature_filter(qc_label='versicolor',method='across',factor_name='Species') - FF=method.apply(FF,D) + FF=model.apply(FF,D) C=mv_feature_filter.hist() gg=chart.plot(C,FF) expect_true(is(gg,'ggplot')) diff --git a/tests/testthat/test-mv-sample-filter.R b/tests/testthat/test-mv-sample-filter.R index 04b3803..146af28 100644 --- a/tests/testthat/test-mv-sample-filter.R +++ b/tests/testthat/test-mv-sample-filter.R @@ -7,7 +7,7 @@ test_that('mv_sample_filter',{ # method M = mv_sample_filter(mv_threshold=50) # apply - M=method.apply(M,D) + M=model.apply(M,D) expect_equal(nrow(M$filtered$data),147) }) @@ -19,7 +19,7 @@ test_that('mv_sample_filter plot',{ # method M = mv_sample_filter(mv_threshold=50) # apply - M=method.apply(M,D) + M=model.apply(M,D) # chart C = mv_sample_filter.hist() gg=chart.plot(C,M) diff --git a/tests/testthat/test-pqn-norm.R b/tests/testthat/test-pqn-norm.R index 466bf82..f5b8cc7 100644 --- a/tests/testthat/test-pqn-norm.R +++ b/tests/testthat/test-pqn-norm.R @@ -6,7 +6,7 @@ test_that('pqn norm',{ # method M = pqn_norm(qc_label='versicolor',factor_name='Species') # apply - M = method.apply(M,D) + M = model.apply(M,D) expect_equal(M$coeff[1,1],0.59,tolerance=0.005) }) @@ -17,7 +17,7 @@ test_that('pqn norm hist',{ # method M = pqn_norm(qc_label='versicolor',factor_name='Species') # apply - M = method.apply(M,D) + M = model.apply(M,D) #chart C = pqn_norm.hist() gg=chart.plot(C,M) diff --git a/tests/testthat/test-prop-na.R b/tests/testthat/test-prop-na.R index 2053687..6e99fb2 100644 --- a/tests/testthat/test-prop-na.R +++ b/tests/testthat/test-prop-na.R @@ -7,7 +7,7 @@ test_that('prop_na',{ # method M = prop_na(factor_name='Species') # apply - M=method.apply(M,D) + M=model.apply(M,D) expect_true(all(M$significant[,1])) expect_true(all(M$na_count$versicolor==50)) }) diff --git a/tests/testthat/test-rsd-filter.R b/tests/testthat/test-rsd-filter.R index 30c408f..e1f4dda 100644 --- a/tests/testthat/test-rsd-filter.R +++ b/tests/testthat/test-rsd-filter.R @@ -6,7 +6,7 @@ test_that('rsd filter',{ # method M = rsd_filter(qc_label='virginica',factor_name='Species',rsd_threshold=100) # apply - M=method.apply(M,D) + M=model.apply(M,D) expect_true(all(M$flags$rsd_flags==1)) }) @@ -17,7 +17,7 @@ test_that('blank filter histogram',{ # method M = rsd_filter(qc_label='virginica',factor_name='Species',rsd_threshold=100) # apply - M=method.apply(M,D) + M=model.apply(M,D) # chart C = rsd_filter.hist() gg=chart.plot(C,M) diff --git a/tests/testthat/test-split-data.R b/tests/testthat/test-split-data.R index 4ae68c4..51cce18 100644 --- a/tests/testthat/test-split-data.R +++ b/tests/testthat/test-split-data.R @@ -6,7 +6,7 @@ test_that('split data',{ # method M = split_data() # apply - M = method.apply(M,D) + M = model.apply(M,D) expect_equal(nrow(M$testing$data),38) expect_equal(nrow(M$training$data),112) }) diff --git a/tests/testthat/test-ttest.R b/tests/testthat/test-ttest.R index a2543b9..61f8cb9 100644 --- a/tests/testthat/test-ttest.R +++ b/tests/testthat/test-ttest.R @@ -7,7 +7,7 @@ test_that('ttest',{ M = filter_smeta(mode='exclude',levels='versicolor',factor_name='Species')+ # need two groups for ttest ttest(factor_names='Species') # apply - M = method.apply(M,D) + M = model.apply(M,D) expect_equal(M[2]$t_statistic[1],-15.386,tolerance=0.0005) }) diff --git a/tests/testthat/test-vec-norm.R b/tests/testthat/test-vec-norm.R index 1adfc20..a40dc08 100644 --- a/tests/testthat/test-vec-norm.R +++ b/tests/testthat/test-vec-norm.R @@ -6,6 +6,6 @@ test_that('vecnorm',{ # method M = vec_norm() # apply - M = method.apply(M,D) + M = model.apply(M,D) expect_equal(M$normalised$data[1,1],0.172,tolerance=0.001) }) From 505912d3f37eaff6df22226f34ce3debd0da38c4 Mon Sep 17 00:00:00 2001 From: grlloyd Date: Mon, 14 Oct 2019 11:00:53 +0100 Subject: [PATCH 2/9] pin struct version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 25b3edd..cad3d39 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -101,7 +101,7 @@ Suggests: sbcms, Rtsne Remotes: computational-metabolomics/pmp, - computational-metabolomics/struct, + computational-metabolomics/struct#4bc5702, computational-metabolomics/sbcms VignetteBuilder: knitr biocViews: WorkflowStep From 7ce936437956c253885089746959aaf27722cded Mon Sep 17 00:00:00 2001 From: grlloyd Date: Mon, 14 Oct 2019 11:07:10 +0100 Subject: [PATCH 3/9] pin struct version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index cad3d39..5dac077 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -101,7 +101,7 @@ Suggests: sbcms, Rtsne Remotes: computational-metabolomics/pmp, - computational-metabolomics/struct#4bc5702, + computational-metabolomics/struct@4bc5702, computational-metabolomics/sbcms VignetteBuilder: knitr biocViews: WorkflowStep From c1de026495c5f4bb580cc56af38ca5a03807ba18 Mon Sep 17 00:00:00 2001 From: grlloyd Date: Mon, 14 Oct 2019 16:22:55 +0100 Subject: [PATCH 4/9] change to use train/predict and apply update due to removal of methods class from struct base --- R/HSDEM_class.R | 2 +- R/HSD_class.R | 2 +- R/PLSFC_class.R | 2 +- R/anova_class.R | 2 +- R/blank_filter_class.R | 34 +- R/classical_lsq_class.R | 2 +- R/confounders_clsq_class.R | 2 +- R/corr_coef_class.R | 2 +- R/d_ratio_filter_class.R | 19 +- R/filter_by_name_class.R | 24 +- R/filter_na_count.R | 24 +- R/filter_smeta_class.R | 18 +- R/fisher_exact_class.R | 2 +- R/fold_change_class.R | 2 +- R/fold_change_int_class.R | 2 +- R/glog_class.R | 2 +- R/hca_class.R | 2 +- R/knn_impute_class.R | 2 +- R/kw_rank_sum_class.R | 2 +- R/log_transform.R | 2 +- R/mixed_effect_class.R | 2 +- R/mv_feature_filter_class.R | 31 +- R/mv_sample_filter_class.R | 23 +- R/pairs_filter_class.R | 20 +- R/pqn_norm_method_class.R | 2 +- R/prop_na_class.R | 2 +- R/rsd_filter.R | 2 +- R/sb_corr.R | 2 +- R/split_data_class.R | 2 +- R/tSNE_class.R | 2 +- R/ttest_class.R | 2 +- R/vec_norm_class.R | 20 +- R/wilcox_test_class.R | 2 +- man-roxygen/{method_apply.R => model_apply.R} | 0 man/model.apply.Rd | 28 +- man/model.predict.Rd | 30 +- man/model.train.Rd | 34 +- vignettes/iterator_example.R | 47 + vignettes/iterator_example.html | 1925 +++++++++++++++++ vignettes/model_example.R | 72 + 40 files changed, 2315 insertions(+), 82 deletions(-) rename man-roxygen/{method_apply.R => model_apply.R} (100%) create mode 100644 vignettes/iterator_example.R create mode 100644 vignettes/iterator_example.html create mode 100644 vignettes/model_example.R diff --git a/R/HSDEM_class.R b/R/HSDEM_class.R index 9986391..51f46b3 100644 --- a/R/HSDEM_class.R +++ b/R/HSDEM_class.R @@ -60,7 +60,7 @@ HSDEM<-setClass( ) #' @export -#' @template method_apply +#' @template model_apply setMethod(f="model.apply", signature=c("HSDEM",'dataset'), definition=function(M,D) { diff --git a/R/HSD_class.R b/R/HSD_class.R index a9d1813..a82fd41 100644 --- a/R/HSD_class.R +++ b/R/HSD_class.R @@ -70,7 +70,7 @@ HSD<-setClass( ) #' @export -#' @template method_apply +#' @template model_apply setMethod(f="model.apply", signature=c("HSD",'dataset'), definition=function(M,D) { diff --git a/R/PLSFC_class.R b/R/PLSFC_class.R index 1e81569..97620f2 100644 --- a/R/PLSFC_class.R +++ b/R/PLSFC_class.R @@ -20,7 +20,7 @@ PLSFC<-setClass( ) #' @export -#' @template method_apply +#' @template model_apply setMethod(f="model.apply", signature=c("PLSFC",'dataset'), definition=function(M,D) { diff --git a/R/anova_class.R b/R/anova_class.R index 7cc82f5..6028b44 100644 --- a/R/anova_class.R +++ b/R/anova_class.R @@ -58,7 +58,7 @@ ANOVA<-setClass( #' @export -#' @template method_apply +#' @template model_apply setMethod(f="model.apply", signature=c("ANOVA",'dataset'), definition=function(M,D) diff --git a/R/blank_filter_class.R b/R/blank_filter_class.R index 6d3de3e..c469afe 100644 --- a/R/blank_filter_class.R +++ b/R/blank_filter_class.R @@ -58,41 +58,49 @@ blank_filter<-setClass( ) #' @export -#' @template method_apply -setMethod(f="model.apply", +#' @template model_train +setMethod(f="model.train", signature=c("blank_filter","dataset"), definition=function(M,D) { - opt=param.list(M) smeta=dataset.sample_meta(D) x=dataset.data(D) # remove = NULL does not remove blanks. ANY VALUE removes blanks. - blank_filtered = pmp::filter_peaks_by_blank(t(x), fold_change=opt$fold_change, - classes=smeta[,opt$factor_name], - blank_label=opt$blank_label, - qc_label=opt$qc_label, + blank_filtered = pmp::filter_peaks_by_blank(t(x), fold_change=M$fold_change, + classes=smeta[,M$factor_name], + blank_label=M$blank_label, + qc_label=M$qc_label, remove=FALSE, - fraction_in_blank=opt$fraction + fraction_in_blank=M$fraction ) - dataset.data(D) = as.data.frame(t(blank_filtered$df)) + # store the flags + flags=data.frame(blank_filtered$flags) + output.value(M,'flags') = data.frame(blank_filtered$flags,stringsAsFactors = F) + return(M) + } +) + +#' @export +#' @template model_predict +setMethod(f="model.predict",signature=c("blank_filter","dataset"), + definition=function(M,D) { # remove the blanks. do it this way because pmp doesnt remove from class labels. - RB = filter_smeta(mode='exclude',levels=opt$blank_label,factor_name=opt$factor_name) + RB = filter_smeta(mode='exclude',levels=M$blank_label,factor_name=M$factor_name) RB=model.apply(RB,D) D=predicted(RB) - flags=data.frame(blank_filtered$flags) + # get the flags + flags=M$flags vmeta=dataset.variable_meta(D) vmeta=vmeta[flags$blank_flags==1,,drop=FALSE] dataset.variable_meta(D)=vmeta output.value(M,'filtered') = D - output.value(M,'flags') = data.frame(blank_filtered$flags,stringsAsFactors = F) return(M) } ) - ##### plots #' plot for blank filter #' diff --git a/R/classical_lsq_class.R b/R/classical_lsq_class.R index 464803b..b7a4e7b 100644 --- a/R/classical_lsq_class.R +++ b/R/classical_lsq_class.R @@ -72,7 +72,7 @@ classical_lsq<-setClass( ) #' @export -#' @template method_apply +#' @template model_apply setMethod(f="model.apply", signature=c("classical_lsq",'dataset'), definition=function(M,D) diff --git a/R/confounders_clsq_class.R b/R/confounders_clsq_class.R index dfdd1bc..f1d692e 100644 --- a/R/confounders_clsq_class.R +++ b/R/confounders_clsq_class.R @@ -81,7 +81,7 @@ confounders_clsq<-setClass( ) #' @export -#' @template method_apply +#' @template model_apply setMethod(f="model.apply", signature=c("confounders_clsq",'dataset'), definition=function(M,D) diff --git a/R/corr_coef_class.R b/R/corr_coef_class.R index 03bdcc4..f7d9970 100644 --- a/R/corr_coef_class.R +++ b/R/corr_coef_class.R @@ -70,7 +70,7 @@ corr_coef<-setClass( ) #' @export -#' @template method_apply +#' @template model_apply setMethod(f="model.apply", signature=c("corr_coef",'dataset'), definition=function(M,D) diff --git a/R/d_ratio_filter_class.R b/R/d_ratio_filter_class.R index 9e646d2..76ef482 100644 --- a/R/d_ratio_filter_class.R +++ b/R/d_ratio_filter_class.R @@ -62,8 +62,8 @@ dratio_filter<-setClass( ) #' @export -#' @template method_apply -setMethod(f="model.apply", +#' @template model_train +setMethod(f="model.train", signature=c("dratio_filter","dataset"), definition=function(M,D) { @@ -86,9 +86,22 @@ setMethod(f="model.apply", M$d_ratio=data.frame(d_ratio=d_ratio,row.names=colnames(D$data)) M$flags=data.frame(rejected=OUT,row.names = colnames(D$data)) + return(M) + } +) + +#' @export +#' @template model_predict +setMethod(f="model.predict", + signature=c("dratio_filter","dataset"), + definition=function(M,D) + { + # get flags + OUT=M$flags$rejected + # remove flagged D$data=D$data[,-OUT] D$variable_meta=D$variable_meta[,-OUT] - + # store M$filtered=D return(M) diff --git a/R/filter_by_name_class.R b/R/filter_by_name_class.R index a566cec..22f1b06 100644 --- a/R/filter_by_name_class.R +++ b/R/filter_by_name_class.R @@ -43,7 +43,7 @@ filter_by_name<-setClass( ) #' @export -#' @template method_apply +#' @template model_apply setMethod(f="model.apply", signature=c("filter_by_name","dataset"), definition=function(M,D) @@ -56,7 +56,7 @@ setMethod(f="model.apply", if (is.logical(opt$names)) { - IN = opt$names + IN = opt$names } else if (is.numeric(opt$names)) { IN = (1:nrow(D$data)) %in% opt$names @@ -105,3 +105,23 @@ setMethod(f="model.apply", } ) +#' @export +#' @template model_train +setMethod(f="model.train", + signature=c("filter_by_name","dataset"), + definition=function(M,D) { + M=model.apply(M,D) + return(M) + } +) + +#' @export +#' @template model_predict +setMethod(f="model.predict", + signature=c("filter_by_name","dataset"), + definition=function(M,D) { + M=model.apply(M,D) + return(M) + } +) + diff --git a/R/filter_na_count.R b/R/filter_na_count.R index 97c675e..aff4b60 100644 --- a/R/filter_na_count.R +++ b/R/filter_na_count.R @@ -61,8 +61,8 @@ filter_na_count<-setClass( ) #' @export -#' @template method_apply -setMethod(f="model.apply", +#' @template model_train +setMethod(f="model.train", signature=c("filter_na_count","dataset"), definition=function(M,D) { @@ -85,11 +85,7 @@ setMethod(f="model.apply", flags=apply(na_count,1,function(x) any(x + + + + + + + + + + + + + + +Iterator objects + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+ + + +
+
+
+
+
+ +
+ + + + + + + +



+
+

1 Introduction

+

Validation is an important aspect of chemometric modelling. The STRUCT framework enables this kind of iterative model testing through iterator objects. In order to demonstrate this we will first load the iris data set, which as been pre-prepared as a dataset object as part of the STRUCT package.

+
D = iris_dataset()
+summary(D)
+
## A dataset object from the struct package
+## 
+## Name: Iris
+## Description: Fisher's Iris data
+## 
+## Consists of 150 samples and 4 features.
+## 
+## There are 3 levels: setosa,versicolor,virginica in factor named "Species"
+



+
+
+

2 Cross-validation

+

Cross validation is a common technique for assessing the performance of classification models. For this example we will use a PLSDA model. Data should be mean centred prior to PLS, so we will build a model sequence first.

+
M = mean_centre() + PLSDA(number_components=2,factor_name='Species')
+M
+
## A model.seq object containing:
+## [1] Mean centre
+## [2] Partial least squares discriminant analysis
+

Iterators objects like the k-fold cross-validation object can be created just like any other struct object. Parameters can be set at creation =, and accessed/changed later using dollar notation.

+
XCV = kfold_xval(folds=5,factor_name='Species')
+# change the number of folds
+XCV$folds=10
+XCV$folds
+
## [1] 10
+

The model to be cross-validated can be set/accessed used the models method.

+
models(XCV)=M
+models(XCV)
+
## A model.seq object containing:
+## [1] Mean centre
+## [2] Partial least squares discriminant analysis
+

Alternatively, iterators can be combined with models using the multiplication symbol:

+
XCV = kfold_xval(folds=5,method='venetian',factor_name='Species') * 
+      (mean_centre()+PLSDA(number_components = 2,factor_name='Species'))
+

The run method can be used with any iterator object. The iterator will then run the model sequence multiple times. In our case we will run cross-validation 5 times splitting the data into different training and test sets each time. The run method also needs a metric to be specified. This metric may be calculated once after all iterations, or after each iteration, depending on the iterator type (resampling, permutation etc). For cross-validation we will calculate balanced accuracy after all iterations.

+
XCV = run(XCV,D,balanced_accuracy())
+XCV$metric
+
##              metric mean sd
+## 1 balanced_accuracy 0.23 NA
+



+

Like other STRUCT objects, iterators can have chart objects associated with them. The chart.names function will list them for an object.

+
chart.names(XCV)
+
## [1] "kfoldxcv_grid"   "kfoldxcv_metric"
+

Charts for iterator objects can be plotted in the same way as charts for any other object.

+
C = kfoldxcv_grid()
+chart.plot(C,XCV)
+
## [[1]]
+

+
## 
+## [[2]]
+

+
## 
+## [[3]]
+

+

It is possible to combine multiple iterators by multiplying them together. This is equivalent to nesting one iterator inside the other. For example, we can repeat our cross-validation multiple times by permuting the sample order.

+
P = permute_sample_order(number_of_permutations = 10) * 
+    kfold_xval(folds=5,factor_name='Species')*
+    (mean_centre() + PLSDA(factor_name='Species',number_components=2))
+P = run(P,D,balanced_accuracy())
+P$metric
+
##              metric   mean         sd
+## 1 balanced_accuracy 0.2235 0.00944281
+
+ + + +
+
+ +
+ + + + + + + + + + + + + + + + + diff --git a/vignettes/model_example.R b/vignettes/model_example.R new file mode 100644 index 0000000..74ed90b --- /dev/null +++ b/vignettes/model_example.R @@ -0,0 +1,72 @@ +## ----setup, include=FALSE-------------------------------------------------- +knitr::opts_chunk$set( + dpi=72 +) +library(structToolbox) +library(gridExtra) + +## -------------------------------------------------------------------------- +D = iris_dataset() +head(D$data) + +## -------------------------------------------------------------------------- +P = PCA(number_components=15) +P$number_components=5 +P$number_components + +## -------------------------------------------------------------------------- +param.ids(P) + +## -------------------------------------------------------------------------- +M = mean_centre() + PCA(number_components = 4) + +## -------------------------------------------------------------------------- +M[2]$number_components + +## -------------------------------------------------------------------------- +M = model.train(M,D) + +## -------------------------------------------------------------------------- +M = model.predict(M,D) + +## -------------------------------------------------------------------------- +output.ids(M[2]) +M[2]$scores + +## -------------------------------------------------------------------------- +chart.names(M[2]) + +## -------------------------------------------------------------------------- +C = pca_scores_plot(groups=D$sample_meta$Species,factor_name='Species') # colour by Species +chart.plot(C,M[2]) + +## -------------------------------------------------------------------------- +# add petal width to emta data of pca scores +M[2]$scores$sample_meta$Petal.Width=D$data$Petal.Width +# update plot +C$factor_name='Petal.Width' +chart.plot(C,M[2]) + +## ----fig.width=10---------------------------------------------------------- +C1 = pca_scores_plot(groups=D$sample_meta$Species,factor_name='Species') # colour by Species +g1 = chart.plot(C1,M[2]) +C2 = PCA.scree() +g2 = chart.plot(C2,M[2]) +grid.arrange(grobs=list(g1,g2),nrow=1) + +## -------------------------------------------------------------------------- +is(PCA(),'stato') + +## -------------------------------------------------------------------------- +# this is the stato id for PCA +stato.id(P) + +# this is the stato name +stato.name(P) + +# this is the stato definition +stato.definition(P) + +## -------------------------------------------------------------------------- +stato.summary(P) + From 13adb139ce0232567c5fb1c51ae81916bc373462 Mon Sep 17 00:00:00 2001 From: "Gavin Lloyd (College of Medical and Dental Sciences)" Date: Thu, 31 Oct 2019 11:54:07 +0000 Subject: [PATCH 5/9] use release version of bioc --- .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 73e93da..5c534fc 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,5 +1,5 @@ language: r -r: bioc-devel +r: bioc-release sudo: false cache: packages warnings_are_errors: false From b73eca099681695e6ca0c06ce8edddf062d40e2d Mon Sep 17 00:00:00 2001 From: "Gavin Lloyd (College of Medical and Dental Sciences)" Date: Thu, 31 Oct 2019 11:54:39 +0000 Subject: [PATCH 6/9] add functions for boostrapping and a modified permutaion test --- DESCRIPTION | 2 + NAMESPACE | 2 + R/bootstrap_class.R | 99 +++++++++++++++++++++ R/permutation_test2_class.R | 151 +++++++++++++++++++++++++++++++++ man/bootstrap-class.Rd | 14 +++ man/permutation_test2-class.Rd | 14 +++ man/run.Rd | 15 +++- 7 files changed, 293 insertions(+), 4 deletions(-) create mode 100644 R/bootstrap_class.R create mode 100644 R/permutation_test2_class.R create mode 100644 man/bootstrap-class.Rd create mode 100644 man/permutation_test2-class.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 5dac077..5e16bd9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -24,6 +24,7 @@ Collate: 'autoscale_class.R' 'balanced_accuracy_class.R' 'blank_filter_class.R' + 'bootstrap_class.R' 'calculate_doc.R' 'chart_plot_doc.R' 'classical_lsq_class.R' @@ -57,6 +58,7 @@ Collate: 'mv_feature_filter_class.R' 'mv_sample_filter_class.R' 'pairs_filter_class.R' + 'permutation_test2_class.R' 'permutation_test_class.R' 'permute_sample_order_class.R' 'pqn_norm_method_class.R' diff --git a/NAMESPACE b/NAMESPACE index 13e0b37..b7f1431 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -14,6 +14,7 @@ export(autoscale) export(balanced_accuracy) export(blank_filter) export(blank_filter.hist) +export(bootstrap) export(classical_lsq) export(compare_dist) export(confounders_clsq) @@ -66,6 +67,7 @@ export(permutation_test.boxplot) export(permutation_test.hist) export(permutation_test.scatter) export(permutation_test.violin) +export(permutation_test2) export(permute_sample_order) export(plsda_scores_plot) export(plsr_cook_dist) diff --git a/R/bootstrap_class.R b/R/bootstrap_class.R new file mode 100644 index 0000000..f068a2f --- /dev/null +++ b/R/bootstrap_class.R @@ -0,0 +1,99 @@ +#' permutation test class +#' +#' Applies a permutation test to a model or model.seq() +#' @examples +#' I=bootstrap() +#' +#' @export bootstrap +bootstrap<-setClass( + "bootstrap", + contains='resampler', + slots=c( + params.number_of_permutations='numeric', + params.collect='character', + outputs.results='data.frame', + outputs.metric='data.frame', + outputs.collected='entity' + ), + prototype = list(name='permutation test', + type='permutation', + result='results', + params.number_of_permutations=10, + params.collect='vip', + outputs.collected=entity(name='collected output', + type=c('logical','list'), + value=NA,max_length=Inf) + ) +) + +#' @export +#' @template run +setMethod(f="run", + signature=c("bootstrap",'dataset','metric'), + definition=function(I,D,MET=NULL) + { + + X=dataset.data(D) + y=dataset.sample_meta(D) + # get the WF + WF=models(I) + n=param.value(I,'number_of_permutations') + + all_results=data.frame('actual'=rep(y[,1],n),'predicted'=rep(y[,1],n),'permutation'=0) + + collected=list() + + for (i in 1:n) + { + results=data.frame('actual'=y[,1],'predicted'=y[,1],'permutation'=i) + + # generate a random sample order + order=sample.int(nrow(X),replace = TRUE) # WITH REPLACEMENT + + # permute + Xp=X[order,,drop=FALSE] + Yp=as.data.frame(y[order,,drop=FALSE]) + + # rebuild datasets + Dp=D + dataset.data(Dp)=Xp + dataset.sample_meta(Dp)=Yp + + if (is(WF,'model_OR_model.seq')) + { + ## permuted labels + # train + WF=model.train(WF,Dp) + # predict + WF=model.predict(WF,Dp) + p=predicted(WF) + results[,2]=p[,1] + all_results[((nrow(X)*(i-1))+1):(nrow(X)*i),]=results + + if (!is.na(I$collect)) { + if (is(WF,'model')) { + collected=c(collected,list(output.value(WF,I$collect))) + } else { + # if sequence assume collecting from last index + collected=c(collected,list(output.value(WF[length(WF)],I$collect))) + } + I$collected=collected + } + + + } + + if (is(WF,'iterator')) + { + + stop('not implemented yet') + } + + } + # store results + output.value(I,'results')=all_results + return(I) + } +) + + diff --git a/R/permutation_test2_class.R b/R/permutation_test2_class.R new file mode 100644 index 0000000..53e5819 --- /dev/null +++ b/R/permutation_test2_class.R @@ -0,0 +1,151 @@ +#' permutation test class +#' +#' Applies a permutation test to a model or model.seq() +#' @examples +#' I=permutation_test2() +#' +#' @export permutation_test2 +permutation_test2<-setClass( + "permutation_test2", + contains='resampler', + slots=c( + params.number_of_permutations='numeric', + params.collect='character', + outputs.results.permuted='data.frame', + outputs.results.unpermuted='data.frame', + outputs.metric='data.frame', + outputs.collected='entity' + ), + prototype = list(name='permutation test', + type='permutation', + result='results', + params.number_of_permutations=10, + params.collect='vip', + outputs.collected=entity(name='collected output', + type=c('logical','list'), + value=NA,max_length=Inf) + ) +) + +#' @export +#' @template run +setMethod(f="run", + signature=c("permutation_test2",'dataset','metric'), + definition=function(I,D,MET=NULL) + { + + X=dataset.data(D) + y=dataset.sample_meta(D) + # get the WF + WF=models(I) + n=param.value(I,'number_of_permutations') + + all_results_permuted=data.frame('actual'=rep(y[,1],n),'predicted'=rep(y[,1],n),'permutation'=0) + all_results_unpermuted=data.frame('actual'=rep(y[,1],n),'predicted'=rep(y[,1],n),'permutation'=0) + + collected=list(permuted=list(),unpermuted=list()) + + for (i in 1:n) + { + perm_results=data.frame('actual'=y[,1],'predicted'=y[,1],'permutation'=i) + unperm_results=data.frame('actual'=y[,1],'predicted'=y[,1],'permutation'=i) + # generate a random sample order + order_x=sample.int(nrow(X)) + order_y=sample.int(nrow(X)) + order_y2=order_x # the same order for y + + # permute + Xp=X[order_x,,drop=FALSE] + Yp=as.data.frame(y[order_y,,drop=FALSE]) + Yp2=as.data.frame(y[order_y2,,drop=FALSE]) + + # rebuild datasets + Dp=D + dataset.data(D)=Xp + dataset.sample_meta(Dp)=Yp + + D2=D + dataset.data(D2)=Xp + dataset.sample_meta(D2)=Yp2 + + if (is(WF,'model_OR_model.seq')) + { + ## permuted labels + # train + WF=model.train(WF,Dp) + # predict + WF=model.predict(WF,Dp) + p=predicted(WF) + perm_results[,2]=p[,1] + all_results_permuted[((nrow(X)*(i-1))+1):(nrow(X)*i),]=perm_results + + if (!is.na(I$collect)) { + if (is(WF,'model')) { + collected$permuted=c(collected$permuted,list(output.value(WF,I$collect))) + } else { + # if sequence assume collecting from last index + collected$permuted=c(collected$permuted,list(output.value(WF[length(WF)],I$collect))) + } + I$collected=collected + } + + ## real labels + # train + WF=model.train(WF,D2) + # predict + WF=model.predict(WF,D2) + p=predicted(WF) + unperm_results[,2]=p[,1] + all_results_unpermuted[((nrow(X)*(i-1))+1):(nrow(X)*i),]=unperm_results + + if (!is.na(I$collect)) { + if (is(WF,'model')) { + collected$unpermuted=c(collected$unpermuted,list(output.value(WF,I$collect))) + } else { + # if sequence assume collecting from last index + collected$unpermuted=c(collected$unpermuted,list(output.value(WF[length(WF)],I$collect))) + } + I$collected=collected + } + } + + if (is(WF,'iterator')) + { + + ## permuted + WF=run(WF,Dp,MET) + v=output.value(WF,'metric') + + if (i==1) + { + all_results_permuted=v + } + else + { + all_results_permuted=rbind(all_results_permuted,v) + } + + + ## real + WF=run(WF,D2,MET) + w=output.value(WF,'metric') + if (i==1) + { + all_results_unpermuted=w + } + else + { + all_results_unpermuted=rbind(all_results_unpermuted,w) + } + + } + + } + # store results + output.value(I,'results.permuted')=all_results_permuted + output.value(I,'results.unpermuted')=all_results_unpermuted + return(I) + } +) + + diff --git a/man/bootstrap-class.Rd b/man/bootstrap-class.Rd new file mode 100644 index 0000000..d8ac1ba --- /dev/null +++ b/man/bootstrap-class.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bootstrap_class.R +\docType{class} +\name{bootstrap-class} +\alias{bootstrap-class} +\alias{bootstrap} +\title{permutation test class} +\description{ +Applies a permutation test to a model or model.seq() +} +\examples{ +I=bootstrap() + +} diff --git a/man/permutation_test2-class.Rd b/man/permutation_test2-class.Rd new file mode 100644 index 0000000..a573ca3 --- /dev/null +++ b/man/permutation_test2-class.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/permutation_test2_class.R +\docType{class} +\name{permutation_test2-class} +\alias{permutation_test2-class} +\alias{permutation_test2} +\title{permutation test class} +\description{ +Applies a permutation test to a model or model.seq() +} +\examples{ +I=permutation_test2() + +} diff --git a/man/run.Rd b/man/run.Rd index 78a6ac3..d7eed49 100644 --- a/man/run.Rd +++ b/man/run.Rd @@ -1,23 +1,30 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/forward_selection_by_rank_class.R, -% R/grid_search_1d_class.R, R/kfold_xval_class.R, R/permutation_test_class.R, -% R/permute_sample_order_class.R, R/run_doc.R +% Please edit documentation in R/bootstrap_class.R, +% R/forward_selection_by_rank_class.R, R/grid_search_1d_class.R, +% R/kfold_xval_class.R, R/permutation_test2_class.R, +% R/permutation_test_class.R, R/permute_sample_order_class.R, R/run_doc.R \docType{methods} -\name{run,forward_selection_byrank,dataset,metric-method} +\name{run,bootstrap,dataset,metric-method} +\alias{run,bootstrap,dataset,metric-method} \alias{run,forward_selection_byrank,dataset,metric-method} \alias{run,grid_search_1d,dataset,metric-method} \alias{run,kfold_xval,dataset,metric-method} +\alias{run,permutation_test2,dataset,metric-method} \alias{run,permutation_test,dataset,metric-method} \alias{run,permute_sample_order,dataset,metric-method} \alias{run} \title{Runs an iterator, applying the chosen model multiple times.} \usage{ +\S4method{run}{bootstrap,dataset,metric}(I, D, MET = NULL) + \S4method{run}{forward_selection_byrank,dataset,metric}(I, D, MET) \S4method{run}{grid_search_1d,dataset,metric}(I, D, MET) \S4method{run}{kfold_xval,dataset,metric}(I, D, MET = NULL) +\S4method{run}{permutation_test2,dataset,metric}(I, D, MET = NULL) + \S4method{run}{permutation_test,dataset,metric}(I, D, MET = NULL) \S4method{run}{permute_sample_order,dataset,metric}(I, D, MET) From 8b0ab3cdbfd011bfbdc440f10361e33637a9b1a0 Mon Sep 17 00:00:00 2001 From: "Gavin Lloyd (College of Medical and Dental Sciences)" Date: Thu, 31 Oct 2019 12:05:28 +0000 Subject: [PATCH 7/9] use struct v0.4.0 --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 5e16bd9..e52e53d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -75,7 +75,7 @@ Collate: 'vec_norm_class.R' 'wilcox_test_class.R' 'zzz.R' -Depends: struct +Depends: struct (== 0.4.0) Imports: ggplot2, pmp, gridExtra, @@ -103,7 +103,7 @@ Suggests: sbcms, Rtsne Remotes: computational-metabolomics/pmp, - computational-metabolomics/struct@4bc5702, + computational-metabolomics/struct@v0.4.0, computational-metabolomics/sbcms VignetteBuilder: knitr biocViews: WorkflowStep From b5a6ae983252a0c078ff8b4c11f1f1ec1034b43c Mon Sep 17 00:00:00 2001 From: "Gavin Lloyd (College of Medical and Dental Sciences)" Date: Thu, 31 Oct 2019 13:41:39 +0000 Subject: [PATCH 8/9] fix broken example --- R/dataset_chart_classes.R | 4 ++-- man/mv_boxplot-class.Rd | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/R/dataset_chart_classes.R b/R/dataset_chart_classes.R index 9095e80..894259a 100644 --- a/R/dataset_chart_classes.R +++ b/R/dataset_chart_classes.R @@ -220,7 +220,7 @@ setMethod(f="chart.plot", #' @param show_counts [TRUE] or FALSE to include the number of samples on the plot #' @examples #' D = sbcms_dataset() -#' C = mv_boxplot() +#' C = mv_boxplot(factor_name='class') #' chart.plot(C,D) #' #' @import struct @@ -272,7 +272,7 @@ setMethod(f="chart.plot", # get data Xt=dataset.data(dobj) # meta data - SM=dataset.sample_meta(dobj)[ ,1] + SM=dataset.sample_meta(dobj)[ ,obj$factor_name] L=levels(SM) diff --git a/man/mv_boxplot-class.Rd b/man/mv_boxplot-class.Rd index 35391c3..563e170 100644 --- a/man/mv_boxplot-class.Rd +++ b/man/mv_boxplot-class.Rd @@ -20,7 +20,7 @@ Boxplot of the numbers of missing values per sample/feature } \examples{ D = sbcms_dataset() -C = mv_boxplot() +C = mv_boxplot(factor_name='class') chart.plot(C,D) } From b8be8f1377c4bddb83f7eec908956617d6a01931 Mon Sep 17 00:00:00 2001 From: "Gavin Lloyd (College of Medical and Dental Sciences)" Date: Thu, 31 Oct 2019 14:30:45 +0000 Subject: [PATCH 9/9] fix broken vignettes --- vignettes/iterator_example.R | 47 - vignettes/iterator_example.Rmd | 4 +- vignettes/iterator_example.html | 1925 ------------------------------- vignettes/model_example.R | 72 -- vignettes/model_example.Rmd | 2 +- 5 files changed, 3 insertions(+), 2047 deletions(-) delete mode 100644 vignettes/iterator_example.R delete mode 100644 vignettes/iterator_example.html delete mode 100644 vignettes/model_example.R diff --git a/vignettes/iterator_example.R b/vignettes/iterator_example.R deleted file mode 100644 index 5af4f10..0000000 --- a/vignettes/iterator_example.R +++ /dev/null @@ -1,47 +0,0 @@ -## ----setup, include=FALSE-------------------------------------------------- -knitr::opts_chunk$set( - dpi=72 -) -library(structToolbox) -library(gridExtra) - -## -------------------------------------------------------------------------- -D = iris_dataset() -summary(D) - -## -------------------------------------------------------------------------- -M = mean_centre() + PLSDA(number_components=2,factor_name='Species') -M - -## -------------------------------------------------------------------------- -XCV = kfold_xval(folds=5,factor_name='Species') -# change the number of folds -XCV$folds=10 -XCV$folds - -## -------------------------------------------------------------------------- -models(XCV)=M -models(XCV) - -## -------------------------------------------------------------------------- -XCV = kfold_xval(folds=5,method='venetian',factor_name='Species') * - (mean_centre()+PLSDA(number_components = 2,factor_name='Species')) - -## -------------------------------------------------------------------------- -XCV = run(XCV,D,balanced_accuracy()) -XCV$metric - -## -------------------------------------------------------------------------- -chart.names(XCV) - -## ----warning=FALSE--------------------------------------------------------- -C = kfoldxcv_grid() -chart.plot(C,XCV) - -## -------------------------------------------------------------------------- -P = permute_sample_order(number_of_permutations = 10) * - kfold_xval(folds=5,factor_name='Species')* - (mean_centre() + PLSDA(factor_name='Species',number_components=2)) -P = run(P,D,balanced_accuracy()) -P$metric - diff --git a/vignettes/iterator_example.Rmd b/vignettes/iterator_example.Rmd index 4a159c1..0df8b52 100644 --- a/vignettes/iterator_example.Rmd +++ b/vignettes/iterator_example.Rmd @@ -6,12 +6,12 @@ author: output: BiocStyle::html_document: toc_float: true - BiocStyle::pdf_document: default + BiocStyle::pdf_document: package: structToolbox vignette: > %\VignetteIndexEntry{Iterator objects} - %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} + %\VignetteEngine{knitr::rmarkdown} --- ```{r setup, include=FALSE} diff --git a/vignettes/iterator_example.html b/vignettes/iterator_example.html deleted file mode 100644 index 7f2d3b6..0000000 --- a/vignettes/iterator_example.html +++ /dev/null @@ -1,1925 +0,0 @@ - - - - - - - - - - - - - - - -Iterator objects - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- - - -
-
-
-
-
- -
- - - - - - - -



-
-

1 Introduction

-

Validation is an important aspect of chemometric modelling. The STRUCT framework enables this kind of iterative model testing through iterator objects. In order to demonstrate this we will first load the iris data set, which as been pre-prepared as a dataset object as part of the STRUCT package.

-
D = iris_dataset()
-summary(D)
-
## A dataset object from the struct package
-## 
-## Name: Iris
-## Description: Fisher's Iris data
-## 
-## Consists of 150 samples and 4 features.
-## 
-## There are 3 levels: setosa,versicolor,virginica in factor named "Species"
-



-
-
-

2 Cross-validation

-

Cross validation is a common technique for assessing the performance of classification models. For this example we will use a PLSDA model. Data should be mean centred prior to PLS, so we will build a model sequence first.

-
M = mean_centre() + PLSDA(number_components=2,factor_name='Species')
-M
-
## A model.seq object containing:
-## [1] Mean centre
-## [2] Partial least squares discriminant analysis
-

Iterators objects like the k-fold cross-validation object can be created just like any other struct object. Parameters can be set at creation =, and accessed/changed later using dollar notation.

-
XCV = kfold_xval(folds=5,factor_name='Species')
-# change the number of folds
-XCV$folds=10
-XCV$folds
-
## [1] 10
-

The model to be cross-validated can be set/accessed used the models method.

-
models(XCV)=M
-models(XCV)
-
## A model.seq object containing:
-## [1] Mean centre
-## [2] Partial least squares discriminant analysis
-

Alternatively, iterators can be combined with models using the multiplication symbol:

-
XCV = kfold_xval(folds=5,method='venetian',factor_name='Species') * 
-      (mean_centre()+PLSDA(number_components = 2,factor_name='Species'))
-

The run method can be used with any iterator object. The iterator will then run the model sequence multiple times. In our case we will run cross-validation 5 times splitting the data into different training and test sets each time. The run method also needs a metric to be specified. This metric may be calculated once after all iterations, or after each iteration, depending on the iterator type (resampling, permutation etc). For cross-validation we will calculate balanced accuracy after all iterations.

-
XCV = run(XCV,D,balanced_accuracy())
-XCV$metric
-
##              metric mean sd
-## 1 balanced_accuracy 0.23 NA
-



-

Like other STRUCT objects, iterators can have chart objects associated with them. The chart.names function will list them for an object.

-
chart.names(XCV)
-
## [1] "kfoldxcv_grid"   "kfoldxcv_metric"
-

Charts for iterator objects can be plotted in the same way as charts for any other object.

-
C = kfoldxcv_grid()
-chart.plot(C,XCV)
-
## [[1]]
-

-
## 
-## [[2]]
-

-
## 
-## [[3]]
-

-

It is possible to combine multiple iterators by multiplying them together. This is equivalent to nesting one iterator inside the other. For example, we can repeat our cross-validation multiple times by permuting the sample order.

-
P = permute_sample_order(number_of_permutations = 10) * 
-    kfold_xval(folds=5,factor_name='Species')*
-    (mean_centre() + PLSDA(factor_name='Species',number_components=2))
-P = run(P,D,balanced_accuracy())
-P$metric
-
##              metric   mean         sd
-## 1 balanced_accuracy 0.2235 0.00944281
-
- - - -
-
- -
- - - - - - - - - - - - - - - - - diff --git a/vignettes/model_example.R b/vignettes/model_example.R deleted file mode 100644 index 74ed90b..0000000 --- a/vignettes/model_example.R +++ /dev/null @@ -1,72 +0,0 @@ -## ----setup, include=FALSE-------------------------------------------------- -knitr::opts_chunk$set( - dpi=72 -) -library(structToolbox) -library(gridExtra) - -## -------------------------------------------------------------------------- -D = iris_dataset() -head(D$data) - -## -------------------------------------------------------------------------- -P = PCA(number_components=15) -P$number_components=5 -P$number_components - -## -------------------------------------------------------------------------- -param.ids(P) - -## -------------------------------------------------------------------------- -M = mean_centre() + PCA(number_components = 4) - -## -------------------------------------------------------------------------- -M[2]$number_components - -## -------------------------------------------------------------------------- -M = model.train(M,D) - -## -------------------------------------------------------------------------- -M = model.predict(M,D) - -## -------------------------------------------------------------------------- -output.ids(M[2]) -M[2]$scores - -## -------------------------------------------------------------------------- -chart.names(M[2]) - -## -------------------------------------------------------------------------- -C = pca_scores_plot(groups=D$sample_meta$Species,factor_name='Species') # colour by Species -chart.plot(C,M[2]) - -## -------------------------------------------------------------------------- -# add petal width to emta data of pca scores -M[2]$scores$sample_meta$Petal.Width=D$data$Petal.Width -# update plot -C$factor_name='Petal.Width' -chart.plot(C,M[2]) - -## ----fig.width=10---------------------------------------------------------- -C1 = pca_scores_plot(groups=D$sample_meta$Species,factor_name='Species') # colour by Species -g1 = chart.plot(C1,M[2]) -C2 = PCA.scree() -g2 = chart.plot(C2,M[2]) -grid.arrange(grobs=list(g1,g2),nrow=1) - -## -------------------------------------------------------------------------- -is(PCA(),'stato') - -## -------------------------------------------------------------------------- -# this is the stato id for PCA -stato.id(P) - -# this is the stato name -stato.name(P) - -# this is the stato definition -stato.definition(P) - -## -------------------------------------------------------------------------- -stato.summary(P) - diff --git a/vignettes/model_example.Rmd b/vignettes/model_example.Rmd index 8e3f63e..8f4157d 100644 --- a/vignettes/model_example.Rmd +++ b/vignettes/model_example.Rmd @@ -6,7 +6,7 @@ author: output: BiocStyle::html_document: toc_float: true - BiocStyle::pdf_document: default + BiocStyle::pdf_document: package: structToolbox abstract: Introduction to model objects vignette: >