miga-base 1.2.17.1 → 1.2.17.2

Sign up to get free protection for your applications and to get access to all the features.
Files changed (91) hide show
  1. checksums.yaml +4 -4
  2. data/lib/miga/version.rb +2 -2
  3. data/utils/enveomics/Manifest/Tasks/mapping.json +39 -11
  4. data/utils/enveomics/Manifest/Tasks/remote.json +2 -1
  5. data/utils/enveomics/Scripts/BedGraph.tad.rb +98 -53
  6. data/utils/enveomics/Scripts/SRA.download.bash +14 -2
  7. data/utils/enveomics/Tests/low-cov.bg.gz +0 -0
  8. data/utils/enveomics/enveomics.R/DESCRIPTION +5 -5
  9. data/utils/enveomics/enveomics.R/R/autoprune.R +99 -87
  10. data/utils/enveomics/enveomics.R/R/barplot.R +116 -97
  11. data/utils/enveomics/enveomics.R/R/cliopts.R +65 -59
  12. data/utils/enveomics/enveomics.R/R/df2dist.R +96 -58
  13. data/utils/enveomics/enveomics.R/R/growthcurve.R +166 -148
  14. data/utils/enveomics/enveomics.R/R/recplot.R +201 -136
  15. data/utils/enveomics/enveomics.R/R/recplot2.R +371 -304
  16. data/utils/enveomics/enveomics.R/R/tribs.R +318 -263
  17. data/utils/enveomics/enveomics.R/R/utils.R +30 -20
  18. data/utils/enveomics/enveomics.R/man/enve.TRIBS-class.Rd +4 -3
  19. data/utils/enveomics/enveomics.R/man/enve.TRIBS.merge.Rd +2 -2
  20. data/utils/enveomics/enveomics.R/man/enve.TRIBStest-class.Rd +3 -3
  21. data/utils/enveomics/enveomics.R/man/enve.__prune.iter.Rd +7 -4
  22. data/utils/enveomics/enveomics.R/man/enve.__prune.reduce.Rd +7 -4
  23. data/utils/enveomics/enveomics.R/man/enve.__tribs.Rd +4 -0
  24. data/utils/enveomics/enveomics.R/man/enve.barplot.Rd +25 -17
  25. data/utils/enveomics/enveomics.R/man/enve.col.alpha.Rd +10 -0
  26. data/utils/enveomics/enveomics.R/man/enve.col2alpha.Rd +8 -2
  27. data/utils/enveomics/enveomics.R/man/enve.df2dist.Rd +14 -0
  28. data/utils/enveomics/enveomics.R/man/enve.df2dist.group.Rd +20 -1
  29. data/utils/enveomics/enveomics.R/man/enve.df2dist.list.Rd +2 -3
  30. data/utils/enveomics/enveomics.R/man/enve.growthcurve.Rd +5 -2
  31. data/utils/enveomics/enveomics.R/man/enve.recplot.Rd +50 -42
  32. data/utils/enveomics/enveomics.R/man/enve.recplot2.ANIr.Rd +5 -2
  33. data/utils/enveomics/enveomics.R/man/enve.recplot2.__counts.Rd +3 -0
  34. data/utils/enveomics/enveomics.R/man/enve.recplot2.__peakHist.Rd +3 -0
  35. data/utils/enveomics/enveomics.R/man/enve.recplot2.__whichClosestPeak.Rd +3 -0
  36. data/utils/enveomics/enveomics.R/man/enve.recplot2.changeCutoff.Rd +3 -0
  37. data/utils/enveomics/enveomics.R/man/enve.recplot2.compareIdentities.Rd +9 -4
  38. data/utils/enveomics/enveomics.R/man/enve.recplot2.corePeak.Rd +3 -0
  39. data/utils/enveomics/enveomics.R/man/enve.recplot2.extractWindows.Rd +3 -3
  40. data/utils/enveomics/enveomics.R/man/enve.recplot2.findPeaks.Rd +0 -2
  41. data/utils/enveomics/enveomics.R/man/enve.recplot2.findPeaks.__em_e.Rd +4 -0
  42. data/utils/enveomics/enveomics.R/man/enve.recplot2.findPeaks.__em_m.Rd +5 -0
  43. data/utils/enveomics/enveomics.R/man/enve.recplot2.findPeaks.__emauto_one.Rd +11 -7
  44. data/utils/enveomics/enveomics.R/man/enve.recplot2.findPeaks.__mow_one.Rd +5 -1
  45. data/utils/enveomics/enveomics.R/man/enve.recplot2.findPeaks.__mower.Rd +3 -0
  46. data/utils/enveomics/enveomics.R/man/enve.recplot2.findPeaks.mower.Rd +2 -2
  47. data/utils/enveomics/enveomics.R/man/enve.recplot2.windowDepthThreshold.Rd +3 -3
  48. data/utils/enveomics/enveomics.R/man/enve.tribs.Rd +2 -2
  49. data/utils/enveomics/enveomics.R/man/plot.enve.GrowthCurve.Rd +3 -0
  50. data/utils/enveomics/enveomics.R/man/plot.enve.TRIBS.Rd +3 -0
  51. data/utils/enveomics/enveomics.R/man/plot.enve.TRIBStest.Rd +6 -3
  52. data/utils/enveomics/enveomics.R/man/plot.enve.recplot2.Rd +2 -2
  53. data/utils/enveomics/enveomics.R/man/summary.enve.GrowthCurve.Rd +3 -0
  54. data/utils/enveomics/enveomics.R/man/summary.enve.TRIBS.Rd +3 -0
  55. data/utils/enveomics/enveomics.R/man/summary.enve.TRIBStest.Rd +3 -0
  56. metadata +3 -37
  57. data/utils/enveomics/Pipelines/assembly.pbs/CONFIG.mock.bash +0 -69
  58. data/utils/enveomics/Pipelines/assembly.pbs/FastA.N50.pl +0 -1
  59. data/utils/enveomics/Pipelines/assembly.pbs/FastA.filterN.pl +0 -1
  60. data/utils/enveomics/Pipelines/assembly.pbs/FastA.length.pl +0 -1
  61. data/utils/enveomics/Pipelines/assembly.pbs/README.md +0 -189
  62. data/utils/enveomics/Pipelines/assembly.pbs/RUNME-2.bash +0 -112
  63. data/utils/enveomics/Pipelines/assembly.pbs/RUNME-3.bash +0 -23
  64. data/utils/enveomics/Pipelines/assembly.pbs/RUNME-4.bash +0 -44
  65. data/utils/enveomics/Pipelines/assembly.pbs/RUNME.bash +0 -50
  66. data/utils/enveomics/Pipelines/assembly.pbs/kSelector.R +0 -37
  67. data/utils/enveomics/Pipelines/assembly.pbs/newbler.pbs +0 -68
  68. data/utils/enveomics/Pipelines/assembly.pbs/newbler_preparator.pl +0 -49
  69. data/utils/enveomics/Pipelines/assembly.pbs/soap.pbs +0 -80
  70. data/utils/enveomics/Pipelines/assembly.pbs/stats.pbs +0 -57
  71. data/utils/enveomics/Pipelines/assembly.pbs/velvet.pbs +0 -63
  72. data/utils/enveomics/Pipelines/blast.pbs/01.pbs.bash +0 -38
  73. data/utils/enveomics/Pipelines/blast.pbs/02.pbs.bash +0 -73
  74. data/utils/enveomics/Pipelines/blast.pbs/03.pbs.bash +0 -21
  75. data/utils/enveomics/Pipelines/blast.pbs/BlastTab.recover_job.pl +0 -72
  76. data/utils/enveomics/Pipelines/blast.pbs/CONFIG.mock.bash +0 -98
  77. data/utils/enveomics/Pipelines/blast.pbs/FastA.split.pl +0 -1
  78. data/utils/enveomics/Pipelines/blast.pbs/README.md +0 -127
  79. data/utils/enveomics/Pipelines/blast.pbs/RUNME.bash +0 -109
  80. data/utils/enveomics/Pipelines/blast.pbs/TASK.check.bash +0 -128
  81. data/utils/enveomics/Pipelines/blast.pbs/TASK.dry.bash +0 -16
  82. data/utils/enveomics/Pipelines/blast.pbs/TASK.eo.bash +0 -22
  83. data/utils/enveomics/Pipelines/blast.pbs/TASK.pause.bash +0 -26
  84. data/utils/enveomics/Pipelines/blast.pbs/TASK.run.bash +0 -89
  85. data/utils/enveomics/Pipelines/blast.pbs/sentinel.pbs.bash +0 -29
  86. data/utils/enveomics/Pipelines/idba.pbs/README.md +0 -49
  87. data/utils/enveomics/Pipelines/idba.pbs/RUNME.bash +0 -95
  88. data/utils/enveomics/Pipelines/idba.pbs/run.pbs +0 -56
  89. data/utils/enveomics/Pipelines/trim.pbs/README.md +0 -54
  90. data/utils/enveomics/Pipelines/trim.pbs/RUNME.bash +0 -70
  91. data/utils/enveomics/Pipelines/trim.pbs/run.pbs +0 -130
@@ -36,9 +36,10 @@
36
36
  #' selection occur in the same transformed space. However, it's useful to
37
37
  #' compare randomly subsampled sets against a selected set of objects. This
38
38
  #' is intended to identify overdispersion or overclustering (see
39
- #' \code{\link{enve.TRIBStest}}) of a subset against the entire collection of objects
40
- #' with minimum impact of sampling biases. This object can be produced by
41
- #' \code{\link{enve.tribs}} and supports S4 methods \code{plot} and \code{summary}.
39
+ #' \code{\link{enve.TRIBStest}}) of a subset against the entire collection of
40
+ #' objects with minimum impact of sampling biases. This object can be produced
41
+ #' by \code{\link{enve.tribs}} and supports S4 methods \code{plot} and
42
+ #' \code{summary}.
42
43
  #'
43
44
  #' @slot distance \code{(numeric)} Centrality measurement of the distances
44
45
  #' between the selected objects (without subsampling).
@@ -73,9 +74,9 @@ enve.TRIBS <- setClass("enve.TRIBS",
73
74
  #' Enveomics: TRIBS Test S4 Class
74
75
  #'
75
76
  #' Test of significance of overclustering or overdispersion in a selected
76
- #' set of objects with respect to the entire set (see \code{\link{enve.TRIBS}}). This
77
- #' object can be produced by \code{\link{enve.tribs.test}} and supports S4 methods
78
- #' \code{plot} and \code{summary}.
77
+ #' set of objects with respect to the entire set (see \code{\link{enve.TRIBS}}).
78
+ #' This object can be produced by \code{\link{enve.tribs.test}} and supports S4
79
+ #' methods \code{plot} and \code{summary}.
79
80
  #'
80
81
  #' @slot pval.gt \code{(numeric)}
81
82
  #' P-value for the overdispersion test.
@@ -101,18 +102,19 @@ enve.TRIBS <- setClass("enve.TRIBS",
101
102
  #'
102
103
  #' @exportClass
103
104
 
104
- enve.TRIBStest <- setClass("enve.TRIBStest",
105
- representation(
106
- pval.gt='numeric',
107
- pval.lt='numeric',
108
- all.dist='numeric',
109
- sel.dist='numeric',
110
- diff.dist='numeric',
111
- dist.mids='numeric',
112
- diff.mids='numeric',
113
- call='call')
114
- ,package='enveomics.R'
115
- );
105
+ enve.TRIBStest <- setClass(
106
+ "enve.TRIBStest",
107
+ representation(
108
+ pval.gt = "numeric",
109
+ pval.lt = "numeric",
110
+ all.dist = "numeric",
111
+ sel.dist = "numeric",
112
+ diff.dist = "numeric",
113
+ dist.mids = "numeric",
114
+ diff.mids = "numeric",
115
+ call = "call"
116
+ ), package = "enveomics.R"
117
+ )
116
118
 
117
119
  #==============> Define S4 methods
118
120
 
@@ -125,24 +127,22 @@ enve.TRIBStest <- setClass("enve.TRIBStest",
125
127
  #' @param ...
126
128
  #' No additional parameters are currently supported.
127
129
  #'
130
+ #' @return No return value.
131
+ #'
128
132
  #' @author Luis M. Rodriguez-R [aut, cre]
129
133
  #'
130
134
  #' @method summary enve.TRIBS
131
- #' @export
132
-
133
- summary.enve.TRIBS <- function
134
- (object,
135
- ...
136
- ){
137
- cat('===[ enve.TRIBS ]-------------------------\n');
138
- cat('Selected',attr(object,'selSize'),'of',
139
- attr(object,'spaceSize'),'objects in',
140
- attr(object,'dimensions'),'dimensions.\n');
141
- cat('Collected',length(attr(object,'subsamples')),'subsamples with',
142
- nrow(attr(object,'distances')),'replicates each.\n');
143
- cat('------------------------------------------\n');
144
- cat('call:',as.character(attr(object,'call')),'\n');
145
- cat('------------------------------------------\n');
135
+ #' @export
136
+ summary.enve.TRIBS <- function(object, ...) {
137
+ cat("===[ enve.TRIBS ]-------------------------\n")
138
+ cat("Selected", attr(object, "selSize"), "of",
139
+ attr(object, "spaceSize"), "objects in",
140
+ attr(object, "dimensions"), "dimensions.\n")
141
+ cat("Collected", length(attr(object, "subsamples")), "subsamples with",
142
+ nrow(attr(object, "distances")), "replicates each.\n")
143
+ cat("------------------------------------------\n")
144
+ cat("call:", as.character(attr(object, "call")), "\n")
145
+ cat("------------------------------------------\n")
146
146
  }
147
147
 
148
148
  #' Enveomics: TRIBS Plot
@@ -171,46 +171,57 @@ summary.enve.TRIBS <- function
171
171
  #' @param ...
172
172
  #' Any additional parameters supported by \code{plot}.
173
173
  #'
174
+ #' @return No return value.
175
+ #'
174
176
  #' @author Luis M. Rodriguez-R [aut, cre]
175
177
  #'
176
178
  #' @method plot enve.TRIBS
177
179
  #' @export
178
180
 
179
- plot.enve.TRIBS <- function
180
- (x,
181
- new=TRUE,
182
- type=c('boxplot', 'points'),
183
- col='#00000044',
184
- pt.cex=1/2,
185
- pt.pch=19,
186
- pt.col=col,
187
- ln.col=col,
188
- ...
189
- ){
190
- type <- match.arg(type);
191
- plot.opts <- list(xlim=range(attr(x,'subsamples'))*attr(x,'selSize'),
192
- ylim=range(attr(x,'distances')), ..., t='n', x=1);
193
- if(new) do.call(plot, plot.opts);
194
- abline(h=attr(x,'distance'), lty=3, col=ln.col);
195
- replicates <- nrow(attr(x,'distances'));
196
- if(type=='points'){
197
- for(i in 1:ncol(attr(x,'distances')))
198
- points(rep(round(attr(x,'subsamples')[i]*attr(x,'selSize')),
199
- replicates), attr(x,'distances')[,i], cex=pt.cex, pch=pt.pch,
200
- col=pt.col);
201
- }else{
202
- stats <- matrix(NA, nrow=7, ncol=ncol(attr(x,'distances')));
203
- for(i in 1:ncol(attr(x,'distances'))){
204
- b <- boxplot.stats(attr(x,'distances')[,i]);
205
- points(rep(round(attr(x,'subsamples')[i]*attr(x,'selSize')),
206
- length(b$out)), b$out, cex=pt.cex, pch=pt.pch, col=pt.col);
207
- stats[, i] <- c(b$conf, b$stats[c(1,5,2,4,3)]);
181
+ plot.enve.TRIBS <- function(
182
+ x,
183
+ new = TRUE,
184
+ type = c("boxplot", "points"),
185
+ col = "#00000044",
186
+ pt.cex = 1/2,
187
+ pt.pch = 19,
188
+ pt.col = col,
189
+ ln.col = col,
190
+ ...
191
+ ) {
192
+ type <- match.arg(type)
193
+ plot.opts <- list(
194
+ xlim = range(attr(x, "subsamples")) * attr(x, "selSize"),
195
+ ylim = range(attr(x, "distances")), ..., t = "n", x = 1
196
+ )
197
+ if (new) do.call(plot, plot.opts)
198
+ abline(h = attr(x, "distance"), lty = 3, col = ln.col)
199
+ replicates <- nrow(attr(x, "distances"))
200
+ if (type == "points") {
201
+ for (i in 1:ncol(attr(x, "distances")))
202
+ points(
203
+ rep(round(attr(x, "subsamples")[i] * attr(x, "selSize")), replicates),
204
+ attr(x, "distances")[, i],
205
+ cex = pt.cex, pch = pt.pch, col = pt.col
206
+ )
207
+ } else {
208
+ stats <- matrix(NA, nrow = 7, ncol = ncol(attr(x, "distances")))
209
+ for (i in 1:ncol(attr(x, "distances"))) {
210
+ b <- boxplot.stats(attr(x, "distances")[, i])
211
+ points(
212
+ rep(
213
+ round(attr(x, "subsamples")[i] * attr(x, "selSize")), length(b$out)
214
+ ),
215
+ b$out, cex = pt.cex, pch = pt.pch, col = pt.col
216
+ )
217
+ stats[, i] <- c(b$conf, b$stats[c(1, 5, 2, 4, 3)])
208
218
  }
209
- x <- round(attr(x,'subsamples')*attr(x,'selSize'))
210
- for(i in c(1,3,5))
211
- polygon(c(x, rev(x)), c(stats[i,], rev(stats[i+1,])), border=NA,
212
- col=col);
213
- lines(x, stats[7,], col=ln.col, lwd=2);
219
+ x <- round(attr(x, "subsamples") * attr(x, "selSize"))
220
+ for (i in c(1, 3, 5))
221
+ polygon(
222
+ c(x, rev(x)), c(stats[i, ], rev(stats[i + 1, ])), border = NA, col = col
223
+ )
224
+ lines(x, stats[7, ], col = ln.col, lwd = 2)
214
225
  }
215
226
  }
216
227
 
@@ -223,37 +234,36 @@ plot.enve.TRIBS <- function
223
234
  #' @param ...
224
235
  #' No additional parameters are currently supported.
225
236
  #'
237
+ #' @return No return value.
238
+ #'
226
239
  #' @author Luis M. Rodriguez-R [aut, cre]
227
240
  #'
228
241
  #' @method summary enve.TRIBStest
229
- #' @export
242
+ #' @export
230
243
 
231
- summary.enve.TRIBStest <- function
232
- (object,
233
- ...
234
- ){
235
- cat('===[ enve.TRIBStest ]---------------------\n');
236
- cat('Alternative hypothesis:\n');
237
- cat(' The distances in the selection are\n');
238
- if(attr(object, 'pval.gt') > attr(object, 'pval.lt')){
239
- cat(' smaller than in the entire dataset\n (overclustering)\n');
240
- }else{
241
- cat(' larger than in the entire dataset\n (overdispersion)\n');
244
+ summary.enve.TRIBStest <- function(object, ...) {
245
+ cat("===[ enve.TRIBStest ]---------------------\n")
246
+ cat("Alternative hypothesis:\n")
247
+ cat(" The distances in the selection are\n")
248
+ if (attr(object, "pval.gt") > attr(object, "pval.lt")) {
249
+ cat(" smaller than in the entire dataset\n (overclustering)\n")
250
+ } else {
251
+ cat(" larger than in the entire dataset\n (overdispersion)\n")
242
252
  }
243
- p.val <- min(attr(object, 'pval.gt'), attr(object, 'pval.lt'));
244
- if(p.val==0){
245
- diff.dist <- attr(object, 'diff.dist');
246
- p.val.lim <- min(diff.dist[diff.dist>0]);
247
- cat('\n P-value <= ', signif(p.val.lim, 4), sep='');
248
- }else{
249
- p.val.lim <- p.val;
250
- cat('\n P-value: ', signif(p.val, 4), sep='');
253
+ p.val <- min(attr(object, "pval.gt"), attr(object, "pval.lt"))
254
+ if (p.val == 0) {
255
+ diff.dist <- attr(object, "diff.dist")
256
+ p.val.lim <- min(diff.dist[diff.dist > 0])
257
+ cat("\n P-value <= ", signif(p.val.lim, 4), sep = "")
258
+ } else {
259
+ p.val.lim <- p.val
260
+ cat("\n P-value: ", signif(p.val, 4), sep = "")
251
261
  }
252
- cat(' ', ifelse(p.val.lim<=0.01, "**", ifelse(p.val.lim<=0.05, "*", "")),
253
- '\n', sep='');
254
- cat('------------------------------------------\n');
255
- cat('call:',as.character(attr(object,'call')),'\n');
256
- cat('------------------------------------------\n');
262
+ cat(" ", ifelse(p.val.lim <= 0.01, "**",
263
+ ifelse(p.val.lim<=0.05, "*", "")), "\n", sep = "")
264
+ cat("------------------------------------------\n")
265
+ cat("call:", as.character(attr(object, "call")), "\n")
266
+ cat("------------------------------------------\n")
257
267
  }
258
268
 
259
269
  #' Enveomics: TRIBS Plot Test
@@ -263,9 +273,9 @@ summary.enve.TRIBStest <- function
263
273
  #' @param x
264
274
  #' \code{\link{enve.TRIBStest}} object to plot.
265
275
  #' @param type
266
- #' What to plot. \code{overlap} generates a plot of the two contrasting empirical
267
- #' PDFs (to compare against each other), \code{difference} produces a plot of the
268
- #' differences between the empirical PDFs (to compare against zero).
276
+ #' What to plot. \code{overlap} generates a plot of the two contrasting
277
+ #' empirical PDFs (to compare against each other), \code{difference} produces a
278
+ #' plot of the differences between the empirical PDFs (to compare against zero).
269
279
  #' @param col
270
280
  #' Main color of the plot if type=\code{difference}.
271
281
  #' @param col1
@@ -281,48 +291,61 @@ summary.enve.TRIBStest <- function
281
291
  #' @param ...
282
292
  #' Any other graphical arguments.
283
293
  #'
294
+ #' @return No return value.
295
+ #'
284
296
  #' @author Luis M. Rodriguez-R [aut, cre]
285
297
  #'
286
298
  #' @method plot enve.TRIBStest
287
299
  #' @export
288
300
 
289
- plot.enve.TRIBStest <- function
290
- (x,
291
- type=c('overlap', 'difference'),
292
- col='#00000044',
293
- col1=col,
294
- col2='#44001144',
295
- ylab='Probability',
296
- xlim=range(attr(x, 'dist.mids')),
297
- ylim=c(0,max(c(attr(x, 'all.dist'), attr(x, 'sel.dist')))),
298
- ...
299
- ){
300
- type <- match.arg(type);
301
- if(type=='overlap'){
302
- plot.opts <- list(xlim=xlim, ylim=ylim, ylab=ylab, ..., t='n', x=1);
303
- do.call(plot, plot.opts);
304
- bins <- length(attr(x, 'dist.mids'))
305
- polygon(attr(x, 'dist.mids')[c(1, 1:bins, bins)],
306
- c(0,attr(x, 'all.dist'),0), col=col1,
307
- border=do.call(rgb, as.list(c(col2rgb(col1)/256, 0.5))));
308
- polygon(attr(x, 'dist.mids')[c(1, 1:bins, bins)],
309
- c(0,attr(x, 'sel.dist'),0), col=col2,
310
- border=do.call(rgb, as.list(c(col2rgb(col2)/256, 0.5))));
311
- }else{
312
- plot.opts <- list(xlim=range(attr(x, 'diff.mids')),
313
- ylim=c(0,max(attr(x, 'diff.dist'))), ylab=ylab, ..., t='n', x=1);
314
- do.call(plot, plot.opts);
315
- bins <- length(attr(x, 'diff.mids'));
316
- polygon(attr(x, 'diff.mids')[c(1, 1:bins, bins)],
317
- c(0,attr(x, 'diff.dist'),0), col=col,
318
- border=do.call(rgb, as.list(c(col2rgb(col)/256, 0.5))));
301
+ plot.enve.TRIBStest <- function(
302
+ x,
303
+ type =c("overlap", "difference"),
304
+ col = "#00000044",
305
+ col1 = col,
306
+ col2 = "#44001144",
307
+ ylab = "Probability",
308
+ xlim = range(attr(x, "dist.mids")),
309
+ ylim = c(0, max(c(attr(x, "all.dist"), attr(x, "sel.dist")))),
310
+ ...
311
+ ) {
312
+ type <- match.arg(type)
313
+ if (type == "overlap") {
314
+ plot.opts <- list(
315
+ xlim = xlim, ylim = ylim, ylab = ylab, ..., t = "n", x = 1
316
+ )
317
+ do.call(plot, plot.opts)
318
+ bins <- length(attr(x, "dist.mids"))
319
+ polygon(
320
+ attr(x, "dist.mids")[c(1, 1:bins, bins)],
321
+ c(0, attr(x, "all.dist"), 0), col = col1,
322
+ border = do.call(rgb, as.list(c(col2rgb(col1) / 256, 0.5)))
323
+ )
324
+ polygon(
325
+ attr(x, "dist.mids")[c(1, 1:bins, bins)],
326
+ c(0, attr(x, "sel.dist"), 0), col = col2,
327
+ border = do.call(rgb, as.list(c(col2rgb(col2) / 256, 0.5)))
328
+ )
329
+ } else {
330
+ plot.opts <- list(
331
+ xlim = range(attr(x, "diff.mids")),
332
+ ylim = c(0,max(attr(x, 'diff.dist'))),
333
+ ylab = ylab, ..., t = "n", x = 1
334
+ )
335
+ do.call(plot, plot.opts)
336
+ bins <- length(attr(x, "diff.mids"))
337
+ polygon(
338
+ attr(x, "diff.mids")[c(1, 1:bins, bins)],
339
+ c(0, attr(x, "diff.dist"), 0), col = col,
340
+ border = do.call(rgb, as.list(c(col2rgb(col) / 256, 0.5)))
341
+ )
319
342
  }
320
343
  }
321
344
 
322
345
  #' Enveomics: TRIBS Merge
323
346
  #'
324
- #' Merges two \code{\link{enve.TRIBS}} objects generated from the same objects at
325
- #' different subsampling levels.
347
+ #' Merges two \code{\link{enve.TRIBS}} objects generated from the same objects
348
+ #' at different subsampling levels.
326
349
  #'
327
350
  #' @param x
328
351
  #' First \code{\link{enve.TRIBS}} object.
@@ -335,35 +358,35 @@ plot.enve.TRIBStest <- function
335
358
  #'
336
359
  #' @export
337
360
 
338
- enve.TRIBS.merge <- function
339
- (x,
340
- y
341
- ){
361
+ enve.TRIBS.merge <- function(x, y) {
342
362
  # Check consistency
343
- if(attr(x,'distance') != attr(y,'distance'))
344
- stop('Total distances in objects are different.');
345
- if(any(attr(x,'points') != attr(y,'points')))
346
- stop('Points in objects are different.');
347
- if(attr(x,'spaceSize') != attr(y,'spaceSize'))
348
- stop('Space size in objects are different.');
349
- if(attr(x,'selSize') != attr(y,'selSize'))
350
- stop('Selection size in objects are different.');
351
- if(attr(x,'dimensions') != attr(y,'dimensions'))
352
- stop('Dimensions in objects are different.');
353
- if(nrow(attr(x,'distances')) != nrow(attr(y,'distances')))
354
- stop('Replicates in objects are different.');
363
+ if (attr(x, "distance") != attr(y, "distance"))
364
+ stop("Total distances in objects are different.")
365
+ if (any(attr(x, "points") != attr(y, "points")))
366
+ stop("Points in objects are different.")
367
+ if (attr(x, "spaceSize") != attr(y, "spaceSize"))
368
+ stop("Space size in objects are different.")
369
+ if (attr(x, "selSize") != attr(y, "selSize"))
370
+ stop("Selection size in objects are different.")
371
+ if (attr(x, "dimensions") != attr(y, "dimensions"))
372
+ stop("Dimensions in objects are different.")
373
+ if (nrow(attr(x, "distances")) != nrow(attr(y, "distances")))
374
+ stop("Replicates in objects are different.")
375
+
355
376
  # Merge
356
- a <- attr(x,'subsamples');
357
- b <- attr(y,'subsamples');
358
- o <- order(c(a,b));
359
- o <- o[!duplicated(c(a,b)[o])] ;
360
- d <- cbind(attr(x,'distances'), attr(y,'distances'))[, o] ;
361
- z <- new('enve.TRIBS',
362
- distance=attr(x,'distance'), points=attr(x,'points'),
363
- distances=d, spaceSize=attr(x,'spaceSize'),
364
- selSize=attr(x,'selSize'), dimensions=attr(x,'dimensions'),
365
- subsamples=c(a,b)[o], call=match.call());
366
- return(z) ;
377
+ a <- attr(x, "subsamples")
378
+ b <- attr(y, "subsamples")
379
+ o <- order(c(a, b))
380
+ o <- o[!duplicated(c(a, b)[o])]
381
+ d <- cbind(attr(x, "distances"), attr(y, "distances"))[, o]
382
+ z <- new(
383
+ "enve.TRIBS",
384
+ distance = attr(x, "distance"), points = attr(x, "points"),
385
+ distances = d, spaceSize = attr(x, "spaceSize"),
386
+ selSize = attr(x, "selSize"), dimensions = attr(x, "dimensions"),
387
+ subsamples = c(a, b)[o], call = match.call()
388
+ )
389
+ return(z)
367
390
  }
368
391
 
369
392
  #==============> Define core functions
@@ -389,44 +412,53 @@ enve.TRIBS.merge <- function
389
412
  #'
390
413
  #' @export
391
414
 
392
- enve.tribs.test <- function
393
- (dist,
394
- selection,
395
- bins=50,
396
- ...
397
- ){
398
- s.tribs <- enve.tribs(dist, selection, subsamples=c(0,1), ...);
399
- a.tribs <- enve.tribs(dist,
400
- subsamples=c(0,attr(s.tribs, 'selSize')/attr(s.tribs, 'spaceSize')), ...);
401
- s.dist <- attr(s.tribs, 'distances')[, 2];
402
- a.dist <- attr(a.tribs, 'distances')[, 2];
403
- range <- range(c(s.dist, a.dist));
404
- a.f <- hist(a.dist, breaks=seq(range[1], range[2], length.out=bins),
405
- plot=FALSE);
406
- s.f <- hist(s.dist, breaks=seq(range[1], range[2], length.out=bins),
407
- plot=FALSE);
408
- zp.f <- c(); zz.f <- 0; zn.f <- c();
409
- p.x <- a.f$counts/sum(a.f$counts);
410
- p.y <- s.f$counts/sum(s.f$counts);
411
- for(z in 1:length(a.f$mids)){
412
- zn.f[z] <- 0;
413
- zz.f <- 0;
414
- zp.f[z] <- 0;
415
- for(k in 1:length(a.f$mids)){
416
- if(z < k){
417
- zp.f[z] <- zp.f[z] + p.x[k]*p.y[k-z];
418
- zn.f[z] <- zn.f[z] + p.x[k-z]*p.y[k];
415
+ enve.tribs.test <- function(dist, selection, bins = 50, ...) {
416
+ s.tribs <- enve.tribs(dist, selection, subsamples = c(0,1), ...)
417
+ a.tribs <- enve.tribs(
418
+ dist,
419
+ subsamples = c(0, attr(s.tribs, "selSize") / attr(s.tribs, "spaceSize")),
420
+ ...
421
+ )
422
+ s.dist <- attr(s.tribs, "distances")[, 2]
423
+ a.dist <- attr(a.tribs, "distances")[, 2]
424
+ range <- range(c(s.dist, a.dist))
425
+ a.f <- hist(
426
+ a.dist, breaks = seq(range[1], range[2], length.out = bins), plot = FALSE
427
+ )
428
+ s.f <- hist(
429
+ s.dist, breaks = seq(range[1], range[2], length.out = bins), plot = FALSE
430
+ )
431
+ zp.f <- c()
432
+ zz.f <- 0
433
+ zn.f <- c()
434
+ p.x <- a.f$counts / sum(a.f$counts)
435
+ p.y <- s.f$counts / sum(s.f$counts)
436
+ for (z in 1:length(a.f$mids)) {
437
+ zn.f[z] <- 0
438
+ zz.f <- 0
439
+ zp.f[z] <- 0
440
+ for (k in 1:length(a.f$mids)) {
441
+ if (z < k) {
442
+ zp.f[z] <- zp.f[z] + p.x[k] * p.y[k-z]
443
+ zn.f[z] <- zn.f[z] + p.x[k-z] * p.y[k]
419
444
  }
420
- zz.f <- zz.f + p.x[k]*p.y[k];
445
+ zz.f <- zz.f + p.x[k] * p.y[k]
421
446
  }
422
447
  }
423
- return(new('enve.TRIBStest',
424
- pval.gt=sum(c(zz.f, zp.f)), pval.lt=sum(c(zz.f, zn.f)),
425
- all.dist=p.x, sel.dist=p.y, diff.dist=c(rev(zn.f), zz.f, zp.f),
426
- dist.mids=a.f$mids,
427
- diff.mids=seq(diff(range(a.f$mids)), -diff(range(a.f$mids)),
428
- length.out=1+2*length(a.f$mids)),
429
- call=match.call()));
448
+ return(
449
+ new(
450
+ "enve.TRIBStest",
451
+ pval.gt = sum(c(zz.f, zp.f)), pval.lt = sum(c(zz.f, zn.f)),
452
+ all.dist = p.x, sel.dist = p.y, diff.dist = c(rev(zn.f), zz.f, zp.f),
453
+ dist.mids = a.f$mids,
454
+ diff.mids = seq(
455
+ diff(range(a.f$mids)),
456
+ -diff(range(a.f$mids)),
457
+ length.out = 1 + 2 * length(a.f$mids)
458
+ ),
459
+ call=match.call()
460
+ )
461
+ )
430
462
  }
431
463
 
432
464
  #' Enveomics: TRIBS
@@ -468,8 +500,8 @@ enve.tribs.test <- function
468
500
  #' dimensions as columns.
469
501
  #' @param pre.tribs
470
502
  #' Optional. If passed, the points are recovered from this object (except if
471
- #' \code{points} is also passed. This should be an \code{\link{enve.TRIBS}} object
472
- #' estimated on the same objects (the selection is unimportant).
503
+ #' \code{points} is also passed. This should be an \code{\link{enve.TRIBS}}
504
+ #' object estimated on the same objects (the selection is unimportant).
473
505
  #'
474
506
  #' @return Returns an \code{\link{enve.TRIBS}} object.
475
507
  #'
@@ -477,69 +509,87 @@ enve.tribs.test <- function
477
509
  #'
478
510
  #' @export
479
511
 
480
- enve.tribs <- function
481
- (dist,
482
- selection=labels(dist),
483
- replicates=1000,
484
- summary.fx=median,
485
- dist.method='euclidean',
486
- subsamples=seq(0,1,by=0.01),
487
- dimensions=ceiling(length(selection)*0.05),
488
- metaMDS.opts=list(),
489
- threads=2,
490
- verbosity=1,
491
- points,
492
- pre.tribs
493
- ){
494
- if(!is(dist, 'dist'))
495
- stop('`dist` parameter must be a `dist` object.');
512
+ enve.tribs <- function(
513
+ dist,
514
+ selection = labels(dist),
515
+ replicates = 1000,
516
+ summary.fx = median,
517
+ dist.method = "euclidean",
518
+ subsamples = seq(0, 1, by = 0.01),
519
+ dimensions = ceiling(length(selection) * 0.05),
520
+ metaMDS.opts = list(),
521
+ threads = 2,
522
+ verbosity = 1,
523
+ points,
524
+ pre.tribs
525
+ ) {
526
+ # Sanity checks
527
+ if (!is(dist, "dist"))
528
+ stop("`dist` parameter must be a `dist` object.")
529
+
496
530
  # 1. NMDS
497
- if(missing(points)){
498
- if(missing(pre.tribs)){
499
- if(verbosity > 0)
500
- cat('===[ Estimating NMDS ]\n');
501
- if(!suppressPackageStartupMessages(
502
- requireNamespace("vegan", quietly=TRUE)))
503
- stop('Unavailable required package: `vegan`.');
504
- mds.args <- c(metaMDS.opts, list(comm=dist, k=dimensions,
505
- trace=verbosity));
506
- points <- do.call(vegan::metaMDS, mds.args)$points;
507
- }else{
508
- points <- attr(pre.tribs, 'points');
509
- dimensions <- ncol(points);
531
+ if (missing(points)) {
532
+ if (missing(pre.tribs)) {
533
+ if (verbosity > 0) cat("===[ Estimating NMDS ]\n")
534
+ if (!suppressPackageStartupMessages(
535
+ requireNamespace("vegan", quietly=TRUE))
536
+ ) stop("Unavailable required package: `vegan`.")
537
+ mds.args <- c(
538
+ metaMDS.opts,
539
+ list(comm = dist, k = dimensions, trace = verbosity)
540
+ )
541
+ points <- do.call(vegan::metaMDS, mds.args)$points
542
+ } else {
543
+ points <- attr(pre.tribs, "points")
544
+ dimensions <- ncol(points)
510
545
  }
511
- }else{
512
- points <- as.matrix(points);
513
- dimensions <- ncol(points);
546
+ } else {
547
+ points <- as.matrix(points)
548
+ dimensions <- ncol(points)
514
549
  }
550
+
515
551
  # 2. Pad ranges
516
- if(verbosity > 0) cat('===[ Padding ranges ]\n');
517
- dots <- matrix(NA, nrow=nrow(points), ncol=dimensions,
518
- dimnames=list(rownames(points), 1:dimensions));
519
- selection <- selection[!is.na(match(selection, rownames(dots)))];
520
- for(dim in 1:dimensions){
521
- dimRange <- range(points[,dim]) +
522
- c(-1,1)*diff(range(points[,1]))/length(selection);
523
- dots[, dim] <- (points[,dim]-dimRange[1])/diff(dimRange);
552
+ if (verbosity > 0) cat("===[ Padding ranges ]\n")
553
+ dots <- matrix(
554
+ NA, nrow = nrow(points), ncol = dimensions,
555
+ dimnames = list(rownames(points), 1:dimensions)
556
+ )
557
+ selection <- selection[!is.na(match(selection, rownames(dots)))]
558
+ for (dim in 1:dimensions) {
559
+ dimRange <- range(points[, dim]) + c(-1, 1) *
560
+ diff(range(points[, 1])) / length(selection)
561
+ dots[, dim] <- (points[, dim] - dimRange[1]) / diff(dimRange)
524
562
  }
563
+
525
564
  # 3. Select points and summarize distances
526
- if(verbosity > 0) cat('===[ Sub-sampling ]\n');
527
- distances <- matrix(NA, nrow=replicates, ncol=length(subsamples),
528
- dimnames=list(1:replicates, as.character(subsamples)));
529
- cl <- makeCluster(threads);
530
- for(frx in subsamples){
531
- if(verbosity > 1) cat('Sub-sampling at ',(frx*100),'%\n',sep='');
532
- distances[, as.character(frx)] = parSapply(cl, 1:replicates, enve.__tribs,
533
- frx, match(selection, rownames(dots)), dimensions, dots, dist.method,
534
- summary.fx, dist);
565
+ if (verbosity > 0) cat("===[ Sub-sampling ]\n")
566
+ distances <- matrix(
567
+ NA, nrow = replicates, ncol = length(subsamples),
568
+ dimnames = list(1:replicates, as.character(subsamples))
569
+ )
570
+ cl <- makeCluster(threads)
571
+ for (frx in subsamples) {
572
+ if (verbosity > 1) cat("Sub-sampling at ", (frx * 100), "%\n", sep = "")
573
+ distances[, as.character(frx)] <- parSapply(
574
+ cl, 1:replicates, enve.__tribs, frx,
575
+ match(selection, rownames(dots)), dimensions, dots, dist.method,
576
+ summary.fx, dist
577
+ )
535
578
  }
536
- stopCluster(cl);
579
+ stopCluster(cl)
580
+
537
581
  # 4. Build object and return
538
- return(new('enve.TRIBS',
539
- distance=do.call(summary.fx, list(as.matrix(dist)[selection, selection])),
540
- points=points, distances=distances, spaceSize=nrow(points),
541
- selSize=length(selection), dimensions=dimensions, subsamples=subsamples,
542
- call=match.call()));
582
+ return(
583
+ new(
584
+ "enve.TRIBS",
585
+ distance = do.call(
586
+ summary.fx, list(as.matrix(dist)[selection, selection])
587
+ ),
588
+ points = points, distances = distances, spaceSize = nrow(points),
589
+ selSize = length(selection), dimensions = dimensions,
590
+ subsamples = subsamples, call = match.call()
591
+ )
592
+ )
543
593
  }
544
594
 
545
595
  #' Enveomics: TRIBS - Internal Ancillary Function
@@ -555,29 +605,34 @@ enve.tribs <- function
555
605
  #' @param summary.fx Summary function
556
606
  #' @param dist Distance
557
607
  #'
608
+ #' @return A numeric indicating the \code{summary.fx} value applied to the
609
+ #' distance matrix subset
610
+ #'
558
611
  #' @author Luis M. Rodriguez-R [aut, cre]
559
612
  #'
560
613
  #' @export
561
614
 
562
- enve.__tribs <- function
563
- (rep, frx, selection, dimensions, dots, dist.method, summary.fx, dist){
564
- sample <- c();
565
- if(frx==0) return(0);
566
- for(point in 1:round(frx*length(selection))){
567
- rand.point <- runif(dimensions);
568
- closest.dot <- '';
569
- closest.dist <- Inf;
570
- for(dot in selection){
571
- dot.dist <- as.numeric(dist(matrix(c(rand.point, dots[dot,]), nrow=2,
572
- byrow=TRUE), method=dist.method));
573
- if(dot.dist < closest.dist){
574
- closest.dot <- dot;
575
- closest.dist <- dot.dist;
615
+ enve.__tribs <- function(
616
+ rep, frx, selection, dimensions, dots, dist.method, summary.fx, dist
617
+ ) {
618
+ sample <- c()
619
+ if (frx == 0) return(0)
620
+ for (point in 1:round(frx * length(selection))) {
621
+ rand.point <- runif(dimensions)
622
+ closest.dot <- ""
623
+ closest.dist <- Inf
624
+ for (dot in selection) {
625
+ dot.dist <- as.numeric(
626
+ dist(matrix(c(rand.point, dots[dot,]), nrow = 2, byrow = TRUE),
627
+ method = dist.method)
628
+ )
629
+ if (dot.dist < closest.dist) {
630
+ closest.dot <- dot
631
+ closest.dist <- dot.dist
576
632
  }
577
633
  }
578
- sample <- c(sample, closest.dot);
634
+ sample <- c(sample, closest.dot)
579
635
  }
580
- return( do.call(summary.fx, list(as.matrix(dist)[sample, sample])) );
636
+ return(do.call(summary.fx, list(as.matrix(dist)[sample, sample])))
581
637
  }
582
638
 
583
-