I have a shiny application where the filters here are reactive with respect to each other. Not sure there is some issue in the code. The values are not to be seen here. Can anyone help me here?
Is there any alternate way?
library(shiny)
library(readxl)
library(dplyr)
library(shinyWidgets) ## for picker input
library(shinydashboard)
library(DT)
library(tidyverse)
library(xtable)
library(shinycssloaders)
library(plotly)
library(htmlwidgets)
library(sparkline)
library(data.table)
require(reshape2)
library(glue)
data_13_Sam <- data.frame(
Ratings = c(1,2,3,4,5,1,2,3,4,5), flag = c("Yes","No","Yes","No","Yes","No","Yes","No","Yes","Yes")
)
ui <- fluidPage(
column(offset = 0, width = 1,uiOutput("rat")),
column(offset = 0, width = 2, uiOutput("nt"))
)
server <- function(input, output, session) {
filter_data <- reactive({
data_13_Sam %>% filter(flag %in% input$nt, Ratings %in% input$rat)
})
##### nt
output$nt <- renderUI({
selectInput("nt",label = tags$h4("New"),choices = unique(filter_data()$flag))
})
###### rat
output$rat <- renderUI({
selectInput("rat",label = tags$h4("Rat"),choices = unique(filter_data()$Ratings))
})
}
shinyApp(ui, server)
I also tried with this second approach as well . But did not work. Writing to csv file and then pulling from that
library(shiny)
library(readr)
library(dplyr)
data_13_Sam <- data.frame(
Ratings = c(1,2,3,4,5,1,2,3,4,5), flag = c("Yes","No","Yes","No","Yes","No","Yes","No","Yes","Yes"),
fle = c("All","All","All","All","All","All","All","All","All","All")
)
ui <- fluidPage(
column(offset = 0, width = 1,uiOutput("all")),
column(offset = 0, width = 1,uiOutput("rat")),
column(offset = 0, width = 2, uiOutput("nt")),
tableOutput('data')
)
server <- function(input, output, session) {
observeEvent(input$rat,{
grp_by <- data_13_Sam %>% filter(Ratings %in% input$rat) %>% group_by(flag) %>% summarise(Det= n())
write.csv(grp_by,"grp_by.csv")
})
observeEvent(input$nt,{
grp_by_nt <- data_13_Sam %>% filter(flag %in% input$nt) %>% group_by(Ratings) %>% summarise(Det= n())
write.csv(grp_by_nt,"grp_by_nt.csv")
})
output$rat <- renderUI({
if(!is.null(input$nt)){grp_by_nt_read <- read_csv("grp_by_nt.csv")}
selectInput("rat",label = tags$h4("Rat"),choices = unique(grp_by_nt_read$Ratings))
})
output$nt <- renderUI({
if(!is.null(input$rat)){grp_by_read <- read_csv("grp_by.csv")}
selectInput("nt",label = tags$h4("New"),choices = unique(grp_by_read$flag))
})
}
shinyApp(ui, server)
You have created a circular dependency. A needs B, B needs C but C needs A. So it is not able to complete anything.
You can try this -
library(shiny)
data_13_Sam <- data.frame(
Ratings = c(1,2,3,4,5,1,2,3,4,5), flag = c("Yes","No","Yes","No","Yes","No","Yes","No","Yes","No")
)
ui <- fluidPage(
column(offset = 0, width = 1,uiOutput("rat")),
column(offset = 0, width = 2, uiOutput("nt")),
tableOutput('data')
)
server <- function(input, output, session) {
filter_data <- reactive({
data_13_Sam %>% filter(flag %in% input$nt, Ratings %in% input$rat)
})
output$rat <- renderUI({
selectInput("rat",label = tags$h4("Rat"),choices = unique(data_13_Sam$Ratings))
})
output$nt <- renderUI({
req(input$rat)
selectInput("nt",label = tags$h4("New"),choices = unique(data_13_Sam$flag[data_13_Sam$Ratings == input$rat]))
})
output$data <- renderTable({filter_data()})
}
shinyApp(ui, server)
So rat displays all the ratings and only for those ratings we display the nt values. You can also reverse this condition if needed to show all values of nt and based on it's selection show rat values.
Related
In Shiny, rather than manually typing out each slider for filtering a dataframe, which is in reality much larger than this, I use the following code to dynamically produce sliders, each with the appropriate range for its column, through the use of a single functional (lapply):
library(shiny)
library(tidyverse)
dat <- data.frame(a = 0:10, b = 20:30, c = 80:90)
ui <- fluidPage(
titlePanel("Filter DF"),
mainPanel(
tableOutput("df"),
uiOutput("sliders")
)
)
server <- function(input, output) {
tmp_df <- reactive({
dat %>% filter(a > 5) # blah blah
})
output$df <- renderTable({
tmp_df()
})
output$sliders <- renderUI({
t <- tmp_df()
pvars <- names(t)
lapply(pvars, function(nm) {
min <- min(t[[nm]], na.rm = TRUE)
max <- max(t[[nm]], na.rm = TRUE)
sliderInput(inputId = paste0("range_", nm),
label = nm,
min = min,
max = max,
value = c(min, max))
})
})
}
shinyApp(ui = ui, server = server)
But I would also like to dynamically create the code which enables each slider to filter (using dplyr) the dataframe with each slider's current values.
How could I do this?
Thanks #Limey for the head's up.
Solution:
library(shiny)
library(tidyverse)
dat <- data.frame(a = 0:10, b = 20:30, c = 80:90)
nms <- names(dat)
sliderUI <- function(id) {
ns <- NS(id)
min <- min(dat[[id]], na.rm = TRUE)
max <- max(dat[[id]], na.rm = TRUE)
sliderInput(inputId = ns('slider'),
label = id,
min = min,
max = max,
value = c(min, max))
}
sliderServer <- function(df, id) {
moduleServer(
id,
function(input, output, session) {
id <- as.name(id)
df %>% filter(dplyr::between(!!id, input$slider[1], input$slider[2]))
}
)
}
ui <- fluidPage(
map(nms, sliderUI),
tableOutput("df")
)
server <- function(input, output, session) {
tmp_df <- reactive({ dat })
output$df <- renderTable({
purrr::reduce(nms, sliderServer, .init = tmp_df())
})
}
shinyApp(ui, server)
I have the shiny app below in which I want to pan and zoom the .svg.
library(shiny)
library(DiagrammeR)
library(tidyverse)
# probably don't need all of these:
library(DiagrammeRsvg)
library(svglite)
library(svgPanZoom)
library(rsvg)
library(V8)# only for svg export but also does not work
library(xml2)
ui <- fluidPage(
grVizOutput("grr",width = "100%",height = "90vh")
)
server <- function(input, output) {
reactives <- reactiveValues()
observe({
reactives$graph <- render_graph(create_graph() %>%
add_n_nodes(n = 2) %>%
add_edge(
from = 1,
to = 2,
edge_data = edge_data(
value = 4.3)))
})
output$grr <-
renderGrViz(reactives$graph
)
}
# Run the application
shinyApp(ui = ui, server = server)
I tried with the svgPanZoom package but could make it work. How does this work? Or an alternative option?
ui <- fluidPage(
svgPanZoomOutput("grr")
)
server <- function(input, output) {
reactives <- reactiveValues()
observe({
reactives$graph <- render_graph(create_graph() %>%
add_n_nodes(n = 2) %>%
add_edge(
from = 1,
to = 2,
edge_data = edge_data(
value = 4.3)))
})
output$grr <-
renderSvgPanZoom({
svgPanZoom(reactives$graph)
})
}
# Run the application
shinyApp(ui = ui, server = server)
You can use the panzoom JavaScript library.
library(shiny)
library(DiagrammeR)
library(magrittr)
ui <- fluidPage(
tags$head(
tags$script(src = "https://unpkg.com/panzoom#9.4.0/dist/panzoom.min.js")
),
grVizOutput("grr", width = "100%", height = "90vh"),
tags$script(
HTML('panzoom($("#grr")[0])')
)
)
server <- function(input, output) {
reactives <- reactiveValues()
observe({
reactives$graph <- render_graph(create_graph() %>%
add_n_nodes(n = 2) %>%
add_edge(
from = 1,
to = 2,
edge_data = edge_data(
value = 4.3)))
})
output$grr <- renderGrViz(reactives$graph)
}
shinyApp(ui, server)
I have a application that has a reative table(based on 2 selectInputs) and a graph. The data for graph is taken from reactive table.
So both graph and table is using the same data. So while constructing a graph, can I observe what the table is having.
Or should I read the same table again in the graph?
I mean should we call head(iris,n = as.numeric(input$rows)) again twice below?
Example,
library(shiny)
library(DT)
library(rAmCharts)
ui <- fluidPage(
selectInput("rows","Rows",c(1:150)),
dataTableOutput("input_table"),
amChartsOutput("barplot",width = 750, height = 500)
)
server <- function(input, output, session) {
output$input_table <- renderDataTable({
new_iris <- head(iris,n = as.numeric(input$rows))
datatable(new_iris)
})
output$barplot <- renderAmCharts({
new_iris1 <- head(iris,n = as.numeric(input$rows)) ## should i call this again???????? Cannot we use from rendertable?
new_iris1 <- new_iris1 %>% group_by(Species) %>% summarise(total = sum(Petal.Length))
pipeR::pipeline(
amBarplot(
x = "Species",
y = "total",
ylab = "X",
xlab = "Y",
data = new_iris1,
labelRotation = 90
),
setChartCursor()
)
})
}
shinyApp(ui, server)
You may want to put your data object in a reactive expression so you can see what is being rendered, like so, this way you can access data() later on in your app
library(shiny)
library(DT)
library(dplyr)
library(rAmCharts)
ui <- fluidPage(
selectInput("rows","Rows",c(1:150)),
dataTableOutput("input_table"),
amChartsOutput("barplot",width = 750, height = 500)
)
server <- function(input, output, session) {
data <- eventReactive(input$rows,{
head(iris,n = as.numeric(input$rows))
})
output$input_table <- renderDataTable({
datatable(data())
})
output$barplot <- renderAmCharts({
new_iris1 <- data()
new_iris1 <- new_iris1 %>% group_by(Species) %>% summarise(total = sum(Petal.Length))
pipeR::pipeline(
amBarplot(
x = "Species",
y = "total",
ylab = "X",
xlab = "Y",
data = new_iris1,
labelRotation = 90
),
setChartCursor()
)
})
}
shinyApp(ui, server)
I have put together a Shiny app that reactively creates lists while simultaneously removing those selections from the list you're selecting from. I'm trying to put together a feature where you click a reset button and it does the following:
1.) Deselects all input options
2.) Sets the Age Range to 18 - 104 (so it captures all values)
3.) Moves the other two sliders to zero
I'm trying to use the shinyjs::reset function, but it doesn't appear to be working. Take a look:
df <- read.csv('https://raw.githubusercontent.com/gooponyagrinch/sample_data/master/datasheet.csv')
library(shiny)
library(shinyWidgets)
library(shinyjs)
library(tidyverse)
library(DT)
ui <- fluidPage(
div(id = "myapp",
fluidRow(
column("",
width = 10, offset = 1,
tags$h3("Select Area"),
panel(
sliderInput("current", "Current Score",
min = 0, max = 100, value = 20),
sliderInput("projected", "Projected Score",
min = 0, max = 100, value = 20),
sliderInput("age", "Age",
min = 18, max = max(df$age), value = c(18,24)),
checkboxGroupInput("ethnicity",label = "Ethnicity",
choices = list("Caucasian"="Caucasian",
"African-American"="African-American",
"Hispanic"="Hispanic",
"Other"="Other")),
checkboxInput('previous', label = "Previous Sale"),
checkboxInput('warm', label = "Warm Lead"),
actionButton("button", "Add to List"),
actionButton("reset", "Reset form")),
textOutput("counter"),
tags$h2("Data to filter"),
DT::dataTableOutput("table"),
tags$h2("IDs added to list"),
DT::dataTableOutput("addedToList")
)
)
)
)
server <- function(input, output, session) {
filterData = reactiveVal(df %>% mutate(key = 1:nrow(df)))
addedToList = reactiveVal(data.frame())
filtered_df <- reactive({
res <- filterData() %>% filter(current_grade >= input$current)
res <- res %>% filter(projected_grade >= input$projected)
res <- res %>% filter(age >= input$age[1] & age <= input$age[2])
res <- res %>% filter(ethnicity %in% input$ethnicity | is.null(input$ethnicity))
if(input$previous == TRUE)
res <- res %>% filter(previous_sale == 1)
if(input$warm == TRUE)
res <- res %>% filter(warm_lead == 1)
res
})
output$counter <- renderText({
res <- filtered_df() %>% select(customer_id) %>% n_distinct()
res
})
output$table <- renderDataTable({
res <- filtered_df() %>% distinct(customer_id)
res
})
observeEvent(input$button, {
addedToList(rbind(addedToList(),
filterData() %>% filter(key %in% filtered_df()$key) %>%
select(customer_id) %>% distinct() ))
filterData(filterData() %>% filter(!key %in% filtered_df()$key))
})
observeEvent(input$reset, {
shinyjs::reset("myapp")
})
output$addedToList <- renderDataTable({
addedToList()
})
}
shinyApp(ui,server)
Am I missing something?
All you need to do is ensure that your application is listening for a call to "ShinyJS" in your application. In the UI, add the useShinyJS() call!
ui <- fluidPage(
useShinyJS()
div(id = "myapp",
fluidRow(...)
)
I also should note this looks like a repeat of this question. 'Reset inputs' button in shiny app
Thanks to this solution I finally figured out how create dynamic SliderInput button. Unfortunately I have a problem with use this input value after all ( to change subset condition in dplyr). Could anyone tell me what I do wrong?
ui.R
library(dplyr)
library(shiny)
library(ggvis)
shinyUI(fluidPage(
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
radioButtons("dataset", label = h4("Product level"),
choices = list("Item" = "df1", "Task" = "df2")),
uiOutput("slider")
),
mainPanel(
ggvisOutput("plot")
)
)
))
server.R
library(shiny)
library(dplyr)
df1 <- data.frame(id = c(1,2,3,4,5), number = c(20,30,23,25,34))
df2 <- data.frame(id = c(1,2), number = c(33,40))
shinyServer(function(input, output) {
datasetInput <- reactive({
switch(input$dataset,
df1 = df1,
df2 = df2)
})
output$slider <- renderUI({
sliderInput("inslider","Slider", min = min(datasetInput()$number),
max = max(datasetInput()$number),
value = c(min(datasetInput()$number),
max(datasetInput()$number))
})
data <- reactive({
datasetInput %>%
filter(number >= input$inslider[1],
number <= input$inslider[2])
})
vis <- reactive({
data %>%
ggvis(~id, ~number) %>%
layer_points(fill = ~factor(id)) %>%
scale_nominal("fill", range = c("red","blue","green","yellow","black"))
})
vis %>% bind_shiny("plot")
})
Since you are using renderUI to make the slider, you have to check that input$inslider exists before filtering the data. When you load it for the first time, it doesn't because it is created by the renderUI
Try this for your server.R:
library(shiny)
library(dplyr)
df1 <- data.frame(id = c(1,2,3,4,5), number = c(20,30,23,25,34))
df2 <- data.frame(id = c(1,2), number = c(33,40))
shinyServer(function(input, output) {
datasetInput <- reactive({
switch(input$dataset,
"df1" = df1,
"df2" = df2)
})
output$slider <- renderUI({
sliderInput("inslider","Slider", min = min(datasetInput()$number),
max = max(datasetInput()$number),
value = c(min(datasetInput()$number),
max(datasetInput()$number))
)})
data <- reactive({
filteredData<-datasetInput()
if(!is.null(input$inslider)){
filteredData<-filteredData %>%
filter(number >= input$inslider[1] ,
number <= input$inslider[2] )
}
filteredData
})
vis <- reactive({
data()%>%
ggvis(~id, ~number) %>%
layer_points(fill = ~factor(id)) %>%
scale_nominal("fill", range = c("red","blue","green","yellow","black"))
})
vis %>% bind_shiny("plot")
})