I would like to use the CSV quick plot application to analyze data however even with all the packages installed the app continues to show an error. The error message is:
Error in file(file, "rt") : cannot open the connection
Warning in run(timeoutMs) :
cannot open file
The code is below:
UI
library(shiny)
shinyUI(pageWithSidebar(
headerPanel("CSV Quick Plot"),
sidebarPanel(
fileInput('infile', 'Choose file to upload',
accept = c(
'text/csv',
'text/comma-separated-values',
'text/tab-separated-values',
'text/plain',
'.csv',
'.tsv'
)
),
selectInput("plotType", label = "Select Plot Type",
c("Histogram" = "hist",
"Correlation" = "corr")),
dateInput("date", "Date:"),
submitButton("Submit")
),
mainPanel(
h3('Output Information'),
h4('File entered'),
verbatimTextOutput("ofile"),
h4('You selected plot type'),
verbatimTextOutput("oplotType"),
h4('You entered'),
verbatimTextOutput("odate"),
plotOutput('newHist')
)
))
server
library(UsingR)
library(shiny)
library(Hmisc)
library(corrplot)
wd <- getwd()
setwd(wd)
shinyServer(
function(input, output) {
output$ofile <- renderPrint({input$infile})
output$oplotType <- renderPrint({input$plotType})
output$odate <- renderPrint({input$date})
plotdata <- reactive({
filestr <- input$infile
read.csv(filestr$name)
if(is.null(input$file1))
return(NULL)
})
output$newHist <- renderPlot({
hist(plotdata())
})
# Conditional plot selection is test in progress
# corrdf <- cor(plotdata)
# output$newHist <- renderPlot({
# corrplot(corrdf, method = "circle")
# })
}
)
Please help me in getting this application to run. Thank you!
There are three problems with your code.
you're checking for if(is.null(input$file1)) but I believe you want to use input$infile
the above check should be done BEFORE read.csv because if there is no file chosen, you don't want to read a file
when reading the file you want to use filestr$datapath instead of filestr$name. The name only gives you the name of the file on the user's local machine, while the datapath gives the actual full path to the file that's been uplodaed
Here is a simplification of your app that only deals with selecting a file and reading it into csv, demonstrating all those points
runApp(shinyApp(
ui = fluidPage(
fileInput('infile', 'Choose file to upload',
accept = c(
'text/csv',
'text/comma-separated-values',
'text/tab-separated-values',
'text/plain',
'.csv',
'.tsv'
)
)
),
server = function(input, output, session) {
plotdata <- reactive({
if (is.null(input$infile)) {
return()
}
filestr <- input$infile
read.csv(filestr$datapath)
})
observe({
cat(str(plotdata()))
})
}
))
Related
I have a shiny which can be used to overlap between query regions and a given data table (e.g. DF). I put two options for uploading query data 1) as .bed format and 2) inserting data as copy/paste.
The shiny works well with uploading .bed file but I am not sure how can I define Server for copy/paste (text) data.
Thank you in advance for any suggestion!
DF<- data.table(chr=c("chr1","chr2"),start=c(10,20),end=c(20,30))%>% setkey(chr, start, end)
text<- data.table(chr=c("chr1","chr2"),start=c(15,25),end=c(15,30))%>% setkey(chr, start, end)
ui <- fluidPage(
sidebarLayout(
sidebarPanel (
p(strong ("Find overlap between query file and data"),style = "color:blue;"),
br(),
selectInput("choose","Choose file source",choices = c("file","text"),selected = "file"),
conditionalPanel("input.choose=='file'",
fileInput("query.file", "Upload genomic coordinates in .bed
format:",multiple = F,accept = ".bed")),
conditionalPanel("input.choose=='text'",
textAreaInput("query.text", "Enter genomic coordinates:")),
actionButton("run", "run"),
width = "2"),
mainPanel(
dataTableOutput("DFtable"),
dataTableOutput("overlap_table"))
)
)
server <- function (input, output, session) {
## Read user .bed file
user_query.file <- reactive({
req(input$query.file)
ext <- tools::file_ext(input$query.file$name)
switch(ext,
bed = fread(input$query.file$datapath,header=F)%>%
dplyr::rename (chr =V1, start=V2, end=V3) %>% setkey(chr, start, end)%>% unique()
)
})
## overlapping between query file and table
overlap <- eventReactive(input$run, {
req(input$run)
withProgress(message = 'Analysis in progress', value = 0, {
query.overlap<- foverlaps(user_query.file() ,DF, nomatch = 0) %>%
unique()
})
})
## output
output$DFtable<- renderDataTable({ DF })
output$overlap_table <- renderDT({overlap () })
}
shinyApp(ui, server)
Desire out put using TEXT input option:
chr start end i.start i.end
chr1 15 15 10 20
chr2 25 30 20 30
Not sure on how your copied text looks like, but assuming something like:
chr,start,end
chr1,10,20
chr4,34,56
All you need is to parse the text contents of the UI input and assigned it to DF variable. Your run event handler could look like:
## overlapping between query file and table
overlap <- eventReactive(input$run, {
req(input$run)
#Requiring text input and parsing it
req(input$query.text)
DF <- data.table(read.csv(text=input$query.text)) %>% setkey(chr, start, end)
withProgress(message = 'Analysis in progress', value = 0, {
query.overlap<- foverlaps(text ,DF, nomatch = 0) %>%
unique()
})
})
Then when clicking on the run button, the analysis is executed and the overlap reactive value is updated. If the comparison is always between file and text provided, you should also include a req(user_query.file()) to ensure the file has been provided and correctly parsed.
The HTML output is created by summarytool::dfSummary function.
summarytools
summarytools uses Bootstrap’s stylesheets to generate standalone HTML documents that can be displayed in a Web Browser or in RStudio’s Viewer using the generic print() function.
When the HTML gets rendered on the tabpanel, the whole UI changes. Is there a way to render the HTML on the tabpanel without changing the UI?
library(summarytools)
ui <- fluidPage(
titlePanel("dfSummary"),
sidebarLayout(
sidebarPanel(
uiOutput("dfSummaryButton")
),
mainPanel(
tabsetPanel(
tabPanel("Data Input",
dataTableOutput("dataInput"),
br(),
verbatimTextOutput("profileSTR")),
tabPanel("dfSummary Output",
htmlOutput("profileSummary")))
)
)
)
server <- function(input, output, session) {
#Read in data file
recVal <- reactiveValues()
dfdata <- iris
#First 10 records of input file
output$dataInput <- renderDataTable(head(dfdata, n = 10), options = list(scrollY = '500px',
scrollX = TRUE, searching = FALSE, paging = FALSE, info = FALSE,
ordering = FALSE, columnDefs = list(list(className = 'dt-center',
targets = '_all'))))
#str() of input file
output$profileSTR <- renderPrint({
ProStr <- str(dfdata)
return(ProStr)
})
#Create dfSummary Button
output$dfSummaryButton <- renderUI({
actionButton("dfsummarybutton", "Create dfSummary")
})
### Apply dfSummary Buttom
observeEvent(input$dfsummarybutton, {
recVal$dfdata <- dfdata
})
#dfSummary data
output$profileSummary <- renderUI({
req(recVal$dfdata)
SumProfile <- print(dfSummary(recVal$dfdata), omit.headings = TRUE, method = 'render')
SumProfile
})
}
shinyApp(ui, server)
Version 0.8.3 of summarytools has a new boolean option, bootstrap.css which will prevent this from happening. Also, graph.magnif allows adjusting the graphs' size.
SumProfile <- print(dfSummary(recVal$dfdata),
method = 'render',
omit.headings = TRUE,
footnote = NA,
bootstrap.css = FALSE,
graph.magnif = 0.8)
The latest version can be installed with devtools:
devtools::install_github("dcomtois/summarytools")
Good luck :)
Trying to take these ideas a step further:
HTML/Text/Markdown in Shiny
Render Images
I want to include a reactive markdown file (*.Md) in a mainPanel conditional on the input to a selectInput. How do I do it?
I've tried variations on renderText, renderPrint and using eval inside includeMarkdown. Nothing seems to work so far.
EG.
### ui.R
shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("var1",
label= "Please Select option",
choices= c("option1", "option2", "option3"),
selected= "option1"
),
mainPanel(
h3("guide:")
includeMarkdown("md_file")
)
)
))
### server.R
shinyServer(function(input, output) {
output$md_file <-
if (input$var1 == "option1") {
renderPrint({"option1.Md"})
} else if (input$var1 == "option2") {
renderPrint({"option2.Md"})
} (input$var1 == "option3") {
renderPrint({"option3.Md"})
}
})
})
R> shiny::runApp('C:/Shiny_demo')
Listening on http://127.0.0.1:6421
Warning in readLines(con) :
cannot open file 'md_file': No such file or directory
Error in readLines(con) : cannot open the connection
Based on a discussion with Joe Cheng in the Shiny Google group, the answer is:
In your UI:
uiOutput("md_file")
In your server:
output$md_file <- renderUI({
file <- switch(input$var1,
option1 = "option1.Md",
option2 = "option2.Md",
option2 = "option3.Md",
stop("Unknown option")
)
includeMarkdown(file)
})
Thanks, Joe!
[EDIT]: solution by agstudy worked for me.
I have a shiny app that allows users to toggle between three tables in a MySQL database. Users can select a table which is used by renderTable to generate the object.
I have put if statements in renderTable to respond to the users' selected table.
When I run the app, any table fails to print and cannot be viewed.
server.R
library(shiny)
library(RMySQL)
con <- dbConnect(RMySQL::MySQL(),user="x",password="x",host="dbhost",dbname="db")
shinyServer(function(input, output) {
data <- reactive({
selectInput("input$data", "Choose your Input:", choices = c('data1'='1','data2'='2', 'data3'='3'))
})
output$table <- renderTable({
if(input$data == data1){
query1 <- reactive({ "SELECT *
FROM data1
ORDER BY var1, var2"})
reactive({dbGetQuery(con,query1())})
head(data())
} else if(input$data == data2){
query1 <- reactive({ "SELECT *
FROM data2
ORDER BY var1, var2"})
reactive({dbGetQuery(con,query1())})
head(data())
} else if(input$data == data3){
query1 <- reactive({ "SELECT *
FROM data3
ORDER BY var1, var2"})
reactive({dbGetQuery(con,query1())})
head(data())
} else print("Select a dataset")
})
})
ui.R
library(shiny)
library('RMySQL')
shinyUI(navbarPage("Test",
tabPanel("Test",
sidebarLayout(
sidebarPanel(
selectInput("data", label = "Data set",
choices = c("", "data1", "data2", "data3"))
),
mainPanel(
tableOutput("table")
)
))
))
Your problem here is not in any case related to MySQLserver but there is a no UI logic. Programming in Shiny is not easy if you don't isolate your code parts:
inputs: defined in your ui interface
reactive functions : should change each time you change your input
outputs: be refreshed once the input data is changed by the reactive function.
You miss-understand the reactive.The basic idea is that your don't need to refresh your UI manually, it should be done automatically once the input parameter is changed.
Here I am rewriting completely your code using the Shiny logic:
library(RMySQL)
library(shiny)
## this a public function that will be used
## in the server side to connect to the data base
## and retrieve data
get_data <-
function(query){
on.exit(dbDisconnect(conn)) ## important to close connection
conn <- dbConnect("MySQL",user="xuser",
password="xpws",
host="xhost",
dbname="xdbname")
dbGetQuery(con,query)
}
server <- shinyServer(
function(input, output) {
## the reactive engine that will refresh query
## each time input changed
query <- reactive( sprintf("SELECT *
FROM %s
ORDER BY var1, var2",input$data)
)
## simply displaying reactive inputs
output$table <- renderTable(
if(input$data!="") get_data(query())
)
})
## define ui elements by step
## for easy indenting
ui_panel <-
tabPanel("Test",
sidebarLayout(
sidebarPanel(
selectInput("data", label = "Data set",
choices = c("","data1", "data2", "data3"))
),
mainPanel(
tableOutput("table")
)
)
)
ui <- shinyUI(navbarPage("Test",ui_panel))
runApp(list(ui=ui,server=server))
I want to create rChart for my data extracted from a mysql database. As shown in ui.R and server.R created ggplot is visible but not the rChart? Can anyone explain what has gone wrong here?
ui.R
library(shiny)
library("shinyBS", lib.loc="/home/thisa/R/x86_64-pc-linux-gnu-library/3.0")
require("rCharts")
options(RCHART_LIB = 'polycharts')
# Define UI for application that plots random distributions
shinyUI(fluidPage(
# Show a plot of the generated distribution
mainPanel(
fluidRow(
column(width=4,
plotOutput("sales")
),
column(width=8,
showOutput("salesR","polycharts")
)
)
)
))
server.R
library(shiny)
library("DBI", lib.loc="/home/thisa/R/x86_64-pc-linux-gnu-library/3.0")
library("RMySQL", lib.loc="/home/thisa/R/x86_64-pc-linux-gnu-library/3.0")
library("ggplot2", lib.loc="/home/thisa/R/x86_64-pc-linux-gnu-library/3.0")
library("shinyBS", lib.loc="/home/thisa/R/x86_64-pc-linux-gnu-library/3.0")
require("rCharts")
con <- dbConnect(MySQL(),
user="root",password="891208",host="localhost",dbname="openPos")
# Define server logic required to generate and plot a random distribution
shinyServer(function(session,input, output) {
sales_total <- reactive({ "SELECT ospos_sales.sale_time,
CAST(sale_time AS date) AS sale_date, ospos_sales.employee_id,
ospos_sales.sale_id, ospos_sales_items.line,
ospos_sales_items.quantity_purchased,
ospos_sales_items.item_cost_price,
ospos_sales_items.item_unit_price,
ospos_sales_items.discount_percent,
ospos_suppliers.person_id,
ospos_suppliers.company_name,
ospos_items.name, ospos_items.category,
ospos_items.supplier_id,
ospos_items.item_number,
ospos_items.quantity,
ospos_items.reorder_level,
ospos_items.location,
sum(quantity_purchased * item_unit_price-item_unit_price*(discount_percent/100))
AS revenue, sum(quantity_purchased * item_cost_price) AS cost
FROM ospos_sales, ospos_sales_items,
ospos_suppliers, ospos_items
WHERE ospos_sales.sale_id = ospos_sales_items.sale_id
AND ospos_sales_items.item_id = ospos_items.item_id
AND ospos_items.supplier_id = ospos_suppliers.person_id
GROUP BY sale_time"})
salesTotal <- reactive({dbGetQuery(con,sales_total())})
output$sales <- renderPlot
({
p<-ggplot(salesTotal(),
aes_string(x="sale_time",y="revenue"))+geom_point()
print(p)})
output$salesR <- renderChart({
m1 <- rPlot(revenue ~ sale_time, data = salesTotal(),type='point')
return(m1)
})
})