Merge branch 'master' of https://github.com/computational-metabolomics/structToolbox

Author: grlloyd

.travis.yml

@@ -11,3 +11,7 @@ addons:
     packages:
       - libudunits2-dev
       - libgdal1-dev
+
+script:
+  - R -e 'install.packages("BiocManager")'
+  - R -e 'BiocManager::install(version = "3.9")'

DESCRIPTION

@@ -35,6 +35,7 @@ Collate:
     'ggplot_theme_pub.R'
     'glog_class.R'
     'grid_search_1d_class.R'
+    'hca_class.R'
     'kfold_xval_class.R'
     'kfold_xval_charts.R'
     'knn_impute_class.R'
@@ -50,7 +51,7 @@ Collate:
     'r_squared_class.R'
     'rsd_filter.R'
     'split_data_class.R'
-    'structtoolbox.R'
+    'structToolbox.R'
     'ttest_class.R'
     'vec_norm_class.R'
 Depends: struct
@@ -67,12 +68,15 @@ Imports: ggplot2,
     reshape2,
     agricolae,
     emmeans,
-    lme4,
     nlme,
     ggthemes
 RoxygenNote: 6.1.1
 Suggests: 
     testthat,
-    covr
+    covr,
+    knitr,
+    rmarkdown
 Remotes: computational-metabolomics/pmp,
   computational-metabolomics/struct
+VignetteBuilder: knitr
+biocViews: WorkflowStep

NAMESPACE

@@ -1,6 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
 export(ANOVA)
+export(HCA)
 export(HSD)
 export(HSDEM)
 export(PCA)
@@ -35,6 +36,7 @@ export(fs_line)
 export(glog_transform)
 export(grid_search_1d)
 export(gs_line)
+export(hca_dendrogram)
 export(kfold_xval)
 export(kfoldxcv_grid)
 export(kfoldxcv_metric)
@@ -84,6 +86,7 @@ exportMethods(run)
 import(agricolae)
 import(car)
 import(emmeans)
+import(ggdendro)
 import(ggplot2)
 import(ggthemes)
 import(grid)

NEWS

@@ -0,0 +1,3 @@
+# structToolbox 0.1.0
+
+* Added a `NEWS.md` file to track changes to the package.

R/HSDEM_class.R

@@ -9,144 +9,144 @@
 #' @include mixed_effect_class.R HSD_class.R
 #' @export HSDEM
 HSDEM<-setClass(
-  "HSDEM",
-  contains=c('method','stato'),
-  slots=c(
-    # INPUTS
-    params.alpha='entity.stato',
-    params.mtc='entity.stato',
-    params.formula='entity',
-
-    # OUTPUTS
-    outputs.p_value='entity.stato',
-    outputs.significant='entity'
-  ),
-  prototype = list(name='Tukey Honest Significant Difference using estimated marginal means',
-    description='Tukey HSD post hoc tests for mixed effects models using estimated marginal means',
-    type="univariate",
-    predicted='p_value',
-    stato.id="STATO:0000187",
-
-    params.alpha=entity.stato(name='Confidence level',
-      stato.id='STATO:0000053',
-      value=0.05,
-      type='numeric',
-      description='the p-value cutoff for determining significance.'
+    "HSDEM",
+    contains=c('method','stato'),
+    slots=c(
+        # INPUTS
+        params.alpha='entity.stato',
+        params.mtc='entity.stato',
+        params.formula='entity',
+
+        # OUTPUTS
+        outputs.p_value='entity.stato',
+        outputs.significant='entity'
     ),
-    params.mtc=entity.stato(name='Multiple Test Correction method',
-      stato.id='OBI:0200089',
-      value='none',
-      type='numeric',
-      description='The method used to adjust for multiple comparisons.'
-    ),
-
-    outputs.p_value=entity.stato(name='p value',
-      stato.id='STATO:0000175',
-      type='numeric',
-      description='the probability of observing the calculated t-statistic.'
-    ),
-    outputs.significant=entity(name='Significant features',
-      #stato.id='STATO:0000069',
-      type='logical',
-      description='TRUE if the calculated p-value is less than the supplied threhold (alpha)'
+    prototype = list(name='Tukey Honest Significant Difference using estimated marginal means',
+        description='Tukey HSD post hoc tests for mixed effects models using estimated marginal means',
+        type="univariate",
+        predicted='p_value',
+        stato.id="STATO:0000187",
+
+        params.alpha=entity.stato(name='Confidence level',
+            stato.id='STATO:0000053',
+            value=0.05,
+            type='numeric',
+            description='the p-value cutoff for determining significance.'
+        ),
+        params.mtc=entity.stato(name='Multiple Test Correction method',
+            stato.id='OBI:0200089',
+            value='none',
+            type='numeric',
+            description='The method used to adjust for multiple comparisons.'
+        ),
+
+        outputs.p_value=entity.stato(name='p value',
+            stato.id='STATO:0000175',
+            type='numeric',
+            description='the probability of observing the calculated t-statistic.'
+        ),
+        outputs.significant=entity(name='Significant features',
+            #stato.id='STATO:0000069',
+            type='logical',
+            description='TRUE if the calculated p-value is less than the supplied threhold (alpha)'
+        )
     )
-  )
 )
 
 #' @export
 setMethod(f="method.apply",
-  signature=c("HSDEM",'dataset'),
-  definition=function(M,D) {
-    X=dataset.data(D)
-    lmer_formula=aov2lme(M$formula)
-    var_names=all.vars(M$formula)
-    var_names_1=var_names[1]
-    var_names=var_names[-1]
-    y=dataset.sample_meta(D)[var_names]
-
-    # set the contrasts
-    O=options('contrasts') # keep the old ones
-    options(contrasts = c("contr.sum","contr.poly"))
-
-    # attempt to detect within factors
-    within=which(var_names %in% all.names(M$formula)[which('Error'== all.names(M$formula))+2])
-    if (length(within)>0) {
-      var_names_ex=var_names[-within]
-    } else {
-      var_names_ex=var_names
-    }
-
-    FF=full_fact(var_names_ex)
-    FF=apply(FF,1,function(x) var_names_ex[x==1])
-    FF=FF[-1]
-
-    output=apply(X,2,function(x) {
-      temp=y
-      temp[[var_names_1]]=scale(x,center = TRUE,scale=TRUE)
-
-      dona=FALSE
-
-      testlm=tryCatch({ # if any warnings/messages set p-values to NA as unreliable
-        LM=lme(lmer_formula$f,random=lmer_formula$random,method='ML',data=temp,na.action=na.omit)
-      }, warning = function(w) {
-        NA
-      }, message = function(m) {
-        NA
-      }, error   = function(e) {
-        NA
-      })
-
-      output2=list()
-      for (k in 1:length(FF)) {
-        if (!is.na(testlm[[1]])) {
-          testhsd=tryCatch({
-            output2[[k]]=as.data.frame(pairs(emmeans(LM,FF[[k]],data=temp)))
-          }, warning  = function(w) {
-            NA
-          } , message = function(m) {
-            NA
-          }, error    = function(e) {
-            NA
-          })
-
-          if (!is.data.frame(testhsd[1])) {
-            output2[[k]]=NA
-          }
+    signature=c("HSDEM",'dataset'),
+    definition=function(M,D) {
+        X=dataset.data(D)
+        lmer_formula=aov2lme(M$formula)
+        var_names=all.vars(M$formula)
+        var_names_1=var_names[1]
+        var_names=var_names[-1]
+        y=dataset.sample_meta(D)[var_names]
+
+        # set the contrasts
+        O=options('contrasts') # keep the old ones
+        options(contrasts = c("contr.sum","contr.poly"))
+
+        # attempt to detect within factors
+        within=which(var_names %in% all.names(M$formula)[which('Error'== all.names(M$formula))+2])
+        if (length(within)>0) {
+            var_names_ex=var_names[-within]
         } else {
-          output2[[k]]=NA
+            var_names_ex=var_names
         }
-      }
-
-      return(output2)
-    })
-
-    p_value=lapply(output,function(x) {
-      x=as.data.frame(x)
-      return(x$p.value)
-      })
-    ln=length(p_value[[1]])
-    p_value=lapply(p_value,function(x){
-      if (length(x)!=ln) {
-        return(p_value[[1]]*NA)
-      } else {
-        return(x)
-      }
-    })
-
-    p_value=do.call("rbind",p_value)
-    p_value=data.frame(p_value)
-    colnames(p_value)=as.data.frame(output[[1]])$contrast
-
-    # fdr correct
-    M$p_value=apply(p_value,2,p.adjust,method=M$mtc)
-
-    M$significant=M$p_value<M$alpha
-
-    # reset contrasts
-    options(O)
-
-    return(M)
-  }
+
+        FF=full_fact(var_names_ex)
+        FF=apply(FF,1,function(x) var_names_ex[x==1])
+        FF=FF[-1]
+
+        output=apply(X,2,function(x) {
+            temp=y
+            temp[[var_names_1]]=scale(x,center = TRUE,scale=TRUE)
+
+            dona=FALSE
+
+            testlm=tryCatch({ # if any warnings/messages set p-values to NA as unreliable
+                LM=lme(lmer_formula$f,random=lmer_formula$random,method='ML',data=temp,na.action=na.omit)
+            }, warning = function(w) {
+                NA
+            }, message = function(m) {
+                NA
+            }, error   = function(e) {
+                NA
+            })
+
+            output2=list()
+            for (k in 1:length(FF)) {
+                if (!is.na(testlm[[1]])) {
+                    testhsd=tryCatch({
+                        output2[[k]]=as.data.frame(pairs(emmeans(LM,FF[[k]],data=temp)))
+                    }, warning  = function(w) {
+                        NA
+                    } , message = function(m) {
+                        NA
+                    }, error    = function(e) {
+                        NA
+                    })
+
+                    if (!is.data.frame(testhsd[1])) {
+                        output2[[k]]=NA
+                    }
+                } else {
+                    output2[[k]]=NA
+                }
+            }
+
+            return(output2)
+        })
+
+        p_value=lapply(output,function(x) {
+            x=as.data.frame(x)
+            return(x$p.value)
+        })
+        ln=length(p_value[[1]])
+        p_value=lapply(p_value,function(x){
+            if (length(x)!=ln) {
+                return(p_value[[1]]*NA)
+            } else {
+                return(x)
+            }
+        })
+
+        p_value=do.call("rbind",p_value)
+        p_value=data.frame(p_value)
+        colnames(p_value)=as.data.frame(output[[1]])$contrast
+
+        # fdr correct
+        M$p_value=apply(p_value,2,p.adjust,method=M$mtc)
+
+        M$significant=M$p_value<M$alpha
+
+        # reset contrasts
+        options(O)
+
+        return(M)
+    }
 )