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?
Related
Below I attach the code I use for the Shiny application. I am wondering how I can specifically use click="plot_click"/near-point/render print, to show part of data(). If you look at the attached image, you see that bunch of info has appeared see image, but I need to take "name", and winning times only.
#code------------------------------------
server<- function(input, output, session) {
#wrangling data:
gslam<- as.data.frame(gslam1)
gslam$tournament <- sapply(gslam$tournament, function(val)
{agrep(val, c('Australian Open', 'U.S.
Open','Wimbledon','FrenchOpen'),
value = TRUE)})
#pivot plot based on Tournament
reactive_data<-reactive({
req(input$sel_tournament)
df<- gslam %>% filter(tournament %in%
input$sel_tournament)%>%group_by(winner,tournament)%>%
mutate(winningNumber=n())
df<-df %>% arrange(winner)
})
#dynamic list
observe({
updateSelectInput(session,"sel_tournament", choices =
gslam$tournament, select="U.S. Open")
})
# create the plot
output$WinnerPlot <- renderPlot({
g<- ggplot(reactive_data(),aes( y =winner, x
=winningNumber),decreasing=FALSE) +
theme(legend.position=none")
g+geom_bar(stat="identity",width=0.5, fill="black")})
output$print = renderPrint({
nearPoints(
reactive_data(), # the plotting data
input$plot_click, # input variable to get the x/y
maxpoints = 1, # only show the single nearest point
threshold = 1000 # basically a search radius. set this big
# to show at least one point per click
)})
output$Top5Plot <-renderPlot({
g<- ggplot(reactive_data(),aes( y =winner, x
=winningNumber),decreasing=FALSE) + theme(legend.position =
"none")
g+geom_bar(stat="identity",width=0.5, fill="black")
})
}
ui <- navbarPage("Grand Slam Shiny Application", id="cc",
tabPanel("Winners' Rank",
fluidRow(titlePanel("Grand Slam
ShinyApp"),
sidebarPanel(
selectInput(inputId =
"sel_tournament",label="Choose Tournament:","Names"))),
plotOutput(("WinnerPlot"), click="plot_click"),
verbatimTextOutput('print')
),
tabPanel("Top 5 Winners' Performance",
plotOutput("Top5Plot"))
)
# Run the App
shinyApp(ui, server)
You may take help of dplyr::select in nearPoints.
output$print = renderPrint({
nearPoints(
dplyr::select(reactive_data(), winner, winningNumber),
input$plot_click,
maxpoints = 1,
threshold = 1000
)})
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)
}
I want to be able to display a dynamic vector as text output in my Shiny app. I also want to utilize HTML (bold, font colors, etc.), so I am using htmlOutput and renderUI instead of textOutputand renderText per this suggestion.
Here is some example code:
library(shiny)
shinyApp(
ui <- htmlOutput("example"),
server <- function(input, output, session){
# vector (in the real app, this is not a static vector--it will be updated with other inputs)
states <- c("Alabama", "Alaska", "Arizona", "Arkansas")
# text output
output$example <- renderUI({
x <- paste0("<strong>Here are your states</strong>: ", states)
HTML(x)
}) #END RENDERUI
} #END SERVER
) #END SHINYAPP
The result of this code is:
Here are your states: Alabama Here are your states: Alaska Here are
your states: Arizona Here are your states: Arkansas
What I want is :
Here are your states: Alabama Alaska Arizona Arkansas
I have come up with a solution using conditional statements, but it's pretty clunky. Here's what I put in renderUI for the above desired output:
x <- paste0("<strong>Here are your states: </strong>",
if(!is.na(states[1])){states[1]},
if(!is.na(states[2])){states[2]},
if(!is.na(states[3])){states[3]},
if(!is.na(states[4])){states[4]})
HTML(x)
Again, the above solution works, but it's rather clunky and will be terribly inefficient for larger vectors (with, let's say, 10+ elements). Is there an easier way to display these vectors while still being able to utilize HTML?
You are looking for paste(..., collapse = " ").
library(shiny)
shinyApp(
ui <- htmlOutput("example"),
server <- function(input, output, session){
# vector (in the real app, this is not a static vector--it will be updated with other inputs)
states <- c("Alabama", "Alaska", "Arizona", "Arkansas")
# text output
output$example <- renderUI({
x <- paste0("<strong>Here are your states</strong>: ", paste(states, collapse = " "))
HTML(x)
}) #END RENDERUI
} #END SERVER
) #END SHINYAPP
Based on this link I tried to include a table of contents in an HTML rmarkdown output. This works fine if I just knit it in RStudio, but when I try the same in Shiny, the table of contents doesn't show up. Am I doing something wrong or is this simply not possible? I also tried some custom css but that also doesn't seem to work. I need this because my users need to set some inputs and download an interactive document themselves with a toc. Please find an example below.
server.r
library(shiny)
library(rmarkdown)
library(htmltools)
library(knitr)
shinyServer(function(input, output) {
output$distPlot <- renderPlot({
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
output$Generate_PDF_Document <- downloadHandler(
# For PDF output, change this to "report.pdf"
filename = paste0("Highchart Document",format(Sys.Date(),"%d%m%Y"),".html"),
content = function(file) {
# # Copy the report file to a temporary directory before processing it, in
# # case we don't have write permissions to the current working dir (which
# # can happen when deployed).
tempReport <- normalizePath('Test.Rmd')
file.copy(tempReport, "Test.Rmd", overwrite = FALSE)
# Knit the document, passing in the `params` list, and eval it in a
# child of the global environment (this isolates the code in the document
# from the code in this app).
out <- render('Test.Rmd', html_document())
file.rename(out,file)
})
})
ui.r
library(shiny)
shinyUI(fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot"),
downloadButton('Generate_PDF_Document','Generate a PDF Report')
)
)
))
rmarkdown doc:
---
title: "Test"
output:
html_document:
toc: true
toc_depth: 3
toc_float: true
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```
## R Markdown
This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see <http://rmarkdown.rstudio.com>.
When you click the **Knit** button a document will be generated that includes both content as well as the output of any embedded R code chunks within the document. You can embed an R code chunk like this:
```{r cars}
summary(cars)
```
## Including Plots
You can also embed plots, for example:
```{r pressure, echo=FALSE}
plot(pressure)
```
Note that the `echo = FALSE` parameter was added to the code chunk to prevent printing of the R code that generated the plot.
Remove html_document() from render. I have not studied the details, but it looks like it forces override of the yaml front matter.
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)