server.R 21 KB
Newer Older
Midoux Cedric's avatar
Midoux Cedric committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
library(shinydashboard)

shinyServer
(function(input, output, session)
{
  checkNull <- function(x) {
    if (!exists(as.character(substitute(x)))) {
      return(NULL)
    } else if (is.null(x)) {
      return(NULL)
    } else if (length(x) > 1) {
      return(x)
    }
    else if (x %in% c(0, "", NA, "NULL")) {
      return(NULL)
    } else {
      return(x)
    }
  }
  
  beautifulTable <- function(data)  {
    DT::datatable(
      data = data,
      rownames = FALSE,
      filter = "top",
      extensions = c("Buttons", "ColReorder", "FixedColumns"),
      options = list(
        dom = "lBtip",
        pageLength = 10,
Midoux Cedric's avatar
Midoux Cedric committed
30
        lengthMenu = list(c(10, 25, 50, 100, -1), list('10', '25', '50', '100', 'All')),
Midoux Cedric's avatar
Midoux Cedric committed
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
        buttons = list(
          'colvis',
          list(
            extend = 'collection',
            buttons = c('copy', 'csv', 'excel', 'pdf'),
            text = 'Download'
          )
        ),
        colReorder = TRUE,
        scrollX = TRUE,
        fixedColumns = list(leftColumns = 1, rightColumns = 0)
      ),
      width = "auto",
      height = "auto"
    )
  }
  
  source(
    "https://raw.githubusercontent.com/mahendra-mariadassou/phyloseq-extended/master/R/load-extra-functions.R"
  )
  
  data16S <- reactive({
Midoux Cedric's avatar
Midoux Cedric committed
53
    if (input$demo != "input")
Midoux Cedric's avatar
Midoux Cedric committed
54
    {
Midoux Cedric's avatar
Midoux Cedric committed
55
56
      load("demo/demo.RData")
      return(get(input$demo))
Midoux Cedric's avatar
Midoux Cedric committed
57
    }
Midoux Cedric's avatar
Midoux Cedric committed
58
59
60
61
62
63
64
65
66
    else {
      if (is.null(input$fileBiom))
      {
        return()
      }
      if (input$biomFormat == "std")
      {
        d <- import_biom(
          BIOMfilename = input$fileBiom$datapath,
Midoux Cedric's avatar
Midoux Cedric committed
67
68
          treefilename = input$fileTree$datapath# ,
          # refseqfilename = input$fileSeq$datapath
Midoux Cedric's avatar
Midoux Cedric committed
69
70
71
72
        )
      } else if (input$biomFormat == "frogs") {
        d <- import_frogs(
          biom = input$fileBiom$datapath,
Midoux Cedric's avatar
Midoux Cedric committed
73
74
          treefilename = input$fileTree$datapath# ,
          # refseqfilename = input$fileSeq$datapath
Midoux Cedric's avatar
Midoux Cedric committed
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
        )
      }
      
      colnames(tax_table(d)) <-
        c("Kingdom",
          "Phylum",
          "Class",
          "Order",
          "Family",
          "Genus",
          "Species",
          "Strain")[1:length(rank_names(d))]
      tax_table(d)[grep("unknown ", tax_table(d))] <- NA
      #tax_table(d)[grep("Unclassified", tax_table(d))] <- NA
      if (!is.null(input$fileMeta)) {
        if (input$CSVsep == "excel") {
          sample_data(d) <-
            RcmdrMisc::readXL(input$fileMeta$datapath,
                              rownames = TRUE,
                              header = TRUE)
        } else {
          sample_data(d) <- read.csv(
            input$fileMeta$datapath,
            header = TRUE,
            sep = input$CSVsep,
            row.names = 1,
            na.strings = NA
          )
        }
Midoux Cedric's avatar
Midoux Cedric committed
104
      } else {
Midoux Cedric's avatar
Midoux Cedric committed
105
106
107
108
109
110
111
112
113
114
        n <- data.frame(sample_names(d) , row.names = sample_names(d))
        names(n) <- "sample_names"
        sample_data(d) <- n
      }
      if (input$rareData) {
        d <- rarefy_even_depth(
          d,
          replace = FALSE,
          rngseed = as.integer(Sys.time()),
          verbose = FALSE
Midoux Cedric's avatar
Midoux Cedric committed
115
116
        )
      }
Midoux Cedric's avatar
Midoux Cedric committed
117
      return(d)
Midoux Cedric's avatar
Midoux Cedric committed
118
119
120
121
122
123
    }
  })
  
  output$rarefactionMin <- renderText({
    if (!is.null(input$fileBiom)) {
      paste("(min sample =", format(min(sample_sums(data16S(
Midoux Cedric's avatar
Midoux Cedric committed
124
        
Midoux Cedric's avatar
Midoux Cedric committed
125
126
127
128
129
130
131
132
133
      ))), big.mark = " "), "reads)")
    } else {
      paste("(min sample =", 0, "reads)")
    }
  })
  
  output$phyloseqPrint <- renderPrint({
    validate(
      need(
Midoux Cedric's avatar
Midoux Cedric committed
134
135
        data16S(),
        "Merci de commencer par importer un fichier d'abondance au format BIOM. Celui-ci peut etre obtenu a l'issue du workflow FROGS avec l'operation 'FROGS BIOM to std BIOM'.\nVous pouvez egalement choisir un dataset de demo"
Midoux Cedric's avatar
Midoux Cedric committed
136
137
138
139
140
141
      )
    )
    data16S()
  })
  
  output$summaryTable <- renderUI({
Midoux Cedric's avatar
Midoux Cedric committed
142
    validate(need(data16S(), ""))
Midoux Cedric's avatar
Midoux Cedric committed
143
144
145
146
147
148
149
150
151
152
153
154
155
    box(
      title = "Tables",
      width = NULL,
      status = "primary",
      tabsetPanel(
        tabPanel("otu_table",
                 beautifulTable(
                   data.frame(OTU = taxa_names(data16S()), otu_table(data16S()))
                 )),
        tabPanel("tax_table",
                 beautifulTable(
                   data.frame(OTU = taxa_names(data16S()), tax_table(data16S()))
                 )),
Midoux Cedric's avatar
Midoux Cedric committed
156
157
158
159
        tabPanel("sample_data",
                 beautifulTable(
                   data.frame(SAMPLE = sample_names(data16S()), sample_data(data16S()))
                 ))
Midoux Cedric's avatar
Midoux Cedric committed
160
161
162
163
164
      )
    )
  })
  
  output$histUI <- renderUI({
Midoux Cedric's avatar
Midoux Cedric committed
165
    validate(need(data16S(), ""))
Midoux Cedric's avatar
Midoux Cedric committed
166
167
168
169
170
171
172
173
174
    box(
      title = "Paramètres",
      width = NULL,
      status = "primary",
      selectInput(
        "barFill",
        label = "Niveau taxo :",
        choices = rank_names(data16S())
      ),
Midoux Cedric's avatar
Midoux Cedric committed
175
176
177
178
179
180
181
182
183
184
185
      selectInput(
        "barGrid",
        label = "Regroupement :",
        choices = c("..." = 0, sample_variables(data16S()))
      )
      ,
      selectInput(
        "barX",
        label = "X :",
        choices = c("..." = 0, sample_variables(data16S()))
      )
Midoux Cedric's avatar
Midoux Cedric committed
186
187
188
189
    )
  })
  
  output$histo <- renderPlot({
Midoux Cedric's avatar
Midoux Cedric committed
190
191
    validate(need(data16S(),
                  "Merci d'importer un fichier d'abondance"))
Midoux Cedric's avatar
Midoux Cedric committed
192
193
194
195
196
197
198
199
200
201
202
203
204
    p <- plot_bar(
      physeq = data16S(),
      fill = input$barFill,
      x = ifelse(is.null(checkNull(input$barX)), "Sample", input$barX)
    )
    if (!is.null(checkNull(input$barGrid))) {
      p <-
        p + facet_grid(paste(".", "~", input$barGrid), scales = "free_x")
    }
    return(p)
  })
  
  output$histFocusUIfocusRank <- renderUI({
Midoux Cedric's avatar
Midoux Cedric committed
205
    validate(need(data16S(), ""))
Midoux Cedric's avatar
Midoux Cedric committed
206
207
208
209
210
211
212
213
214
    radioButtons(
      "focusRank",
      label = "Niveau taxo :",
      choices = rank_names(data16S())[-length(rank_names(data16S()))],
      inline = TRUE
    )
  })
  
  output$histFocusUIfocusTaxa <- renderUI({
Midoux Cedric's avatar
Midoux Cedric committed
215
    validate(need(data16S(), ""))
Midoux Cedric's avatar
Midoux Cedric committed
216
217
218
    selectInput(
      "focusTaxa",
      label = "Taxa :",
Midoux Cedric's avatar
Midoux Cedric committed
219
220
221
      choices = unique(as.vector(tax_table(data16S(
        
      ))[, input$focusRank])),
Midoux Cedric's avatar
Midoux Cedric committed
222
223
224
225
226
      selected = TRUE
    )
  })
  
  output$histFocusUIfocusNbTaxa <- renderUI({
Midoux Cedric's avatar
Midoux Cedric committed
227
    validate(need(data16S(), ""))
Midoux Cedric's avatar
Midoux Cedric committed
228
229
230
231
232
233
234
235
236
237
238
239
    sliderInput(
      "focusNbTaxa",
      label = "Nombre de sous-taxons :",
      min = 0,
      #max = sum(tax_table(tax_glom(data16S(), rank_names(data16S())[1+as.integer(input$focusRank)]))[, as.integer(input$focusRank)]==input$focusTaxa)
      max = 30
      ,
      value = 10
    )
  })
  
  output$histFocusUIfocusGrid <- renderUI({
Midoux Cedric's avatar
Midoux Cedric committed
240
241
242
243
    validate(need(data16S(), ""))
    selectInput("focusGrid",
                label = "Regroupement :",
                choices = c("..." = 0, sample_variables(data16S())))
Midoux Cedric's avatar
Midoux Cedric committed
244
245
246
  })
  
  output$histFocusUIfocusX <- renderUI({
Midoux Cedric's avatar
Midoux Cedric committed
247
    validate(need(data16S(), ""))
Midoux Cedric's avatar
Midoux Cedric committed
248
249
    selectInput("focusX",
                label = "X :",
Midoux Cedric's avatar
Midoux Cedric committed
250
                choices = c("..." = 0, sample_variables(data16S())))
Midoux Cedric's avatar
Midoux Cedric committed
251
252
253
  })
  
  output$histoFocus <- renderPlot({
Midoux Cedric's avatar
Midoux Cedric committed
254
255
    validate(need(data16S(),
                  "Merci d'importer un fichier d'abondance"))
Midoux Cedric's avatar
Midoux Cedric committed
256
257
258
259
    p <- plot_composition(
      physeq = data16S(),
      taxaRank1 = input$focusRank,
      taxaSet1 = input$focusTaxa,
Midoux Cedric's avatar
Midoux Cedric committed
260
      taxaRank2 = rank_names(data16S())[which(rank_names(data16S()) == input$focusRank) + 1],
Midoux Cedric's avatar
Midoux Cedric committed
261
      numberOfTaxa = input$focusNbTaxa,
Midoux Cedric's avatar
Midoux Cedric committed
262
      fill = rank_names(data16S())[which(rank_names(data16S()) == input$focusRank) + 1],
Midoux Cedric's avatar
Midoux Cedric committed
263
264
265
266
267
268
269
270
271
272
      x = ifelse(is.null(checkNull(input$focusX)), "Sample", input$focusX)
    )
    if (!is.null(checkNull(input$focusGrid))) {
      p <-
        p + facet_grid(paste(".", "~", input$focusGrid), scales = "free_x")
    }
    return(p)
  })
  
  output$clustUI <- renderUI({
Midoux Cedric's avatar
Midoux Cedric committed
273
    validate(need(data16S(), ""))
Midoux Cedric's avatar
Midoux Cedric committed
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
    box(
      title = "Paramètres",
      width = NULL,
      status = "primary",
      selectInput(
        "clustDist",
        label = "Distance :",
        choices = list(
          "bray",
          "jaccard",
          "unifrac",
          "wunifrac",
          "dpcoa",
          "jsd",
          "euclidean"
        )
      ),
      selectInput(
        "clustMethod",
        label = "Methode :",
        choices = list(
          "ward.D2",
          "ward.D",
          "single",
          "complete",
          "average",
          "mcquitty",
          "median",
          "centroid"
        )
      ),
Midoux Cedric's avatar
Midoux Cedric committed
305
306
307
308
309
      selectInput(
        "clustCol",
        label = "Couleur :",
        choices = c("..." = 0, sample_variables(data16S()))
      )
Midoux Cedric's avatar
Midoux Cedric committed
310
311
312
313
    )
  })
  
  output$clust <- renderPlot({
Midoux Cedric's avatar
Midoux Cedric committed
314
315
    validate(need(data16S(),
                  "Merci d'importer un fichier d'abondance"))
Midoux Cedric's avatar
Midoux Cedric committed
316
317
318
319
320
321
322
323
324
    plot_clust(
      physeq = data16S(),
      dist = input$clustDist,
      method = input$clustMethod,
      color = checkNull(input$clustCol)
    )
  })
  
  output$richnessAUI <- renderUI({
Midoux Cedric's avatar
Midoux Cedric committed
325
    validate(need(data16S(), ""))
Midoux Cedric's avatar
Midoux Cedric committed
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
    box(
      title = "Paramètres",
      width = NULL,
      status = "primary",
      checkboxGroupInput(
        "richnessMeasures",
        label = "Mesures :",
        choices = c(
          "Observed",
          "Chao1",
          "ACE",
          "Shannon",
          "Simpson",
          "InvSimpson",
          "Fisher"
        ),
        selected = c(
          "Observed",
          "Chao1",
          "ACE",
          "Shannon",
          "Simpson",
          "InvSimpson",
          "Fisher"
        ),
        inline = TRUE
      ),
Midoux Cedric's avatar
Midoux Cedric committed
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
      selectInput(
        "richnessX",
        label = "X :",
        choices = c("..." = 0, sample_variables(data16S()))
      ),
      selectInput(
        "richnessColor",
        label = "Couleur :",
        choices = c("..." = 0, sample_variables(data16S()))
      ),
      selectInput(
        "richnessShape",
        label = "Forme :",
        choices = c("..." = 0, sample_variables(data16S()))
      ),
Midoux Cedric's avatar
Midoux Cedric committed
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
      radioButtons(
        "richnessBoxplot",
        label = "Representation :",
        choices = list(
          "Points seuls" = 1,
          "Boxplot et points" = 2,
          "Boxplot seul" = 3
        ),
        selected = 2,
        inline = TRUE
      )
    )
  })
  
  output$richnessA <- renderPlot({
Midoux Cedric's avatar
Midoux Cedric committed
383
384
    validate(need(data16S(),
                  "Merci d'importer un fichier d'abondance"))
Midoux Cedric's avatar
Midoux Cedric committed
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
    p <- plot_richness(
      physeq = data16S(),
      x = ifelse(is.null(checkNull(
        input$richnessX
      )), "samples", input$richnessX),
      color = checkNull(input$richnessColor),
      shape = checkNull(input$richnessShape),
      measures = checkNull(input$richnessMeasures)
    )
    if (input$richnessBoxplot >= 2) {
      p <- p + geom_boxplot()
    }
    if (input$richnessBoxplot <= 2) {
      p <- p + geom_point()
    }
    return(p)
  })
  
  output$richnessATable <- renderUI({
Midoux Cedric's avatar
Midoux Cedric committed
404
405
    validate(need(data16S(),
                  "Merci d'importer un fichier d'abondance"))
Midoux Cedric's avatar
Midoux Cedric committed
406
407
408
409
410
411
412
413
414
415
416
417
418
    p(beautifulTable(data.frame(
      SAMPLE = sample_names(data16S()), round(estimate_richness(data16S()), digits = 2)
    )))
  })
  
  output$richnessBUI <- renderUI({
    box(
      title = "Paramètres",
      width = NULL,
      status = "primary",
      selectInput(
        "richnessOrder",
        label = "Ordre de tri des echantillons :",
Midoux Cedric's avatar
Midoux Cedric committed
419
        choices = c("..." = 0, sample_variables(data16S()))
Midoux Cedric's avatar
Midoux Cedric committed
420
421
422
423
424
      )
    )
  })
  
  output$richnessB <- renderPlot({
Midoux Cedric's avatar
Midoux Cedric committed
425
426
    validate(need(data16S(),
                  "Merci d'importer un fichier d'abondance"))
Midoux Cedric's avatar
Midoux Cedric committed
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
    beta <-
      melt(as(distance(data16S(), method = input$richnessBDist), "matrix"))
    colnames(beta) <- c("x", "y", "distance")
    if (!is.null(checkNull(input$richnessOrder)))
    {
      new_factor = as.factor(get_variable(data16S(), input$richnessOrder))
      variable_sort <-
        as.factor(get_variable(data16S(), input$richnessOrder)[order(new_factor)])
      L = levels(reorder(sample_names(data16S()), as.numeric(new_factor)))
      beta$x <- factor(beta$x, levels = L)
      beta$y <- factor(beta$y, levels = L)
      palette <- hue_pal()(length(levels(new_factor)))
      tipColor <-
        col_factor(palette, levels = levels(new_factor))(variable_sort)
    }
    p <-
      ggplot(beta, aes(x = x, y = y, fill = distance)) + geom_tile()
    p <- p + theme(
      axis.text.x = element_text(
        angle = 90,
        hjust = 1,
        color = checkNull(tipColor)
      ),
      axis.text.y = element_text(color = checkNull(tipColor)),
      axis.title.x = element_blank(),
      axis.title.y = element_blank()
    )
    return(p + scale_fill_gradient2())
  })
  
  output$networkBUI <- renderUI({
Midoux Cedric's avatar
Midoux Cedric committed
458
    validate(need(data16S(), ""))
Midoux Cedric's avatar
Midoux Cedric committed
459
460
461
462
463
464
465
466
467
468
469
470
471
472
    box(
      title = "Paramètres",
      width = NULL,
      status = "primary",
      sliderInput(
        "netwMax",
        label = "Cutoff :",
        min = 0,
        max = 1,
        value = 0.7
      ),
      checkboxInput("netwOrphan",
                    label = "Garder les points orphelins",
                    value = TRUE),
Midoux Cedric's avatar
Midoux Cedric committed
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
      selectInput(
        "netwCol",
        label = "Couleur :",
        choices = c("..." = 0, sample_variables(data16S()))
      ),
      selectInput(
        "netwShape",
        label = "Forme :",
        choices = c("..." = 0, sample_variables(data16S()))
      ),
      selectInput(
        "netwLabel",
        label = "Label :",
        choices = c(
          "..." = 0,
          "Sample name" = "value",
          sample_variables(data16S())
Midoux Cedric's avatar
Midoux Cedric committed
490
        )
Midoux Cedric's avatar
Midoux Cedric committed
491
      )
Midoux Cedric's avatar
Midoux Cedric committed
492
493
494
495
    )
  })
  
  output$networkB <- renderPlot({
Midoux Cedric's avatar
Midoux Cedric committed
496
497
    validate(need(data16S(),
                  "Merci d'importer un fichier d'abondance"))
Midoux Cedric's avatar
Midoux Cedric committed
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
    g <- make_network(
      data16S(),
      distance = input$richnessBDist,
      max.dist = input$netwMax,
      keep.isolates = input$netwOrphan
    )
    p <- plot_network(
      g,
      physeq = data16S(),
      color = checkNull(input$netwCol),
      shape = checkNull(input$netwShape),
      label = checkNull(input$netwLabel),
      hjust = 2,
      title = NULL
    )
    return(p)
  })
  
  output$richnessBTable <- renderUI({
Midoux Cedric's avatar
Midoux Cedric committed
517
518
    validate(need(data16S(),
                  "Merci d'importer un fichier d'abondance"))
Midoux Cedric's avatar
Midoux Cedric committed
519
520
521
522
523
524
525
526
    p(beautifulTable(data.frame(
      SAMPLE = sample_names(data16S()), round(as.matrix(
        distance(data16S(), method = input$richnessBDist)
      ), digits = 2)
    )))
  })
  
  output$rarefactionCurve <- renderPlot({
Midoux Cedric's avatar
Midoux Cedric committed
527
528
    validate(need(data16S(),
                  "Merci d'importer un fichier d'abondance"))
Midoux Cedric's avatar
Midoux Cedric committed
529
530
    p <- ggrare(
      physeq = data16S(),
Midoux Cedric's avatar
Midoux Cedric committed
531
532
      step = 100,
      #step = input$rarefactionStep,
Midoux Cedric's avatar
Midoux Cedric committed
533
534
535
536
537
538
539
      color = checkNull(input$rarefactionColor),
      se = FALSE
    )
    if (!is.null(checkNull(input$rarefactionGrid))) {
      p <- p + facet_grid(paste(".", "~", input$rarefactionGrid))
    }
    
Midoux Cedric's avatar
Midoux Cedric committed
540
541
542
543
544
    if (input$rarefactionMin) {
      p <-
        p + geom_vline(xintercept = min(sample_sums(data16S())),
                       color = "gray60")
    }
Midoux Cedric's avatar
Midoux Cedric committed
545
546
547
548
549
    return(p)
    
  })
  
  output$rarefactionCurveUI <- renderUI({
Midoux Cedric's avatar
Midoux Cedric committed
550
    validate(need(data16S(), ""))
Midoux Cedric's avatar
Midoux Cedric committed
551
552
553
554
    box(
      title = "Paramètres",
      width = NULL,
      status = "primary",
Midoux Cedric's avatar
Midoux Cedric committed
555
556
557
558
559
560
561
562
563
564
565
566
      # sliderInput(
      #   "rarefactionStep",
      #   label = "Etapes de calcul :",
      #   min = 1,
      #   max = 1000,
      #   value = 100
      # ),
      checkboxInput("rarefactionMin", label = "Afficher le seuil de l'echantillon minimal", value = FALSE),
      selectInput(
        "rarefactionColor",
        label = "Couleur :",
        choices = c("..." = 0, sample_variables(data16S()))
Midoux Cedric's avatar
Midoux Cedric committed
567
      ),
Midoux Cedric's avatar
Midoux Cedric committed
568
569
570
571
572
      selectInput(
        "rarefactionGrid",
        label = "Regroupement :",
        choices = c("..." = 0, sample_variables(data16S()))
      )
Midoux Cedric's avatar
Midoux Cedric committed
573
574
575
576
    )
  })
  
  output$HeatmapUI <- renderUI({
Midoux Cedric's avatar
Midoux Cedric committed
577
    validate(need(data16S(), ""))
Midoux Cedric's avatar
Midoux Cedric committed
578
579
580
581
    box(
      title = "Paramètres",
      width = NULL,
      status = "primary",
Midoux Cedric's avatar
Midoux Cedric committed
582
583
584
585
586
587
588
589
590
591
      selectInput(
        "heatmapGrid",
        label = "Regroupement :",
        choices = c("..." = 0, sample_variables(data16S()))
      ),
      selectInput(
        "heatmapX",
        label = "X :",
        choices = c("..." = 0, sample_variables(data16S()))
      ),
Midoux Cedric's avatar
Midoux Cedric committed
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
      sliderInput(
        "heatmapTopOtu",
        label = "Selection des n OTU les plus abondant :",
        min = 1,
        max = ntaxa(data16S()),
        value = 250
      ),
      selectInput(
        "heatmapDist",
        label = "Distance :",
        selected = "bray",
        choices = list(
          "bray",
          "jaccard",
          "unifrac",
          "wunifrac",
          "dpcoa",
          "jsd",
          "euclidean"
        )
      ),
      selectInput(
        "heatmapMethod",
        label = "Methode :",
        selected = "NMDS",
        choices = list(
          "NMDS",
          "ward.D2",
          "ward.D",
          "single",
          "complete",
          "average",
          "mcquitty",
          "median",
          "centroid"
        )
      )
    )
  })
  
  output$Heatmap <- renderPlot({
Midoux Cedric's avatar
Midoux Cedric committed
633
634
    validate(need(data16S(),
                  "Merci d'importer un fichier d'abondance"))
Midoux Cedric's avatar
Midoux Cedric committed
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
    p <- plot_heatmap(
      physeq = prune_taxa(names(sort(
        taxa_sums(data16S()), decreasing = TRUE
      )[1:input$heatmapTopOtu]), data16S()),
      distance = input$heatmapDist,
      method = input$heatmapMethod,
      sample.order = checkNull(input$heatmapX),
      low = "yellow",
      high = "red",
      na.value = "white"
    )
    if (!is.null(checkNull(input$heatmapGrid))) {
      p <-
        p + facet_grid(paste(".", "~", input$heatmapGrid), scales = "free_x")
    }
    return(p)
  })
  
  output$treeUI <- renderUI({
Midoux Cedric's avatar
Midoux Cedric committed
654
    validate(need(data16S(), ""))
Midoux Cedric's avatar
Midoux Cedric committed
655
656
657
658
659
660
661
    box(
      title = "Paramètres",
      width = NULL,
      status = "primary",
      radioButtons(
        "treeRank",
        label = "Niveau taxonomique légendé :",
Midoux Cedric's avatar
Midoux Cedric committed
662
663
664
        choices = c(aucun = "",
                    rank_names(data16S()),
                    OTU = "taxa_names"),
Midoux Cedric's avatar
Midoux Cedric committed
665
666
667
668
669
670
671
672
673
674
675
        inline = TRUE
      ),
      sliderInput(
        "treeTopOtu",
        label = "Selection des n OTU les plus abondant :",
        min = 1,
        max = ntaxa(data16S()),
        value = 20
      ),
      checkboxInput("treeRadial", label = "Arbre radial", value = FALSE),
      checkboxInput("treeSample", label = "Show samples", value = TRUE),
Midoux Cedric's avatar
Midoux Cedric committed
676
677
678
679
680
681
682
683
684
685
      selectInput(
        "treeCol",
        label = "Couleur :",
        choices = c("..." = 0, sample_variables(data16S()))
      ),
      selectInput(
        "treeShape",
        label = "Forme :",
        choices = c("..." = 0, sample_variables(data16S()))
      )
Midoux Cedric's avatar
Midoux Cedric committed
686
687
688
689
    )
  })
  
  output$tree <- renderPlot({
Midoux Cedric's avatar
Midoux Cedric committed
690
691
    validate(
      need(data16S(), "Merci d'importer un fichier d'abondance"),
Midoux Cedric's avatar
Midoux Cedric committed
692
693
694
695
      need(
        phy_tree(data16S(), errorIfNULL = FALSE),
        "Arbre phylo invalide"
      )
Midoux Cedric's avatar
Midoux Cedric committed
696
    )
Midoux Cedric's avatar
Midoux Cedric committed
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
    p <- plot_tree(
      physeq = prune_taxa(names(sort(
        taxa_sums(data16S()), decreasing = TRUE
      )[1:input$treeTopOtu]), data16S()),
      method = ifelse(input$treeSample, "sampledodge", "treeonly"),
      color = checkNull(input$treeCol),
      shape = checkNull(input$treeShape),
      size = "abundance",
      label.tips = checkNull(input$treeRank),
      sizebase = 5,
      ladderize = "left",
      plot.margin = 0
    )
    if (checkNull(input$treeRadial)) {
      return(p + coord_polar(theta = "y"))
    } else {
      return(p)
    }
  })
  
  output$acpUI <- renderUI({
Midoux Cedric's avatar
Midoux Cedric committed
718
    validate(need(data16S(), ""))
Midoux Cedric's avatar
Midoux Cedric committed
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
    box(
      title = "Paramètres",
      width = NULL,
      status = "primary",
      selectInput(
        "acpDist",
        label = "Distance :",
        selected = "bray",
        choices = list(
          "bray",
          "jaccard",
          "unifrac",
          "wunifrac",
          "dpcoa",
          "jsd",
          "euclidean"
        )
      ),
      selectInput(
        "acpMethod",
        label = "Methode :",
        selected = "MDS",
        choices = list("DCA", "CCA", "RDA", "CAP", "DPCoA", "NMDS", "MDS", "PCoA")
      ),
Midoux Cedric's avatar
Midoux Cedric committed
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
      selectInput(
        "acpCol",
        label = "Couleur :",
        choices = c("..." = 0, sample_variables(data16S()))
      ),
      selectInput(
        "acpShape",
        label = "Forme :",
        choices = c("..." = 0, sample_variables(data16S()))
      ),
      selectInput(
        "acpEllipse",
        label = "Ellipses :",
        choices = c("..." = 0, sample_variables(data16S()))
      ),
      selectInput(
        "acpRep",
        label = "Barycentre :",
        choices = c("..." = 0, sample_variables(data16S()))
      )
Midoux Cedric's avatar
Midoux Cedric committed
763
764
765
766
    )
  })
  
  output$acp <- renderPlot({
Midoux Cedric's avatar
Midoux Cedric committed
767
768
    validate(need(data16S(),
                  "Merci d'importer un fichier d'abondance"))
Midoux Cedric's avatar
Midoux Cedric committed
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
    p <- plot_samples(
      data16S(),
      ordination = ordinate(
        data16S(),
        method = input$acpMethod,
        distance = input$acpDist
      ),
      axes = c(1, 2),
      color = checkNull(input$acpCol),
      replicate = checkNull(input$acpRep),
      shape = checkNull(input$acpShape)
    )
    if (!is.null(checkNull(input$acpEllipse))) {
      p <- p + stat_ellipse(aes_string(group = input$acpEllipse))
    }
    return(p + theme_bw())
  })
Midoux Cedric's avatar
Midoux Cedric committed
786
})