Nothing
#' @importFrom plotly renderPlotly ggplotly layout event_data
#' @importFrom ggpubr ggarrange
#' @importFrom viridis scale_color_viridis
#' @importFrom utils read.csv write.csv
#' @importFrom stats aggregate
#' @importFrom magrittr %>%
#' @import ggplot2
server <- function(input, output, session){
## global reactiveValues list
globalVarList <- reactiveValues()
filedata <- reactive({
inFile <- input$datafile
if(is.null(inFile)) return(NULL)
read.csv(
inFile$datapath,
header = input$header,
row.names=as.numeric(input$rownames)
)
})
newLocdata <- reactive({
get_new_coordinates2(
ns=input$numloc,
bg_shape=input$shape,
isid=input$sid,
lay_out=input$arrange,
preLoc = filedata()
)
})
observeEvent(input$reload, {
session$reload()
})
output$plot1 <- plotly::renderPlotly({
if(is.null(globalVarList$vv)){
loclist <- newLocdata()
g1 <- loclist$simLoc
globalVarList$locdf <- g1
globalVarList$simLocParam <- loclist$simLocParam
}else{
g1 <- globalVarList$locdf
}
gg_scatter <- ggplot(data=g1,aes(x=x, y=y,color=group)) +
geom_point(size=input$ptsize) +
xlab("Coordinate 1") +
ylab("Coordinate 2")+
theme(legend.title=element_blank(),
text = element_text(size=input$textsize))+
coord_fixed()
if(input$shape %in% c("Square","Circle")){
plotly::ggplotly(gg_scatter, height = 400, width= 1.1*400*(diff(range(g1$x))/diff(range(g1$y)))) %>% plotly::layout(dragmode = 'select',legend = list(title=list(text='<b> Group </b>',side="top"),orientation = "v", x=1.05))
}else{
plotly::ggplotly(gg_scatter) %>% plotly::layout(dragmode = 'select',legend = list(title=list(text='<b> Group </b>',side="top"),orientation = "v", x=1.05))
}
})
## initial table
output$summary_table <- renderTable({
g1 <- globalVarList$locdf
summary_df <- cbind.data.frame(aggregate(g1$foldchange~g1$group,FUN=length),
aggregate(g1$foldchange~g1$group,FUN=mean)[,2])
colnames(summary_df) <- c("Group","NumSpots","Fold Change")
summary_df$PropSpots <- round(summary_df$NumSpots/sum(summary_df$NumSpots),3)
return(summary_df[,c("Group","NumSpots","PropSpots","Fold Change")])
},
digits=3
)
output$brush <- renderText({
if(is.null(filedata())&(input$shape %in% c("User Define Shape","User Define Spots"))){
"!!! Warning: No dataframe provided, simulate using the square backgound shape \n"
}
# g1 <- newLocdata()$simLoc
g1 <- globalVarList$locdf
group <- g1[,3]
names(group) <- rownames(g1)
d <- plotly::event_data('plotly_selected')
if (is.null(d)){
"Select points (i.e., box/lasso) to define new group"
}else{
dd <- round(cbind(d[[3]],d[[4]]),3)
vv <- group[which(round(g1[,1],3) %in% dd[,1] & round(g1[,2],3) %in% dd[,2])]
globalVarList$vv <- vv
paste0("Number of points selected: ",length(vv)," (",100*round(length(vv)/length(group),3),"%)")
}
})
output$distTable <- renderDataTable({
locdf <- globalVarList$locdf
display_locdf <- cbind.data.frame(LocID=rownames(locdf),locdf)
display_locdf
},
options = list(pageLength=10)
)
output$SpotPlot <- renderPlot({
locdf <- globalVarList$locdf
gg_scatter_spot <- ggplot(data=locdf,aes(x=x, y=y,color=group)) +
geom_point(size=input$ptsizeCount) +
xlab("Coordinate 1") +
ylab("Coordinate 2")+
theme(legend.title=element_blank(),
text = element_text(size=input$textsizeCount)
)+ coord_fixed()
ptlist <- list(gg_scatter_spot)
ggpubr::ggarrange(plotlist=ptlist,ncol=length(ptlist))
})
observeEvent(input$Change > 0, {
if (!is.null(globalVarList$vv)){
## update the location file in the global list
vv <- globalVarList$vv
locdf <- globalVarList$locdf
locdf[which(row.names(locdf) %in% names(vv)),]$group <- input$NewGroup
locdf[which(row.names(locdf) %in% names(vv)),]$foldchange <- input$fc
globalVarList$locdf <- locdf
## check if there is multiple effects in the same group
output$brush3 <- renderText({
locdf <- globalVarList$locdf
check_multi <- aggregate(locdf$foldchange~locdf$group,FUN=unique)
if(length(grep(",",check_multi[,2]))!=0){
paste0("Group ", check_multi[,1][grep(",",check_multi[,2])]," has more than one effect size, consider redefining the effect size for the group")
}
})
output$SpotPlot <- renderPlot({
locdf <- globalVarList$locdf
gg_scatter_spot <- ggplot(data=locdf,aes(x=x, y=y,color=group)) +
geom_point(size=input$ptsizeCount) +
xlab("Coordinate 1") + ylab("Coordinate 2")+
theme(legend.title=element_blank(),
text = element_text(size=input$textsizeCount))+
coord_fixed()
ptlist <- list(gg_scatter_spot)
ggpubr::ggarrange(plotlist=ptlist,ncol=length(ptlist))
})
} ## end of the is.null if
})
## Note global loc file is used here
newCountdata <- reactive({
pattern_count_func2(
pattern_in = globalVarList$locdf,
numHighSignal = input$numHighSig,
numLowSignal = input$numLowSig,
numBG = input$numNoise,
disper_in = input$disper_para,
zero_in = input$zeroProp,
mu_in = input$meanCount_para,
isid = input$count_sid
)
})
## without >0, won't run before click
observeEvent(input$countGenerate,{
locdf <- globalVarList$locdf
output$countbrush <- NULL
if(input$zeroProp < 0){
output$countbrush <- renderText({
paste0("The minimum zero proportion allowed is 0!")
})
}else if(input$zeroProp> 1){
output$countbrush <- renderText({
paste0("The max zero proportion allowed is 1!")
})
}
if((input$numHighSig + input$numLowSig + input$numNoise)== 0){
output$countbrush <- renderText({
paste0("Total number of genes to simulate is zero, please change the simulation setting")
})
}else{
output$countInfobrush <- renderText({
paste0("Baseline Mu: ",input$meanCount_para,"\n",
"Baseline Overdispersion: ",input$disper_para,"\n",
"Additional Zero Proportion: ",input$zeroProp,"\n",
"Number of Locations: ", nrow(locdf),"\n",
"Number of Higher Signal Genes Simulated: ", input$numHighSig,"\n",
"Number of Lower Signal Genes Simulated: ", input$numLowSig,"\n",
"Number of Noise Genes Simulated: ", input$numNoise,"\n")
})
countlist <- newCountdata()
countdf <- countlist$ctdf
simcountParam <- countlist$simcountParam
globalVarList$countdf <- countdf
globalVarList$simcountParam <- simcountParam
## has to be after the countdf, otherwise, the plot is not updated with seed change.
newPlotdata <- reactive({
combined_df <- cbind.data.frame(locdf,apply(countdf,1,relative_func))
selected_gene <- c(paste0("signal",input$sigidx),paste0("noise",input$noidx))
npdf <- combined_df[,c("x","y","group",selected_gene)]
names(npdf) <- c("x","y","group","signal_gene","noise_gene")
return(npdf)
})
## count summary table
output$summary_count_table <- renderTable({
loc_mu_df <- locdf
summary_df <- cbind.data.frame(aggregate(loc_mu_df$foldchange~loc_mu_df$group,FUN=length),
aggregate(loc_mu_df$foldchange~loc_mu_df$group,FUN=mean)[,2])
summary_df$Mu <- input$meanCount_para*summary_df[,3]
colnames(summary_df) <- c("Group","NumSpots","Fold Change","Mu")
summary_df$PropSpots <- round(summary_df$NumSpots/sum(summary_df$NumSpots),3)
summary_df$Dispersion <- input$disper_para
return(summary_df[,c("Group","NumSpots","PropSpots","Mu","Dispersion")])
},digits=3)
## update pop display of the countdata after the group assignment
output$countTable <- renderDataTable({
display_count_df <- cbind.data.frame(GeneID=rownames(countdf),countdf)
display_count_df[,1:10]
}, options = list(pageLength=10)
)
output$ExpressionPlot <- renderPlot({
pltdf <- newPlotdata()
if(input$dosignal){
gg_scatter_signal <- ggplot(data=pltdf,aes(x=x, y=y,color=signal_gene)) +
geom_point(size=input$ptsizeCount)+
viridis::scale_color_viridis(option="D",direction=-1) +
xlab("Coordinate 1") + ylab("Coordinate 2")+
ggtitle(paste0("Signal Gene #",input$sigidx)) +
theme(legend.title=element_blank(),
text = element_text(size=input$textsizeCount))+ coord_fixed()
}else{
gg_scatter_signal <- NULL
}
if(input$donoise){
gg_scatter_noise <- ggplot(data=pltdf,aes(x=x, y=y,color=noise_gene)) +
geom_point(size=input$ptsizeCount)+
viridis::scale_color_viridis(option="D",direction=-1) +
xlab("Coordinate 1") + ylab("Coordinate 2")+
ggtitle(paste0("Noise Gene #",input$noidx)) +
theme(legend.title=element_blank(),text = element_text(size=input$textsizeCount)) + coord_fixed()
}else{
gg_scatter_noise <- NULL
}
ptlist <- list(gg_scatter_signal,gg_scatter_noise)
to_delete <- !sapply(ptlist,is.null)
ptlist <- ptlist[to_delete]
if(length(ptlist)==0){
return(NULL)
}else if(length(ptlist)==2){
ggpubr::ggarrange(plotlist=ptlist,ncol=length(ptlist), common.legend = TRUE, legend="right")
}else{
ggpubr::ggarrange(plotlist=ptlist,ncol=length(ptlist))
}
}) ## end of ExpressionPlot
}## end of gene number else
})## end of countGenerate
## Quit the app and get back to the R
observeEvent(input$exit,{
countdf <- globalVarList$countdf
simcountParam <- globalVarList$simcountParam
locdf <- globalVarList$locdf
simLocParam <- globalVarList$simLocParam
session$sendCustomMessage(type = "closeWindow", message = "message")
stopApp(list(simCount = countdf,simInfo = locdf,simcountParam = simcountParam,simLocParam=simLocParam))
})
} ## end of server
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.