I am making a Shiny app that should have an empty spreadsheet (like excel), where I can paste some data, which can be further processed to get some desired output.
How can I access the data from the spreadsheet for further manipulation in my app?
In the code below, I successfully load an empty spreadsheet that is editable, I can also paste whatever I want into it, but I don't know how to manipulate the data further. I tried to at least load it like a DT table just to see if I managed to convert it to data.frame.
library(shiny)
library(RXSpreadsheet)
ui <- fluidPage(
tabsetPanel(
tabPanel(
"Spreadsheet",
RXSpreadsheet("table"),
RXSpreadsheetOutput("spreadsheet")
),
tabPanel(
"Tabela",
DT::dataTableOutput("dataframe")
)
)
)
server <- function(input, output) {
data <- reactive({
input$table
})
output$spreadsheet <- renderRXSpreadsheet({
data()
})
data_2 <- reactive({
as.data.frame(data())
})
output$dataframe <- DT::renderDT({
data_2()
})
}
shinyApp(ui, server)
I'd like to create several ui which use an input parameter. The problem is that the new UI created are still reacting to the input even when I put an isolate()
The right behaviour would give a custom UI created and isolated from the new inputs coming from the selectInput()
For instance I'd like a first UI with the year 2019 selected and second UI with the year 2020.
Here we can see that adding 2020 will change in each UI which is wrong.
library(shiny)
customplotUI <- function(id){
ns <- NS(id)
fluidPage(
sidebarPanel(id=ns("sidebarpanel"),
actionButton(ns("add"),label = "Add"),
selectInput(inputId=ns("years"),label="Year :", choices = c(2019,2020),selected = 2019, multiple = TRUE)),
mainPanel(div(id=ns("placeholder"))
)
)
}
customplot <- function(input,output,session){
ns <- session$ns
output$res <- renderPrint({
data <- data.frame(year=c(2019,2020),value=c("mtcars2019","mtcars2020"))
data[data$year %in% input$years,]})
ctn <- reactiveVal(0)
Id <- reactive({
function(id){
paste0(id, ctn())
}
})
IdNS <- reactive({
function(id){
ns(paste0(id, ctn()))
}
})
observeEvent(input$add, {
ctn(ctn() + 1)
print(Id()('div'))
insertUI(
selector = paste0('#', ns('placeholder')),
ui = div(
id = Id()('div'),
verbatimTextOutput(IdNS()('chart'))
)
)
id <- Id()('chart')
output[[id]] <- renderPrint({
data <- data.frame(year=c(2019,2020),value=c("mtcars2019","mtcars2020"))
#data[data$year %in% isolate(input$years),]
data[data$year %in% input$years,]
})
})
}
ui <- fluidPage(
customplotUI(id="customplot")
)
server <- function(input, output, session){
callModule(customplot,id="customplot",session=session)
}
shinyApp(ui, server)
Perhaps I'm misunderstanding what you're trying to accomplish, but when I run the code, using the commented line with isolate seems to work as intended.
I'm guessing that in creating the minimal reprex (thank you for doing this btw!), you might have gone a little too minimal and removed another reactive that updates data. If you are trying to have the individual UI elements update based on some other input but keep the same filtering scheme, you need to capture the current value of input$years outside of the renderPrint statement.
Here you can see the subset of rows is unchanged, but the last column updates based on input box:
...
id <- Id()('chart')
targetYears <- input$years
output[[id]] <- renderPrint({
data <- data.frame(year=c(2019,2020),
value=c("mtcars2019","mtcars2020"),
yrInput = paste(input$years, collapse =" "))
data[data$year %in% targetYears, ]
...
isolate only prevents a change in the reactive from triggering an update. If the update is triggered by something else, the current/updated value of the reactive is still used. Through the wonders of R's scoping rules, by capturing the value of input$years in non-reactive variable, targetYears, outside of the renderPrint call and then using that in the renderPrint expression it will always use the the value of the input when output[[id]] was created. The isolate is not needed as you are using observeEvent which will prevent the observer from executing when you change the input.
I have a r leaflet map that has multiple layers and each layer can be checked or unchecked. I am trying to find a way to have a select all/deselect all option.
Below is my code where the overlays are reactive groups.
df() is a reactive dataframe
myLocation() is a reactive location (long,lat)
So in the map in the upper right hand corner is where I want a select all/ deselect all option
groups <- reactive({as.character(unique(df()$Folder))})
groupColors <- reactive({
colorFactor(palette = rainbow(length(groups())),
domain = df()$Folder)
})
output$mymap <- renderLeaflet({
leaflet() %>%
addTiles() %>%
leaflet::addMarkers(lng=c(myLocation()[1]), lat=c(myLocation()[2]),
popup = paste("Lat/Long: ",myLocation()[2],"/",myLocation()[1]),
popupOptions = popupOptions(maxWidth = 1000, closeOnClick = TRUE))
%>%
############more code here
#this section is where a select all/ deselect option has to be placed
addLayersControl(overlayGroups=groups(),options =
layersControlOptions(collapsed = TRUE))
})
Following shiny tutorial... try using leafletProxy to modify your existing map and use the hideGroup() function from leaflet to add/remove the entire group.
I'm trying to use shiny to create a bar graph for a state that is selected via drop-down box. I'm quite new to R and I've tried a variety of examples to no avail. I have three variables (state, claim #, total $) and for each state there are five values. So something like this:
state <- c("PA", "TX", "NY")
claim_num <- c(1:15)
total <- sample(1000:5000, 15)
df <- (state, claim_num, total)
I want to have something similar to https://beta.rstudioconnect.com/jjallaire/shiny-embedding/#inline-app but I don't know if I can format my data in that was since I would have a lot of NAs.
Do you mean something like this (you can download and run the example)?
library(shiny)
ui <- shinyUI(
fluidPage(
titlePanel("Sample Shiny App"),
sidebarLayout(
sidebarPanel(
uiOutput("stateInput")
),
mainPanel(
plotOutput("statePlot")
)
)
))
server <- shinyServer(function(input, output) {
state <- sample(state.abb, 3, replace = FALSE)
total <- sample(1000:5000, 15)
claimNumber <- 1:15
data <- data.frame(state, total, claimNumber)
output$stateInput <- renderUI({
selectInput(
inputId = "state",
label = "Select a State:",
choices = levels(data$state)
)
})
output$statePlot <- renderPlot({
hist(data$total[data$state == input$state])
})
})
shinyApp(ui = ui, server = server)
What we're doing is taking the list of unique states available in our data frame and passing those to our selectInput that renders as a dropdown in the UI. From here, we can access whatever value the user has selected through the input$state object. More generally, we can access inputs based on whatever we define the inputId to be (in this particular case, we call it state).
Having grabbed the user input, we can then subset the data frame to only return values that correspond to the user-defined state and, in this case, pass those totals values to a plot that we render as output.
I'm currently designing a Shiny app that outputs a table. I would like to highlight the cells in a particular column (e.g., make the cells blue). I've tried using the HighlightRows function from the shinyBS package, but that doesn't seem to work.
Here is a portion of my server script making up the table:
output$text1 <- renderTable({
tab1 <- as.data.frame(matrix(c(rrround(input$patha,3),PowerF()$tta,input$nxn,rrround(currentInput()$patha,3),rrround(rxyval()$rxy,3),rrround(rxyval()$rxy_p,3),rround(PowerF()$tra,3),
rrround(input$pathp,3),PowerF()$ttp,input$nxn,rrround(currentInput()$pathp,3),rrround(rxyval()$rxyp,3),rrround(rxyval()$rxyp_p,3),rround(PowerF()$trp,3))
,ncol=7, byrow=TRUE))
rownames(tab1) <- c('Actor', 'Partner')
colnames(tab1) <- c('Size', 'Power', 'N','Beta','r','partial r','ncp')
tab1.align = "r"
highlightRows(session, id='tab1', class = "info", column="Power", regex = ".")
print(tab1, type="html")
})
Any help would be greatly appreciated.
Thanks!
You can modify your datatable using tags$script. below is an example of highlighting 3 columns (1), (5) and (9) of a sample datatable. I had a small problem with a similar issue, you can view that How to change Datatable row background colour based on the condition in a column, Rshiny
rm(list = ls())
library(shiny)
options(digits.secs=3)
test_table <- cbind(rep(as.character(Sys.time()),10),rep('a',10),rep('b',10),rep('b',10),rep('c',10),rep('c',10),rep('d',10),rep('d',10),rep('e',10),rep('e',10))
colnames(test_table) <- c("Time","Test","T3","T4","T5","T6","T7","T8","T9","T10")
ui =navbarPage(inverse=TRUE,title = "Coloring datatables",
tabPanel("Logs",icon = icon("bell"),
mainPanel(htmlOutput("logs"))),
tabPanel("Extra 2",icon = icon("bell")),
tabPanel("Extra 3",icon = icon("bell")),
tags$style(type="text/css", "#logs td:nth-child(1) {text-align:center;background-color:red;color: white;text-align:center}"),
tags$style(type="text/css", "#logs td:nth-child(5) {text-align:center;background-color:blue;color: white;text-align:center}"),
tags$style(type="text/css", "#logs td:nth-child(9) {text-align:center;background-color:green;color: white;text-align:center}")
)
server <- (function(input, output, session) {
my_test_table <- reactive({
other_data <- rbind(c(as.character(Sys.time()),(sample(c("Pass","Aggr","Bad"))[1]),round(c(rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1)),2)),
(c(as.character(Sys.time()),(sample(c("Pass","Aggr","Bad"))[1]),round(c(rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1)),2))))
test_table <<- rbind(apply(other_data, 2, rev),test_table)
as.data.frame(test_table)
})
output$logs <- renderTable({my_test_table()},include.rownames=FALSE)
})
runApp(list(ui = ui, server = server))