Nothing
library(shiny)
library(ggplot2)
library(shinyjs)
datasets <- list(
"Random distribution" =
data.frame("Normal" =
rnorm(1000, 150, 20),
"Bimodal" =
c(rnorm(500, 200, 50), rnorm(500, 400, 50)),
"Uniform" =
runif(1000, 100, 200),
check.names = FALSE),
"faithful" = faithful,
"rock" = rock,
"cars" = cars)
shinyServer(function(input, output, session) {
# show/hide the marginal plots settings
observe({
toggle(id = "marginal-settings", anim = TRUE,
time = 0.3, condition = input$show_marginal)
})
output$dataset_select <- renderUI({
selectInput("dataset", "Choose a dataset:", names(datasets))
})
datasetInput <- reactive({
if (is.null(input$dataset)) {
return(NULL)
}
datasets[[input$dataset]]
})
output$x_var_select <- renderUI({
dataset <- datasetInput()
selectInput("x_var", "X variable",
colnames(dataset), colnames(dataset)[1])
})
output$y_var_select <- renderUI({
dataset <- datasetInput()
selectInput("y_var", "Y variable",
colnames(dataset), colnames(dataset)[2])
})
# there's a bug with sliderInput where if you scroll all the way
# to the left and exit the window, it returns NA and breaks Shiny
fontSize <- reactive({
if (is.null(input$font_size)) {
0
} else {
input$font_size
}
})
size <- reactive({
if (is.null(input$size)) {
1
} else {
input$size
}
})
output$plot <- renderPlot({
dataset <- datasetInput()
# make sure the x and y variable select boxes have been updated
if (is.null(input$x_var) || is.null(input$y_var) ||
!input$x_var %in% colnames(dataset) ||
!input$y_var %in% colnames(dataset)) {
return(NULL)
}
# when the plot changes, change the code as well
text("code", code())
p <-
ggplot(dataset, aes_string(input$x_var, input$y_var)) +
geom_point() +
theme_bw(fontSize())
# apply axis transformations to ensure marginal plots still work
if (input$xtrans == "log") {
p <- p + scale_x_log10()
} else if (input$xtrans == "reverse") {
p <- p + scale_x_reverse()
}
if (input$ytrans == "log") {
p <- p + scale_y_log10()
} else if (input$ytrans == "reverse") {
p <- p + scale_y_reverse()
}
if (input$show_marginal) {
p <- ggExtra::ggMarginal(
p,
type = input$type,
margins = input$margins,
size = size(),
col = input$col,
fill = input$fill)
}
p
})
# the code to reproduce the plot
code <- reactive({
code <- sprintf(paste0(
"p <- ggplot(`%s`, aes_string('%s', '%s')) +\n",
" geom_point() + theme_bw(%s)"),
input$dataset, input$x_var, input$y_var, fontSize()
)
if (input$xtrans == "log") {
code <- paste0(code, " + scale_x_log10()")
} else if (input$xtrans == "reverse") {
code <- paste0(code, " + scale_x_reverse()")
}
if (input$ytrans == "log") {
code <- paste0(code, " + scale_y_log10()")
} else if (input$ytrans == "reverse") {
code <- paste0(code, " + scale_y_reverse()")
}
code <- paste0(code, "\n\n")
if (input$show_marginal) {
code <- paste0(code, sprintf(paste0(
"ggExtra::ggMarginal(\n",
" p,\n",
" type = '%s',\n",
" margins = '%s',\n",
" size = %s,\n",
" col = '%s',\n",
" fill = '%s'\n",
")"),
input$type, input$margins, size(), input$col,
input$fill))
} else {
code <- paste0(code, "p")
}
})
observe({
if (input$sal == 1) stopApp()
})
# hide the loading message
hide("loading-content", TRUE, "fade")
})
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.