I'm building a shiny app and I need one of the tabpanels to show the R Documentation of one of the functions of the package RecordLinkage, so the user can choose his argument options.
I have tried
library(shiny)
library(RecordLinkage)
ui <- fluidPage(
tabPanel("Literature of functions",
selectInput(
"literatureChoice",
"Choose a function : ",
choices = c("compare.dedup",
"compare.linkage")
),
textOutput("literatureOutput")
),
)
server <- function(input, output) {
output$literatureOutput <- renderText({
?compare.linkage
})
}
But it doesn't show any documentation. I'm aware that ?compare.linkage shows in help panel in RStudio instead of the console.
R help documentations are stored in Rd objects. We need a way to fetch this object and render them in Shiny.
We fetch the Rd object with the help of Rd_fun() found in the gbRd package.
We then parse the file into html with Rd2HTML. The file is saved in the temp directory and read back into R.
The example is for the reactive() function found in the shiny package, replace it with whichever function required.
library(shiny)
library(gbRd)
library(tools)
ui <- fluidPage(
tabPanel("Literature of functions",
selectInput(
"literatureChoice",
"Choose a function : ",
choices = c("compare.dedup",
"compare.linkage")
),
htmlOutput("literatureOutput")
)
)
server <- function(input, output) {
output$literatureOutput <- renderText({
temp = Rd2HTML(Rd_fun("reactive"),out = tempfile("docs"))
content = read_file(temp)
file.remove(temp)
content
})
}
shinyApp(ui,server)
Related
In the below example code, the function testFunction() is defined in the separate source file functionsLibrary.R saved on the desktop. This example code works as intended.
How would I modify the code to first test if testFunction() is an object in the R workspace, and source it (running the line source("C:/Users/laran/OneDrive/Desktop/functionsLibrary.R")) only if the function is not in the workspace?
In the full code this is intended for, the function takes a very long time to run (reading a large data file into memory) and I only want it sourced if it is not currently a workspace object.
Example code:
library(shiny)
source("C:/Users/laran/OneDrive/Desktop/functionsLibrary.R")
ui <- fluidPage(
br(),
numericInput('selectValue','Select number of values to square:',value=1,step=1,min=1),
br(),
tableOutput('table')
)
server <- function(input,output,session)({
output$table <- renderTable(testFunction(input$selectValue))
})
shinyApp(ui, server)
Source file contents (filename functionsLibrary.R):
testFunction <- function(a) {
b <- data.frame(Value=seq(1:a),Square_Value = seq(1:a)^2)
return(b)
}
An easy way to go about this would be to use exist(). This should work for your problem.
library(shiny)
if (!exists("testFunction")) {
source("C:/Users/laran/OneDrive/Desktop/functionsLibrary.R")
}
ui <- fluidPage(
br(),
numericInput('selectValue','Select number of values to square:',value=1,step=1,min=1),
br(),
tableOutput('table')
)
server <- function(input,output,session)({
output$table <- renderTable(testFunction(input$selectValue))
})
shinyApp(ui, server)
We could extend the if clause to check if testFunction is really a function in case it exists and if not source the file.
if (!exists("testFunction") || (exists("testFunction") && !is.function(testFunction)))
I have a Shiny app that wrangles a large csv file. Currently the user can select a facility_id number from a drop down menu to get a specific plot, see https://r.timetochange.today/shiny/Annual_Emissions2/. I would like to pass this id with a URL parameter like /?selected_facilities=1010040 so I can embed the plots in another website.
I have taken the code from How do you pass parameters to a shiny app via URL and tried to use it to update my selectInput() value in the server section of the Shiny app, but I don't really understand how the UI part is constructed so I am not getting it right. Any help would really be appreciated! Here is the relevant code:
#### shiny UI ####
facilities <- unique(ghg_emissions$facility_id)
ui <- fluidPage(
titlePanel("Annual Greenhouse Gas Emissions"),
sidebarLayout(
sidebarPanel(
selectInput("selected_facility",
"Select facility",
choices = facilities) # select input gives the drop down menu to select facilities
),
mainPanel(
plotlyOutput("facility_plot")
)
)
)
#### shiny server ####
server <- function(input, output, session) {
# Here you read the URL parameter from session$clientData$url_search
observe({
query <- parseQueryString(session$clientData$url_search)
if (!is.null(query[['selected_facility']])) {
updateSelectInput(session, "selected_facility", value = query[['selected_facility']])
}
})
Your UI is good, the issue with the updateSelectInput, use selected rather than value and include choices.
Minimal working example:
library(shiny)
facilities <- seq(1:5)
ui <- fluidPage(
selectInput("selected_facility", "Select facility", choices = facilities)
)
server <- function(input, output, session) {
observe({
#Get URL query
query <- parseQueryString(session$clientData$url_search)
#Ignore if the URL query is null
if (!is.null(query[['selected_facility']])) {
#Update the select input
updateSelectInput(session, "selected_facility", selected = query[['selected_facility']], choices = facilities)
}
})
}
shinyApp(ui, server)
To test, run your shiny app, click 'Open in Browser' and append your query to the URL, e.g.
127.0.0.1:6054/?selected_facility=4
To reproduce :
library(shiny)
library(DT)
testdf<-c("car1",sample(1:1000,1),sample(1:10,1),sample(1:10,1),sample(1:10,1))
testdf<-rbind(testdf,c("car2",sample(1:1000,1),sample(1:10,1),sample(1:10,1),sample(1:10,1)))
testdf<-data.frame(testdf)
shinyApp(
ui = fluidPage(
tabPanel("tab1",dataTableOutput("datatable")),
actionButton("CheckFile", "Refresh data")
),
server = function(input, output, session) {
X = testdf
output$datatable = renderDataTable(
{X},selection = list(mode = 'single',target = 'cell')
)
observeEvent(input$CheckFile, {
tryCatch(eval(testdf[nrow(testdf)+1,]<-c(sample(row.names(mtcars),1),sample(1:1000,1),sample(1:10,1),sample(1:10,1),sample(1:10,1))))
#same with evaluate function
#evaluate(testdf[nrow(testdf)+1,]<-c(sample(row.names(mtcars),1),sample(1:1000,1),sample(1:10,1),sample(1:10,1),sample(1:10,1)))
removeModal()
showModal(modalDialog(
title="Refresh done",
footer=NULL,
easyClose=T
))
})
}
)
My app is rendering a table. I want to give the user the possibility to update this dataset with an actionButton(). It then calls an other R file that update this dataset with source(). However, this script may contain some errors and stops before the end. So I chose to handle errors with tryCatch() and eval(). The problem is that these two functions inside my shiny app avoid the update of the dataset.
I made this reproducible example to illustrate the problem.
When I'm only running this line the dataset is updated:
tryCatch(eval(testdf[nrow(testdf)+1,]<-c(sample(row.names(mtcars),1),sample(1:1000,1),sample(1:10,1),sample(1:10,1),sample(1:10,1))))
But in the app, it is not the case.
Any idea?
Thanks in advance.
I am trying to make a Shiny App that retrieves an image from Nasa API and displays it to the user.
Although I manage to download the image from the API and store it in a temp file I can't display it in the shiny app but only locally.
Here is my code so far:
library(shiny)
library(httr)
library(jpeg)
library(RCurl)
library(jsonlite)
library(shinythemes)
#library(imager)
key<-"eH45R9w40U4mHE79ErvPWMtaANJlDwNaEtGx3vLF"
url<-"https://api.nasa.gov/planetary/apod?date="
ui <- fluidPage(theme = shinytheme("yeti"),
# Application title
titlePanel("Nasa API"),
sidebarLayout(
sidebarPanel(
helpText("Wellcome to Nasa search API ",
"enter a date in YYYY-MM-DD to search for picture"),
textInput("date", label="Date input",
value = "Enter date..."),
actionButton("go", "Search")
),
mainPanel(
imageOutput("myImage")
)
)
)
server <- function(input, output,session) {
query<-eventReactive(input$go,{
input$date
})
output$myImage <- renderImage({
nasa_url<-paste0(url,query(),"&api_key=",key)
# A temp file to save the output.
# This file will be removed later by renderImage
response<-getURLContent(nasa_url)
json<-fromJSON(response)
img_url<-json$url
temp<-tempfile(pattern = "file", fileext = ".jpg")
download.file(img_url,temp,mode="wb")
jj <- readJPEG(temp,native=TRUE)
plot(0:1,0:1,type="n",ann=FALSE,axes=FALSE)
rasterImage(jj,0,0,1,1)
#im<-load.image(temp) #use this with library(imager)
#plot(im) #use this with library(imager)
},deleteFile = T)
}
# Run the application
shinyApp(ui = ui, server = server)
Be careful when sharing your code as you just shared your private API key. I suggest you generate a new one.
It does not work because shiny only serves files that are in the ~/www directory. So they should be downloaded to that folder for your method to work.
Perhaps an easier way to go about this is simply to embed the image. Looking at the code it looks like json$url is the URL to the image.
library(shiny)
ui <- fluidPage(
h4("Embedded image"),
uiOutput("img")
)
server <- function(input, output, session) {
output$img <- renderUI({
tags$img(src = "https://www.r-project.org/logo/Rlogo.png")
})
}
shinyApp(ui, server)
You could try the above without hardcoding https://www.r-project.org/logo/Rlogo.png and using your json$url instead.
I have a simple shiny app that I am testing SHINY pro and I would like to access the session$user like the documentation suggests:
http://rstudio.github.io/shiny-server/latest/#flat-file-authentication. See section 4.1 which shows this code:
shinyServer(function(input, output, session) {
output$username <- reactive({
session$user
})
That code works but I need to access session$user in the ui.r file via the GetUser() function
Here is my ui.r File:
library(shiny)
shinyUI(fluidPage(
textOutput("HeaderTime"),
sidebarPanel(
selectInput("t", "t:", as.character(GetUser()), selected = as.character(GetUser())), width = 2
),
mainPanel(
tabsetPanel(
tabPanel("test",
dataTableOutput("Table"),
plotOutput("Plot"),
# verbatimTextOutput("Txt"),
width = 12
)
)
)
))
You can see the GetUser() function in the selectInput. I have placed GetUser() in my server.R file here:
shinyServer(function(input, output, session) {
GetUser<-reactive({
return(session$user)
})
output$Plot<-renderPlot({
hist(rnorm(1000))
})
output$Table<- renderDataTable({
data.frame(a=c(1,2,3,4),b = c("TEst","test","test","test"))
})
})
when I run this code I get the error:
Error in GetUser() : argument "session" is missing, with no default
Any idea how to allow the ui.r to access GetUser() in the server.r file so session$user can be used in the ui?
Here is code to run project:
library(rJava)
library(shiny)
install.packages("shiny")
runApp("C://me/pathtoproject")
Thank you.
The error you get does address the problem (albeit in a cryptic way).
When you call your GetUser function in the ui, the "session" argument is not known (i.e. it is only "known" by the server).
I suggest to use updateSelectInput (or renderUI if you prefer) and send the session$user value from the server side.
Something like (not tested):
server = function(session,input, output) {
GetUser<-reactive({
return(session$user)
})
updateSelectInput(session, "t", "t:", as.character(GetUser()),selected = as.character(GetUser()))