-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathapp.R
156 lines (134 loc) · 9.24 KB
/
app.R
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
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
# Libraries ----
source("libraries.R")
# Scripts ----
source("core.R")
source("mypl1.R")
source("mypl2.R")
source("suggestion.R")
# User interface ----
ui <- dashboardPage(dashboardHeader(title = "NeuroPGx"),
dashboardSidebar(fileInput(inputId = "file",
label = "Load Data",
accept = c(".csv", ".tsv", ".xlsx"))
),
dashboardBody(fluidRow(tabBox(title = "About",
id = "tabset2",
tabPanel(title = "Workflow",
width = 6,
status = "info",
fluidRow(column(width = 6, align = "center", tags$img(src = "Workflow image.svg")),
column(width = 6, h4("How to use"),
p(style="text-align: justify;",
"Please upload an input file using the browse button on the sidebar.
Refer to the sample input files in the samples directory to prepare your input file.",br(),
"The software will run even if you miss genotype info for some of the five core genes.",br()),
p(style="text-align: justify;",
"Export the results using the download buttons below each result box.")))),
tabPanel(title = "Software Description",
width = 6,
status = "info",
p(style="text-align: justify;",
"NeuroPGx software performed the automated identification of all possible diplotypes
compatible with genotypes at each CYP gene included in the virtual NeuroPGx Panel.
Basing on population characteristics, the software selects the most likely diplotype-phenotype.
Otherwise, all possible diplotype-phenotype combinations were identified and reported in the output file.",br(),
"The NeuroPGx software output files provide information about:",
tags$ol(
tags$li("the genotypes at evaluated SNPs."),
tags$li("the main diplotypes at CYP genes and corresponding metabolization phenotypes."),
tags$li("the list of possible (rare) diplotypes and corresponding metabolization phenotypes."))),
p(tags$a(href="https://cpicpgx.org/", "CPIC guidelines"),
"(last accession: 30 May 2021)", br(),
tags$a(href="https://www.pharmgkb.org/page/dpwg", "DPWG guidelines"),
"(last accession: 30 May 2021)"))),
box(title = "Samples",
status = "primary",
width = 6,
withSpinner(DTOutput(outputId = "sample")))),
fluidRow(box(title = "Assigned Diplotypes",
status = "success",
width = 6,
withSpinner(DTOutput(outputId = "ac")),
uiOutput(outputId = "download_button")),
tabBox(title = "Plots",
id = "tabset1",
tabPanel(title = "Phenotype", withSpinner(plotOutput(outputId = "phn1"))),
tabPanel(title = "EHR", withSpinner(plotOutput(outputId = "ehr1"))))),
fluidRow(box(title = "Suggested drug w/o interactions",
status = "info",
width = 6,
withSpinner(DTOutput(outputId = "plain")),
uiOutput(outputId = "download_plain")),
box(title = "Suggested drug with interactions",
status = "info",
width = 6,
withSpinner(DTOutput(outputId = "interaction")),
uiOutput(outputId = "download_interaction")))
),
skin = "green"
)
# Server logic ----
server <- function(input, output) {
# Sample input
data <- reactive({
req(input$file)
ext <- tools::file_ext(input$file$name)
switch(ext,
xlsx = read.xlsx(input$file$datapath),
csv = vroom::vroom(input$file$datapath, delim = ","),
tsv = vroom::vroom(input$file$datapath, delim = "\t"),
validate("Invalid file; Please upload a .xlsx, .csv or .tsv file"))
})
# Sample preview
output$sample <- renderDT({data()}, options = list(pageLength = 5), filter = "top")
# Output production
ac <- reactive({diplo_assign(input = data(), pheno = pheno, frq = frq, altab = altab)})
## Drug list
drug.list <- reactive({pharm_sum(data = ac(),
comb_drugs = comb_drugs,
diplo_drugs = diplo_drugs,
pheno_drugs = pheno_drugs)})
# Output head with loading screen
output$ac <- renderDT({ac()},
options = list(pageLength = 5),
filter = "top")
output$plain <- renderDT({drug.list()[[1]]},
options = list(pageLength = 5),
filter = "top")
output$interaction <- renderDT({drug.list()[[2]]},
options = list(pageLength = 5),
filter = "top")
# Download buttons
output$download_button <- renderUI({
req(ac())
downloadButton(outputId = "download_item",
label = "Download .xlsx") })
output$download_plain <- renderUI({
req(drug.list())
downloadButton(outputId = "download_item_plain",
label = "Download .xlsx") })
output$download_interaction <- renderUI({
req(drug.list())
downloadButton(outputId = "download_item_interaction",
label = "Download .xlsx") })
# Download operation
output$download_item <- downloadHandler(filename = function() {paste("data-",Sys.Date(), ".xlsx", sep = "")},
content = function(file) {write.xlsx(ac(), file)},
contentType = ".xlsx")
output$download_item_plain <- downloadHandler(filename = function() {paste("plain-",Sys.Date(), ".xlsx", sep = "")},
content = function(file) {write.xlsx(drug.list()[[1]], file)},
contentType = ".xlsx")
output$download_item_interaction <- downloadHandler(filename = function() {paste("interaction-",Sys.Date(), ".xlsx", sep = "")},
content = function(file) {write.xlsx(drug.list()[[2]], file)},
contentType = ".xlsx")
# Pheno summary plot
pl1 <- reactive({pheno_sum(data = ac())})
# Show plot
output$phn1 <- renderPlot({pl1()})
# EHR summary plot
pl2 <- reactive({ehr_sum(data = ac())})
# Show plot
output$ehr1 <- renderPlot({pl2()})
}
# Run the application
shinyApp(ui = ui, server = server)