Commit 5815f75c authored by Kimberly Isobel Meechan's avatar Kimberly Isobel Meechan

Merge branch 'patch-1' into 'master'

Added snippets directory

See merge request !2
parents 14e6a550 50cf9050
library(DT) ## R interface to the js DataTables library
library(EBImage) ## already has shiny integration functions
library(shiny)
ui <- fluidPage(
titlePanel("Input files", windowTitle = "Cell Explorer"),
## Sidebar layout with input and output definitions
sidebarLayout(
## Sidebar panel for inputs
sidebarPanel(
## Input: Select a file
fileInput("datafile", "Select data file (in CSV format)",
multiple = FALSE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")),
## Horizontal line
tags$hr(),
## Input: Checkbox if file has header
checkboxInput("header", "File has header", TRUE),
## Input: Select separator
radioButtons("sep", "Separator",
choices = c(Comma = ",",
Semicolon = ";",
Tab = "\t"),
selected = "\t"),
## Input: Select quotes
radioButtons("quote", "Quote",
choices = c(None = "",
"Double Quote" = '"',
"Single Quote" = "'"),
selected = '"'),
tags$hr(),
## Select variables to display
uiOutput("variables")
),
## Main panel for displaying outputs
mainPanel(
## Output: Data file
DTOutput("content")
)
),
tags$hr(),
h1('Plot'),
plotOutput('plot', height = 500),
verbatimTextOutput('x4')
)
server <- function(input, output) {
## Increase max upload size to 500 MB
options(shiny.maxRequestSize=500*1024^2)
data <- reactive({
if (is.null(input$datafile)) return(NULL)
## After the user selects and uploads a data file,
## the content of the data file will be shown.
req(input$datafile)
## When reading semicolon separated files,
## having a comma separator causes `read.csv` to error
tryCatch(
{
df <- read.csv(input$datafile$datapath,
header = input$header,
sep = input$sep,
quote = input$quote)
},
error = function(e) {
## return a safeError if a parsing error occurs
stop(safeError(e))
}
)
return(df)
})
## Dynamically generate UI input when data is uploaded
output$variables <- renderUI({
checkboxGroupInput(inputId = "selected_var",
label = "Select variables to plot",
choices = names(data()))
})
output$content <- renderDT(data(), server = TRUE)
## Highlight selected rows in the plot
output$plot = renderPlot({
selected_rows <- input$content_rows_selected
selected_cols <- input$selected_var
par(mar = c(4, 4, 1, .1))
D <- data()
## Limit selection to two columns otherwise we get a scatterplot matrix
if (length(selected_cols) == 2) {
plot(D[,selected_cols])
}
if (length(selected_rows)) {
points(D[selected_rows, selected_cols], pch = 19, cex = 1, col = "red")
}
})
output$x4 = renderPrint({
s = input$selected_var
if (length(s)) {
cat('These variables were selected:\n\n')
cat(s, sep = ', ')
}
})
img <- reactive({
readImage(image.file)
})
## Interactive image display with EBImage
output$widget <- renderDisplay({
display(img(), method = 'browser')
})
}
## Run the application
shinyApp(ui = ui, server = server, options = list("port" = 4722))
library(shiny)
ui <- basicPage(
plotOutput("plot1",
click = "plot_click",
dblclick = "plot_dblclick",
hover = "plot_hover",
brush = "plot_brush"
),
verbatimTextOutput("info")
)
server <- function(input, output) {
library(png)
prev_vals <- NULL
structures <- reactiveValues(data = data.frame(box_id = numeric(), xmin = numeric(), ymin = numeric(), xmax = numeric(), xmax = numeric()))
output$plot1 <- renderPlot({
img <- readPNG("canonical_mitotic_cell.png", native = TRUE)
plot(1:640, type='n')
rasterImage(img,1,1,640,640)
if (nrow(structures$data) > 0) {
r <- structures$data
rect(r$xmin, r$ymin, r$xmax, r$ymax, border = "red")
}
}, height = 640, width = 640)
observe({
e <- input$plot_brush
if (!is.null(e)) {
vals <- data.frame(xmin = round(e$xmin, 1), ymin = round(e$ymin, 1), xmax = round(e$xmax, 1), ymax = round(e$ymax, 1))
if (identical(vals,prev_vals)) return() #We dont want to change anything if the values havent changed.
structures$data <- rbind(structures$data,cbind(data.frame(box_id = nrow(structures$data)+1),vals))
prev_vals <<- vals
}
})
output$info <- renderText({
xy_str <- function(e) {
if(is.null(e)) return("NULL\n")
paste0("x=", round(e$x, 1), " y=", round(e$y, 1), "\n")
}
xy_range_str <- function(e) {
if(is.null(e)) return("NULL\n")
paste0("xmin=", round(e$xmin, 1), " xmax=", round(e$xmax, 1),
" ymin=", round(e$ymin, 1), " ymax=", round(e$ymax, 1))
}
paste0(
"click: ", xy_str(input$plot_click),
"dblclick: ", xy_str(input$plot_dblclick),
"hover: ", xy_str(input$plot_hover),
"brush: ", xy_range_str(input$plot_brush)
)
})
}
shinyApp(ui, server)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment