Correlation App - Issues Running
65 views
Skip to first unread message
Lily H.
Sep 26, 2016, 12:15:24 PM9/26/16
to Shiny - Web Framework for R
Hi
I'm running the script below to create a correlation shiny app (just testing it out at this stage). When running the App, I get an error message stating "unexpected end of input". Sometimes the app has not run into an external window. My dataset is called 'SocialTest'.
I've taken the script template from here: https://github.com/saurfang/shinyCorrplot
Would be really grateful if any experienced group members could cast a quick look over it and see if there are any obvious errors or provide general help re why this error message would typically come up.
Thanks
library(shiny)
library(corrplot)
library(ggplot2)
library(htmltools)
server <- shinyServer(function(input, output, session) {
## Data Input and Pre-processing ##
dataset <- reactive({
datasource <- input$dataset
if(datasource == "SocialTest") {
inFile <- input$datafile
if(is.null(inFile)) {
NULL
} else {
#TODO: Better way to unescape e.g. \\t
read.delim(inFile$datapath, sep = gsub("\\t", "\t", input$datafile_sep, fixed = TRUE))
}
} else {
eval(parse(text = datasource))
}
})
numericColumns <- reactive({
df <- dataset()
colnames(df)[sapply(df, is.numeric)]
})
correlation <- reactive({
data <- dataset()
variables <- input$variables
if(is.null(data) || !length(intersect(variables, colnames(data)))) {
NULL
} else {
cor(dataset()[,input$variables], use = input$corUse, method = input$corMethod)
}
})
sigConfMat <- reactive({
val <- correlation()
if(!is.null(val))
corTest(val, input$confLevel)
})
## Data and Correlation Validation and UI Updates #
#Update hclust rect max
observe({
val <- correlation()
if(!is.null(val))
updateNumericInput(session, "plotHclustAddrect", max = nrow(val))
})
#Update variable selection
observe({
updateCheckboxGroupInput(session, "variablesCheckbox", choices = numericColumns(), selected = numericColumns())
updateSelectInput(session, "variables", choices = numericColumns(), selected = numericColumns())
})
#Link Variable Selection
observe({
if(input$variablesStyle == "Checkbox") {
updateCheckboxGroupInput(session, "variablesCheckbox", selected = isolate(input$vairables))
}
})
observe({
updateSelectInput(session, "variables", selected = input$variablesCheckbox)
})
output$warning <- renderUI({
val <- correlation()
if(is.null(val)) {
tags$i("Waiting for data input...")
} else {
isNA <- is.na(val)
if(sum(isNA)) {
tags$div(
tags$h4("Warning Text"),
helpText("Help Text"),
renderTable(expand.grid(attr(val, "dimnames"))[isNA,]))
}
}
})
## Correlation Plot ##
server <- shinyServer(function(input, output) {
output$corrPlot <- renderPlot({
val <- correlation()
if(is.null(val)) return(NULL)
val[is.na(val)] <- 0
args <- list(val,
order = if(input$plotOrder == "manual") "original" else input$plotOrder,
hclust.method = input$plotHclustMethod,
addrect = input$plotHclustAddrect,
p.mat = sigConfMat()[[1]],
sig.level = if(input$sigTest) input$sigLevel else NULL,
insig = if(input$sigTest) input$sigAction else NULL,
lowCI.mat = sigConfMat()[[2]],
uppCI.mat = sigConfMat()[[3]],
plotCI = if(input$showConf) input$confPlot else "n")
if(input$showConf) {
do.call(corrplot, c(list(type = input$plotType), args))
} else if(input$plotMethod == "mixed") {
do.call(corrplot.mixed, c(list(lower = input$plotLower,
upper = input$plotUpper),
args))
} else {
do.call(corrplot, c(list(method = input$plotMethod, type = input$plotType), args))
}
})
sortableCheckboxGroupInput <- function(inputId, ...) {
# return label and select tag
attachDependencies(
tagList(
singleton(tags$head(tags$script(src="js/sortable.js"))),
checkboxGroupInput(inputId, ...),
tags$script(paste0("makeSortable($('#", inputId, "'));"))),
jqueryUIDep)
}
sortableSelectizeInput <- function (..., options = NULL)
{ # add drag_drop to plugin list
options <- if (is.null(options)) list() else options
options$plugins <- c(list("drag_drop"), options$plugins)
# return label and select tag
input <- selectizeInput(..., options = options)
attachDependencies(input, c(htmlDependencies(input), list(jqueryUIDep)))
}
library(shiny)
library(markdown)
library(corrplot)
ui <- shinyUI(fluidPage(
# Application title
titlePanel(list("Correlation Matrix with", tags$i("corrplot"))),
# Sidebar with a slider input
sidebarLayout(
sidebarPanel(
selectInput("dataset", "Dataset",
c("SocialTest")),
conditionalPanel("input.dataset === 'SocialTest'",
fileInput("datafile", ""),
textInput("datafile_sep", "Field Seperator", value = ",")),
tags$hr(),
selectInput("corMethod", "Correlation Method",
eval(formals(cor)$method)),
selectInput("corUse", "NA Action",
c("everything", "all.obs", "complete.obs", "na.or.complete", "pairwise.complete.obs")),
tags$hr(),
#Only works if we are not showing confidence interval
conditionalPanel("!input.showConf",
selectInput("plotMethod", "Plot Method",
list("mixed", all = eval(formals(corrplot)$method)), "circle"),
conditionalPanel("input.plotMethod === 'mixed'",
wellPanel(
selectInput("plotLower", "Lower Method", eval(formals(corrplot)$method)),
selectInput("plotUpper", "Upper Method", eval(formals(corrplot)$method)))
)
),
conditionalPanel("input.showConf || input.plotMethod !== 'mixed'",
selectInput("plotType", "Plot Type",
eval(formals(corrplot)$type))),
selectInput("plotOrder", "Reorder Correlation",
eval(formals(corrplot)$order)),
conditionalPanel("input.plotOrder === 'hclust'",
wellPanel(
selectInput("plotHclustMethod", "Method",
eval(formals(corrplot)$hclust.method)),
numericInput("plotHclustAddrect", "Number of Rectangles", 3, 0, NA))),
tags$hr(),
checkboxInput("sigTest", "Significance Test"),
conditionalPanel("input.sigTest",
numericInput("sigLevel", "Significane Level",
0.05, 0, 1, 0.01),
selectInput("sigAction", "Insignificant Action",
eval(formals(corrplot)$insig))),
checkboxInput("showConf", "Show Confidence Interval"),
conditionalPanel("input.showConf",
selectInput("confPlot", "Ploting Method",
eval(formals(corrplot)$plotCI)[-1]),
numericInput("confLevel", "Confidence Level",
0.95, 0, 1, 0.01))
),
# Show a plot of the generated correlation
mainPanel(
tabsetPanel(
tabPanel("Correlation",
column(3,
radioButtons("variablesStyle", "Variable Selection Style", c("Checkbox", "Selectize"), inline = T),
helpText("Choose the variables to display. Drag and drop to reorder."),
conditionalPanel("input.variablesStyle === 'Checkbox'",
sortableCheckboxGroupInput("variablesCheckbox", "", c("Loading..."))),
conditionalPanel("input.variablesStyle === 'Selectize'",
sortableSelectizeInput("variables", "", c("Loading..."), multiple = T, options = list(plugins = list("remove_button"))))),
column(9,
plotOutput("corrPlot", height = 600),
uiOutput("warning"))
),
tabPanel("Data",
dataTableOutput("dataTable")),
tabPanel("About",
includeMarkdown("README.md"))
)
)
)
))
shinyApp(ui = ui, server = server)
shiny::runApp(display.mode="showcase")
Reply all
Reply to author
Forward
0 new messages