I have a problem in RShiny. Below I show code from 2 files:
# File app.R
library(shiny)
library(dplyr)
source("myscript.R")
library(rhandsontable)
shinyUI<-fluidPage(
fluidRow(
titlePanel(title = "Application in RSHINY"),
textInput("text1", "Give numbers with commas","1,3,12,18"),
submitButton("Update!"),
column(8,actionButton("saveBtn","Save"),rHandsontableOutput("table"))))
shinyServer<-function(input,output,session){
output$table <- renderRHandsontable({
arg=(strsplit(input$text1,",") %>% unlist() %>% as.numeric())
tabelaa=dataframe_FUNCTION(arg)
rownames(tabelaa)=paste("Row",1:4,sep="")
rhandsontable(format(tabelaa, digits=0),width=400,rowHeaderWidth=300)
})
}
shinyApp(ui=shinyUI, server=shinyServer)
Problem 1) When I change value in rhandsontable and click on button Update,
I want to change rhandsontable values automatically.
Problem 2) How to write current rhandsonetable to csv file
## myscript.R
dataframe_FUNCTION<-function(...){
aa=list(...)
my_df=data.frame(aa)
colnames(my_df)="COL"
return(my_df^2)
}
Related
EDIT: Because I had set the format options in a global function, I have to set either latex_options or bootstrap_options in the kable_styling() call. I was using bootstrap_options which wasn't being read by the latex. My work-around is to make the tables twice, once in a chunk for html, and once in a chunk for latex. Not great, but it works if I click the Knit button and choose Knit to PDF. However, it throws the original error when I try to run it in the shiny app.
I have created a test version (MiniTest) of my project. What I need to do is have a shiny app run with a tab that will produce an html file for a user-chosen (reactive) Country, and provide an Excel download (I have that working so kept it out of this example), and a PDF download. I knit in an .Rmd which chooses the format and allows for parameterization. (The shiny part was set up by someone else, from whom I took over this project when they left before finishing it.)
I use kable and kableExtra to create and format tables, as I heard it words for both html and LaTeX output. The HTML is more as less as I want it. I can knit either html or PDF, and it runs, BUT when in the shiny app, only the html portion works. I think I have narrowed down the PDF issue(s) to column_spec crashing the download. If I comment out the column_spec lines in t01 and t02, the Download PDF runs. But I need that formatting. I'm sorry, but I've lost track of all the sites I have searched.
In global.R, I set:
countries <- c("ABC", "DEF", "GHI", "JKL")
In the .Rmd, I have YAML set up (with two-space indents for Country and output types):
params:
Country: ABC
output:
pdf_document: default
html_document: default
Relevant .Rmd chunks and inline code include:
knitr::opts_chunk$set(echo = FALSE)
options(knitr.table.format = function() {
if (knitr::is_latex_output()) "latex" else "html"
})
library(shiny)
library(htmlwidgets)
library(shinythemes)
library(shinydashboard)
library(shinyjs)
library(shinycssloaders)
library(markdown)
library(tidyr)
library(tidyverse)
library(janitor)
library(kableExtra)
options(scipen = 999)
mini <- mtcars %>%
tibble::rownames_to_column(var = "car") %>%
mutate(Country = c(rep("ABC", 8), rep("DEF", 8), rep("GHI", 8), rep("JKL", 8)))
## https://bookdown.org/yihui/rmarkdown-cookbook/font-color.html
colorize <- function(x, color) {
if (knitr::is_latex_output()) {
## hack setting color='blue' instead of a hexcode with # that breaks the LaTeX code
sprintf("\\textcolor{%s}{%s}", color = 'blue', x) ## works, but isn't right blue
} else if (knitr::is_html_output()) {
sprintf("<span style='color: %s;'>%s</span>", color, x)
} else x
}
## make two tables with `kable` and `kableExtra`
new_title <- paste0("Dynamically Changing Country Name in column", params$Country)
t01 <- mini %>%
filter(Country == params$Country) %>%
select(car, mpg:hp) %>%
rename({{new_title}} := car) %>%
kable(align = c("l", "c", "c", "c", "c")) %>%
kable_styling(full_width = FALSE, position = "left", bootstrap_options = c("striped", "condensed")) %>%
column_spec(1, bold = TRUE) %>%
column_spec(2:3, width = "5em") %>%
row_spec(0, color = "#2A64AB") %>%
row_spec(6, bold = TRUE)
t02_title <- paste0(params$Country, " Table with Dollar Signs in Var Names")
t02 <- mini %>%
filter(Country == params$Country) %>%
select(car, drat, wt) %>%
mutate(car = case_when(car == "Mazda RX4" ~ "Mazda RX4 (US\\$)*", TRUE ~ as.character(car))) %>%
## want to blank out column names - removing them entirely would be best, but it fails
kable(align = c("l", "r", "c"), escape = TRUE, col.names = c("", "", "")) %>%
kable_styling(full_width = FALSE, position = "left", bootstrap_options = c("striped", "condensed")) %>%
column_spec(1, bold = TRUE) %>%
column_spec(2, width = "10em") %>%
footnote(general = "*Never smart to start with an asterisk, but here we are", general_title = "")
## make two charts with `ggplot2`
chart1 <- mini %>%
filter(Country == params$Country) %>%
select(car, mpg:hp) %>%
ggplot2::ggplot(mapping = aes(x = mpg)) +
geom_col(aes(y = `cyl`, fill = "cyl"), color = "black")
c1_title <- paste0("Some fab title here for ", params$Country)
chart2 <- mini %>%
filter(Country == params$Country) %>%
select(car, vs:carb) %>%
ggplot2::ggplot(mapping = aes(x = carb)) +
geom_col(aes(y = `gear`, fill = "gear"), color = "black")
c2_title <- paste0("Another chart, ", params$Country)
## make a "tiny" LaTeX environment that is only generated for LaTeX output, with chunk setting `include = knitr::is_latex_output()`.
knitr::asis_output('\n\n\\begin{tiny}')
## Table 1
t01
I expect a PDF to pop up, but instead a Save File box pops up asking to save "DownloadPDF" with no file extension. The ui.R is supposed to name it as "FactCountryName.pdf" where "CountryName" is input from the Country the user chose in the drop-down list. Regardless of whether I choose Save (nothing happens) or Cancel, my R throws the following error:
```
! LaTeX Error: Illegal character in array arg.
```
If I comment out the line column_spec(1, bold = TRUE) %>%, the error changes to:
```
! Use of \#array doesn't match its definition.
\new#ifnextchar ...served#d = #1\def \reserved#a {
#2}\def \reserved#b {#3}\f...
l.74 ...m}|>{\centering\arraybackslash}p{5em}|c|c}
```
Please help!
Turns out that using the Knit button in R automatically loads the required LaTeX packages, such as booktabs. Running the file in the Shiny app was not loading all the packages needed. All I had to do was specifically call the extra packages in the YAML (which I found by looking at the .tex file made from the PDF through Knit button).
---
params:
Country: ABC
header-includes:
- \usepackage{booktabs}
- \usepackage{longtable}
- \usepackage{array}
- \usepackage{multirow}
- \usepackage{wrapfig}
- \usepackage{float}
- \usepackage{colortbl}
- \usepackage{pdflscape}
- \usepackage{tabu}
- \usepackage{threeparttable}
- \usepackage{threeparttablex}
output:
pdf_document:
keep_tex: true
html_document: default
---
I plot data with highcharter package in R, and save them as html to keep interactive features. In most cases I plot more than one graph, therefore bring them together as a canvas.
require(highcharter)
hc_list <- lapply(list(sin,cos,tan,tanh),mapply,seq(1,5,by = 0.1)) %>%
lapply(function(x) highchart() %>% hc_add_series(x))
hc_grid <- hw_grid(hc_list,ncol = 2)
htmltools::browsable(hc_grid) # print
htmltools::save_html(hc_grid,"test_grid.html") # save
I want to extract the data from plots that I have saved as html in the past, just like these. Normally I would do hc_list[[1]]$x$hc_opts$series, but when I import html into R and try to do the same, I get an error. It won't do the job.
> hc_imported <- htmltools::includeHTML("test_grid.html")
> hc_imported[[1]]$x$hc_opts$series
Error in hc_imported$x : $ operator is invalid for atomic vectors
If I would be able to write a function like
get_my_data(my_imported_highcharter,3) # get data from 3rd plot
it would be the best. Regards.
You can use below code
require(highcharter)
hc_list <- lapply(list(sin,cos,tan,tanh),mapply,seq(1,5,by = 0.1)) %>%
lapply(function(x) highchart() %>% hc_add_series(x))
hc_grid <- hw_grid(hc_list,ncol = 2)
htmltools::browsable(hc_grid) # print
htmltools::save_html(hc_grid,"test_grid.html") # save
# hc_imported <- htmltools::includeHTML("test_grid.html")
# hc_imported[[1]]$x$hc_opts$series
library(jsonlite)
library(RCurl)
library(XML)
get_my_data<-function(my_imported_highcharter,n){
webpage <- readLines(my_imported_highcharter)
pagetree <- htmlTreeParse(webpage, error=function(...){})
body <- pagetree$children$html$children$body
divbodyContent <- body$children$div$children[[n]]
script<-divbodyContent$children[[2]]
data<-as.character(script$children[[1]])[6]
data<-fromJSON(data,simplifyVector = FALSE)
data<-data$x$hc_opts$series[[1]]$data
return(data)
}
get_my_data("test_grid.html",3)
get_my_data("test_grid.html",1)
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()))
})
}
))
I'm downloading a png image according to user provided input, and I show the image with
mainPanel(
img(src="file.png", height =1187 , width = 748)
)
but, if the user changes the input I have to refresh the page.
The app draft is follows below
the ui
library(shiny)
org <- read.delim("http://rest.kegg.jp/list/organism", header=FALSE)
org <- apply(org[,2:3], 1, function(x) paste(as.matrix(x), collapse="-"))
# Define UI for dataset viewer application
shinyUI(fluidPage(
# Application title
titlePanel("Reactivity"),
# Sidebar with controls to provide a caption, select a dataset, and
# specify the number of observations to view. Note that changes made
# to the caption in the textInput control are updated in the output
# area immediately as you type
sidebarLayout(
sidebarPanel(
textInput("caption", "Caption:", "Data Summary"),
tags$textarea(id="foo", rows=3, cols=40, "Default value"),
selectInput("dataset", "Choose an organism:",
choices = org ),
numericInput("obs", "Number of observations to view:", 10)
),
# Show the caption, a summary of the dataset and an HTML table with
# the requested number of observations
mainPanel(
h3(textOutput("caption")),
verbatimTextOutput("summary"),
tableOutput("view"),
plotOutput('plot1'),
img(src="file.png", height =1187 , width = 748)
)
)
))
and the server
library(shiny)
# Define server logic required to summarize and view the selected dataset
shinyServer(function(input, output) {
output$caption <- renderText({
cps <- strsplit(input$foo, "\\s+")[[1]]
#tab <- read.table("http://rest.kegg.jp/link/pathway/zma")
#path2cpd <- read.table("http://rest.kegg.jp/link/pathway/compound")
#allmetab <- unique(path2cpd[which(path2cpd[,2] %in% sub("path:zma", "path:map", tab[,2])),])
#cps <- unique(allmetab[,1])
#
url <- "http://www.kegg.jp/kegg-bin/show_pathway?zma00944+default%3dred+"
url <- paste(url, paste(cps, collapse="+"), sep="+")
download.file(url, "form.html")
lines <- readLines("form.html")
imgUrl <- lines[grep('img src="/', lines)]
url <- paste0("http://www.kegg.jp/", strsplit(imgUrl, '"')[[1]][2])
download.file(url, "www/file.png")
url
})
# The output$summary depends on the datasetInput reactive expression,
# so will be re-executed whenever datasetInput is invalidated
# (i.e. whenever the input$dataset changes)
output$plot1 <- renderPlot({
})
})
if you paste the compound codes
C01477
C04608
C04858
C05622
in the box with "Default Value" written I would like to automatically update the picture, or at least have a button to update without having to reload all the app.
If one reloads the navigator one can see the figure with the red dots colored (at the page bottom).
How can I make the function read the image again after a time interval?
I am developing a Shiny application in R. For certain pieces of renderPrint output I would like the shiny user interface to display nothing. Kind of like the hidden option for pre or div tags in HTML5 example shown below:
http://www.w3schools.com/tags/tryit.asp?filename=tryhtml5_global_hidden
Below is my shiny example code. A brief explanation: you can use a drop down menu to select one of two variables (factor variable or continuous variable). If you select the factor variable I want to show the caption and the table output. If you select the continuous variable I don't want to see anything. Right now, the caption disappears if you insert a blank string "" as the return to renderText. However, I don't know how to get renderPrint to show nothing. I've tried:
"". Doesn't work as it returns the actual blank string
NULL. Doesn't work as it returns the string NULL
invisible(). Best so far, but still doesn't work as it returns the grey formatted box.
Goal is to just display nothing. Shiny ui.r and server.r code given below:
library(shiny)
##
## Start shiny UI here
##
shinyUI(pageWithSidebar(
headerPanel("Shiny Example"),
sidebarPanel(
wellPanel(
selectInput( inputId = "variable1",label = "Select First Variable:",
choices = c("Binary Variable 1" = "binary1",
"Continuous Variable 1" = "cont1"),
selected = "Binary Variable 1"
)
)
),
mainPanel(
h5(textOutput("caption2")),
verbatimTextOutput("out2")
)
))
##
## Start shiny server file and simulated data here
##
binary1 <- rbinom(100,1,0.5)
cont1 <- rnorm(100)
dat <- as.data.frame(cbind(binary1, cont1))
dat$binary1 <- as.factor(dat$binary1)
dat$cont1 <- as.numeric(dat$cont1)
library(shiny)
shinyServer(function(input, output) {
inputVar1 <- reactive({
parse(text=sub(" ","",paste("dat$", input$variable1)))
})
output$caption2 <- renderText({
if ( (is.factor(eval(inputVar1()))==TRUE) ) {
caption2 <- "Univariate Table"
} else {
if ( (is.numeric(eval(inputVar1()))==TRUE) ) {
caption2 <- ""
}
}
})
output$out2 <- renderPrint({
if ( (is.factor(eval(inputVar1()))==TRUE) ) {
table(eval(inputVar1()))
} else {
if ( (is.numeric(eval(inputVar1()))==TRUE) ) {
invisible()
}
}
})
})
A few questions...
Why does renderText handle hidden/invisible presentation different than renderPrint? Is it because the former outputs text as pre tag; whereas, the latter displays formatted output in div tag?
To those HTML experts (upfront, I am not one)...what option would be best to get my output to display nothing? Is the hidden option embedded in a pre or div tag best (I know it doesn't work in IE browsers). Should I try something else? CSS options, etc?
Assuming hidden is the best way to go (or that I get an answer to 2. above), how do I pass this option/argument through the renderPrint function in shiny? Or would I need to use a different shiny function to achieve this functionality?
Btw...My R version is: version.string R version 3.0.1 (2013-05-16) and I am using shiny version {R package version 0.6.0}. Thanks in advance for your help.
I am not sure that I have understood your question, but try the following:
here is the Ui first:
library(shiny)
ui <- fluidPage(pageWithSidebar(
headerPanel("Shiny Example"),
sidebarPanel(
wellPanel(
selectInput(inputId = "variable1",label = "Select First Variable:",
choices = c("Binary Variable 1" = "binary1",
"Continuous Variable 1" = "cont1"),
selected = "Binary Variable 1"
)
)
),
mainPanel(
h5(textOutput("caption2")),
verbatimTextOutput("out2", placeholder=TRUE)
)
))
Start shiny Server file and simulated data here:
binary1 <- rbinom(100,1,0.5)
cont1 <- rnorm(100)
dat <- as.data.frame(cbind(binary1, cont1))
dat$binary1 <- as.factor(dat$binary1)
dat$cont1 <- as.numeric(dat$cont1)
server <- (function(input, output) {
inputVar1 <- reactive({
parse(text=sub(" ","",paste("dat$", input$variable1)))
})
output$caption2 <- renderText({
if ((is.factor(eval(inputVar1()))==TRUE) ) {
caption2 <- "Univariate Table"
} else {
if ((is.numeric(eval(inputVar1()))==TRUE) ) {
caption2 <- "Continous"
}
}
})
output$out2 <- renderPrint({
if ((is.factor(eval(inputVar1()))==TRUE) ) {table(eval(inputVar1()))}
})
})
And finally:
shinyApp(ui = ui, server = server)