CESA/server.R at master · ScienceAdvances/CESA · GitHub

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
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
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
104
105
106
107
108
109
110
111
112
113
114
suppressPackageStartupMessages(library(shiny))
suppressPackageStartupMessages(library(ggplot2))
suppressPackageStartupMessages(library(survival))

source("www/source.R", local = TRUE)

shinyServer(function(input, output, session) {
    analysis <- reactiveVal(NULL)
    analysis_error <- reactiveVal(NULL)

    output$analysis_ready <- reactive(!is.null(analysis()))
    outputOptions(output, "analysis_ready", suspendWhenHidden = FALSE)

    observeEvent(input$run, {
        analysis_error(NULL)
        result <- tryCatch({
            counts <- parse_survival_counts(input$data_text)
            individuals <- expand_survival_counts(counts)
            list(counts = counts, individuals = individuals,
                 summary = make_summary_table(individuals),
                 curves = survival_curve_data(individuals))
        }, error = function(e) {
            analysis_error(conditionMessage(e))
            NULL
        })
        if (is.null(result)) {
            analysis(NULL)
            showNotification(analysis_error(), type = "error", duration = 8)
        } else {
            analysis(result)
            groups <- nlevels(result$individuals$group)
            animals <- nrow(result$individuals)
            showNotification(
                sprintf("Analysis complete: %s animals across %s group%s.",
                        animals, groups, if (groups == 1L) "" else "s"),
                type = "message", duration = 4
            )
        }
    }, ignoreInit = TRUE)

    output$analysis_status <- renderUI({
        if (!is.null(analysis_error()))
            return(div(class = "status-panel status-error", span(class = "status-dot"),
                       div(strong("Analysis failed"), p(analysis_error()))))
        if (is.null(analysis()))
            return(div(class = "status-panel status-idle", span(class = "status-dot"),
                       div(strong("Ready for analysis"), p("Review the example data or paste your own table, then run the analysis."))))
        NULL
    })

    output$summary_table <- renderTable({
        req(analysis())
        analysis()$summary
    }, striped = TRUE, hover = TRUE, bordered = FALSE, align = "lccccc")

    survival_plot <- reactive({
        req(analysis())
        curves <- analysis()$curves
        max_day <- max(curves$time)
        interval <- if (max_day <= 40) 5 else if (max_day <= 100) 10 else 20
        group_names <- levels(curves$group)
        group_colours <- survival_group_colours(group_names)

        p <- ggplot(curves, aes(x = time, y = survival, colour = group)) +
            geom_step(linewidth = 1) +
            scale_colour_manual(values = group_colours, breaks = group_names) +
            scale_x_continuous(breaks = seq(0, ceiling(max_day / interval) * interval, by = interval),
                               expand = expansion(mult = c(0, 0.025))) +
            scale_y_continuous(limits = c(0, 1), breaks = seq(0, 1, 0.2),
                               expand = expansion(mult = c(0, 0.02))) +
            labs(x = "Days at 20 °C", y = "Fraction surviving", colour = NULL) +
            theme_classic(base_size = 16) +
            theme(legend.position = "right", legend.justification = "left",
                  legend.key.width = grid::unit(1.6, "cm"),
                  axis.line = element_line(linewidth = 0.5),
                  plot.margin = margin(10, 15, 10, 10))
        if (nlevels(curves$group) == 2L) {
            p_value <- analysis()$summary[["P value"]][[2L]]
            p <- p + annotate("text", x = max(curves$time) * 0.4, y = 0.3, label = paste("p", p_value),
                              hjust = 1.1, vjust = 1.5, colour = "#263238", size = 4)
        }
        p
    })

    output$survival_plot <- renderUI({
        req(analysis())
        p_value <- if (nlevels(analysis()$curves$group) == 2L) {
            analysis()$summary[["P value"]][[2L]]
        } else NULL
        HTML(make_survival_svg(analysis()$curves, p_value))
    })

    safe_name <- reactive({
        req(analysis())
        name <- levels(analysis()$individuals$group)[[1L]]
        cleaned <- gsub("[^A-Za-z0-9._-]+", "_", name)
        if (nzchar(cleaned)) cleaned else "CESA"
    })

    output$download_excel <- downloadHandler(
        filename = function() paste0(safe_name(), "_survival_results.xlsx"),
        contentType = "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet",
        content = function(file) {
            req(analysis())
            write_excel_workbook(
                list(`Individual data` = analysis()$individuals,
                     Summary = analysis()$summary),
                file
            )
        })
    output$download_plot <- downloadHandler(
        filename = function() paste0(safe_name(), "_survival.pdf"),
        content = function(file) ggplot2::ggsave(file, survival_plot(), width = 160, height = 120, units = "mm"))
})