Outputing N tables in shiny, where N depends on the data
I started from the comment with link Dieter made to my question (R Shiny - add tabPanel to tabsetPanel dynamically (with the use of renderUI)). The principle is the same - generate HTML with all the tables in Server.R and then display it with uiOutput() in Ui.R. The difference is, that I could not find a function in shiny package, that would be analogous to the tabPanel(), that generates the HTML in the given example.
But I was able to use xtable() to generate the HTML and passed it some extra arguments for the tables to look like expected in shiny framework when rendered.
Example of a function, that generates HTML for an arbitrary number of tables:
tabelize <- function(variables, arg2, ...) {
tables <- list() # create a list to hold all tables
for (variable in variables) { # go through all possible values of variables
table <- function_that_returns_a_data_frame(variable, arg2, ...)
tables[[as.character(variable)]] <-
# save table into slot in created list
# print table as HTML with additional formatting options
print(xtable(table, caption=paste("Variable:", variable)),
type="html",
html.table.attributes='class="data table table-bordered table-condensed"',
caption.placement="top")
}
return(lapply(tables, paste)) # return HTML tables pasted together
}
Call this function in Server.R (with some additional options) and assign to an output$ slot:
output$tables <- renderUI({
out <- tabelize(variables, arg2, ...)
# additional options to make rendering possible
return(div(HTML(out),class="shiny-html-output"))
})
Do an uiOutput() of it in Ui.R:
... code
uiOutput("tables")
... code
If there's a better way, please comment.
r Shiny action button and data table output last N rows
@Tomáš - I would recommend avoiding putting your output statements inside of observeEvent. Instead, I would create an eventReactive that will be triggered by your action button. And when this happens, it will store all your needed info in a list, and all of your outputs will be dependent on this list. Here is one way to do this (below is the server function only).
server <- function(input, output) {
aq_data <- eventReactive(input$gobutton, {
list(data = airquality, nID = input$numericID, rID = input$radioID, sID = input$selectID, tID = input$textID)
})
output$textik <- renderText({
vypis=c("Zobrazili ste tabuľku s", aq_data()[["nID"]], "riadkami a boxplot pre atribút Ozone ste nastavili na farbu ", aq_data()[["rID"]])
print(vypis)
})
output$table <- renderTable(tail(aq_data()[["data"]], aq_data()[["nID"]]))
output$distPlot <- renderPlot({
dat <- aq_data()
boxplot(reformulate("Month", dat[["sID"]]), col = dat[["rID"]], border = 'white', main = dat[["tID"]], data = dat[["data"]])
})
}
Shiny: Dynamic Number of Output Elements/Plots
Inspired from this, you could do:
ui.R
shinyUI(pageWithSidebar(
headerPanel("Dynamic number of plots"),
sidebarPanel(
selectInput(inputId = "choosevar",
label = "Choose Cut Variable:",
choices = c("Nr. of Gears"="gear", "Nr. of Carburators"="carb"))
),
mainPanel(
# This is the dynamic UI for the plots
uiOutput("plots")
)
))
server.R
library(googleVis)
shinyServer(function(input, output) {
#dynamically create the right number of htmlOutput
output$plots <- renderUI({
plot_output_list <- lapply(unique(mtcars[,input$choosevar]), function(i) {
plotname <- paste0("plot", i)
htmlOutput(plotname)
})
tagList(plot_output_list)
})
# Call renderPlot for each one. Plots are only actually generated when they
# are visible on the web page.
for (i in 1:max(unique(mtcars[,"gear"]),unique(mtcars[,"carb"]))) {
local({
my_i <- i
plotname <- paste0("plot", my_i)
output[[plotname]] <- renderGvis({
data <- mtcars[mtcars[,input$choosevar]==my_i,]
if(dim(data)[1]>0){
gvisColumnChart(
data, xvar='hp', yvar='mpg'
)}
else NULL
})
})
}
})
It basically creates htmlOutput plots dynamically and binds the googleVis plots when there is data in the subset.
How to display data in shiny which has been splitted into different parts?
You can look into uiOutput and renderUI. These allow you to pass dynamic render objects or lists of objects. You'd have uiOutput("someName") in your ui, and then a output$someName <- renderUI(...) in your server.
In the renderUI, you perform the split. You then put each of the result into a renderTable, then return the list of renderTable objects.
Some additional reading on things like this:
Unknown number of tables to be presented in Shiny
Output N tables in Shiny
Dynamic Number of Output Elements
Shiny Example with Dynamic Number of Plots
Edit:
Your ui is fine, you can use this as your server:
output$data <- renderUI({
splitDFs<- split(iris, iris$Species)
splitRenders <- lapply(1:length(splitDFs), function(x) renderTable(splitDFs[[x]]))
return(splitRenders)
})
The problem with the previous version was that lapply renderTable for some reason was not directly getting at the elements of splitDFs*, it was just picking up the last one each time. This explicitly extracts the individual split dataframes and properly builds the render, so it should work now.
- This is strange because lapply works properly in other scenarios, e.g. when the function is print. It might be something like ggplot, where the dataframe is passed in but not evaluated till the end, so the renderTable gets overwritten with the latest one.
Dynamically Creating Images And Tables From User Input In R Shiny
I would approach this by wrapping essentially all of what you're doing in an observeEvent function. I don't think reactive are the natural way to try to get your functions to run since they're more about returning an R object output that runs when required.
Something like:
observeEvent(input$dis,
{
Snapshot <- CreateSnapshot(input$dis)
VisualizationTable <- ProduceTable(input$dis)
fileData <- your read function of choice since it no longer needs to be reactive
output$fileData <- renderTable({
fileData
})
etc..
}
)
So every time the user chooses a discipline the entire thing will run, generating the outputs you want.
If there's no reason you want to produce a csv you could streamline this more by not saving the csv since you save it only to read the file to load it.
Shiny not outputing when using showOutput and multiple charts
I think you are using some dated functions. Both leaflet and d3heatmap have their own rendering/output functions based on htmltools. Change your UI to
bootstrapPage(mainPanel(width = 12,
div(class = "row",
div(d3heatmapOutput("heatmap"), class = "span6"),
div(leafletOutput("geomap"), class = "span6")
)
))
I would also take the data processing outside of the the reactives since it doesn't change, either putting it in your server or in the global.R that gets read at startup.
With these minor mods, your server could be
library(dplyr)
library(d3heatmap)
library(RColorBrewer)
library(shiny)
library(leaflet)
library(rCharts)
cases <- read.csv("casos_2015.csv") %>%
select(-Total) %>%
select(-Semana)
## I would add the labels here as well unless those are subject to change
data <- read.csv("cantones.csv")
function(input, output, session) {
output$heatmap <- renderD3heatmap({
d3heatmap(cases, scale = "row",
dendrogram = "none",
color = scales::col_quantile("Reds", NULL, 10),
xaxis_font_size = "10px",
show_grid = 0.2)
})
output$geomap <- renderLeaflet({
casos_popup <- paste0("<strong>Canton: </strong>", data$canton,
"<br><strong>Cases: </strong>", data$casos,
"<br><strong>Rate: </strong>", signif(data$tasa, 3))
m <- leaflet(data) %>%
addProviderTiles("CartoDB.Positron") %>%
addCircles(~lng,
~lat,
popup = casos_popup,
radius = ~sqrt(casos) * 300,
weight = 1,
color = "red")
m
})
}
Shiny: Reactive Value to DT:datatable
Here's how I solved it! Note: There are several v$data.. which I would like to use in order, depending on what my user has already done.
#Count the number of recoding terms to render
counter <- reactiveValues(n = 0)
#Recoding button functionality
observeEvent(input$add_recode, {counter$n <- counter$n + 1})
observeEvent(input$rm_recode, {
if(counter$n > 0) counter$n <- counter$n - 1
})
recoding_i <- reactive({
n <- counter$n
if(n>0){
isolate({
lapply(seq_len(n),function(i){
fluidRow(
column(width=4,
textInput(inputId=paste0('recode_name',i),
label=paste0("Variable Name",i))),
column(width=4,
textInput(inputId = paste0('recode_call',i),
label=paste0('Code',i)))
)
}
)
})
}
})
output$recoding <- renderUI({ recoding_i() })
#Observes press of recode button.
observeEvent(input$'execute_recode',{
v[["print_execute_complete"]] <- TRUE
})
#Observes press of recode button.
observeEvent(input$'reset_recode',{
v[["print_execute_complete"]] <- FALSE
})
#Loop over recoding input boxes.
observeEvent(v$print_execute_complete, {
if(v[["print_execute_complete"]] == TRUE){
n <- counter$n
if(n==0){
if(is.null(v$datafiltered)){
v$datarecoded <- myData()
} else {
v$datarecoded <- v$datafiltered
}
} else {
if(is.null(v$datafiltered)){
v$datarecoded <- myData()
} else {
v$datarecoded <- v$datafiltered
lapply(seq_len(n), function(i){
recode_call_i <- rlang::parse_expr(rlang::eval_tidy(rlang::parse_expr(eval(paste0("input$recode_call",i)))))
var_name_i <- rlang::sym(rlang::eval_tidy(rlang::parse_expr(paste0("input$recode_name",i))))
v$datarecoded <- mutate(v$datarecoded,!!var_name_i := !!recode_call_i)
}
)
}
}
}
}
)
#Confirmation text
output$execute_complete <- renderText({
req(v[["print_execute_complete"]])
if(v[["print_execute_complete"]] == TRUE){
"Recoding Complete."
}
})
#Render recoded data table
output$recoded_dt <- DT::renderDataTable({
req(v[["print_execute_complete"]] == TRUE)
if(!is.null(v[["datarecoded"]])){
return(DT::datatable(v[["datarecoded"]], filter='top'))
} else if(v[["print_filter_complete"]] == TRUE & !is.null(v[["datafiltered"]])) {
return(DT::datatable(v[["datafiltered"]], filter='top'))
} else {
DT::datatable(myData(),filter='top')
}
})
How do I display text output in Shiny depending on the result of a caluclation?
Your second attempt is not working because variable 'x' is not global, it's defined under output$results and you can't access it in output$text2. I cannot run your whole code since you didn't provide the necessary data but I guess this would do the job for you:
# in the ui change your tableOutput() to textOutput() for 'results':
h3(textOutput("results"))
# in the server change your output$results to this:
output$results <- renderText({
x <- cramerV(cramerdata())
print(paste("The results equal:", x, ifelse(x > 0.5, "There is a strong association between the selected variables",
ifelse(x > 0.3 && x <= 0.5, "There is a medium association between the selected variables",
ifelse(x > 0.1 && x <= 0.3, "There is a weak association between the selected variables", "There is a very weak association between the selected variables")))))
})
P.S. You had already put cramerV(cramerdata()) in the results() reactive element, so why are you rewriting that in the output$results.
P.S.S: try not to use the same name for variables and functions (like results here both as reactive element and output)
Related Topics
Bold Formatting for Significant Values in a Rmarkdown Table
R - Set Execution Time Limit in Loop
Chloropleth Map with Geojson and Ggplot2
Gradient Breaks in a Ggplot Stat_Bin2D Plot
Adding Shade to R Lineplot Denotes Standard Error
How to Create a Pie Chart with Percentage Labels Using Ggplot2
Inserting a Table Under the Legend in a Ggplot2 and Saving Everything to a File
How to Read a Subset of Large Dataset in R
Transfer Data from Database to Spark Using Sparklyr
Math of Tm::Findassocs How Does This Function Work
Remove Multiple Patterns from Text Vector R
Mathematical Expression in Axis Label
Stacking an Existing Rasterstack Multiple Times
Memory Limits in Data Table: Negative Length Vectors Are Not Allowed