-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathserver.R
107 lines (74 loc) · 3.18 KB
/
server.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
# author: Anton Kratz
# created: Sun Dec 20 17:43:02 JST 2015
# last change: Mon Jun 6 22:10:42 JST 2016
library(shiny)
library(DT)
library(ggplot2)
library(tools)
options(shiny.maxRequestSize=30*1024^2)
shinyServer(function(input, output) {
foo <- reactive(inputdata())
up <- reactive(nrow(subset(foo(), ((foo()$pvalue<=input$pv) & ((foo()$log2FoldChange)>=input$fc)))))
down <- reactive(nrow(subset(foo(), ((foo()$pvalue<=input$pv) & ((-foo()$log2FoldChange)>=input$fc)))))
output$plot1 <- renderPlot({
bname = basename(input$variable)
bname_sans_ext = file_path_sans_ext(bname)
one_two = strsplit(bname_sans_ext, "_vs_")[[1]]
one = one_two[1]
g <- ggplot(foo(), aes(x=baseMean, y=log2FoldChange)) + geom_point(color=ifelse(((foo()$pvalue<=input$pv) & ((abs(foo()$log2FoldChange))>=input$fc)), "red", "black"), alpha = input$alphaslider, shape = 19, size=1) + scale_x_continuous(trans='log2') + coord_cartesian(xlim = ranges$x, ylim = ranges$y) + labs(y = paste("log2FoldChange (positive FC indicates enrichment in ", one, ")", sep=""))
# add this to the ggplot statement above to add a contour
# + geom_density2d(color="white")
terms <- unlist(strsplit(input$searchpoint, "|", fixed = TRUE))
l <- length(terms)
pal <- rainbow(l)
lx <- min(foo()$baseMean)
ly <- max(foo()$log2FoldChange)
for(i in 1:l) {
xloc = foo()[grep(terms[i], foo()$symbol, ignore.case=TRUE), ]$baseMean
yloc = foo()[grep(terms[i], foo()$symbol, ignore.case=TRUE), ]$log2FoldChange
lbl = foo()[grep(terms[i], foo()$symbol, ignore.case=TRUE), ]$symbol
g <- g + annotate("point", size = 5, shape = 20, color = pal[i], x = xloc, y = yloc)
# add a legend
g <- g + annotate("point", size = 5, shape = 19, color = pal[i], x = lx, y = ly-10*i*(ly/100))
g <- g + annotate("text", x = lx, y = ly-10*i*(ly/100), label=terms[i], color="black")
}
g
# ggsave(file="test.svg", plot=g, width=10, height=8)
})
output$info <- renderDataTable({
res <- brushedPoints(foo(), input$plot_brush)
datatable(res, escape=FALSE, filter = 'top', options = list(pageLength = 10, autoWidth = TRUE))
})
ranges <- reactiveValues(x = NULL, y = NULL)
# When a double-click happens, check if there's a brush on the plot.
# If so, zoom to the brush bounds; if not, reset the zoom.
observeEvent(input$plot1_dblclick, {
brush <- input$plot_brush
if (!is.null(brush)) {
ranges$x <- c(brush$xmin, brush$xmax)
ranges$y <- c(brush$ymin, brush$ymax)
} else {
ranges$x <- NULL
ranges$y <- NULL
}
})
inputdata <- reactive({
fload <- read.table(input$variable, header = TRUE, row.names=1, na.strings="NA", sep = "\t", dec = ".")
fload
})
output$text1 <- renderUI({
str1 <- paste("<b>UP:", up())
str2 <- paste("<b>DOWN:", down())
HTML(paste(str1, str2, sep = '</b><br/>'))
})
# This does not work, info_rows_all in DT has a bug and simply doesn't give me all the indices of all the rows, only the rows on the current page
output$dbutton <- downloadHandler (
filename = function() {
paste('export-', Sys.Date(), '.csv', sep='')
},
content = function(file) {
s = input$info_rows_all
write.csv(foo()[s, ], file)
}
)
})