\
I'm a really beginner in R Shiny.
I have a similar problem as at the link below.
multiple group_by in shiny app
Instead of making a table which worked out/I managed by following the instructions in the link above.
I would like to make a plot, preferably with hchart. In which i would to switch the information because of the group by. The difficult part / or the thing that doesn't work is putting the group_by on the x-axis.
## hier de tabel versie
df2 <- readRDS("Data.rds")
library(shiny)
library(DT)
library(dplyr)
ui <- fluidPage(
titlePanel("Dashboard"),
sidebarLayout(
sidebarPanel(
uiOutput("groups")
),
mainPanel(
DT::dataTableOutput("summary")
)
)
)
server <- function(input, output) {
mydata <- reactive({
data <- df2
data
})
output$groups <- renderUI({
df <- mydata()
selectInput(inputId = "grouper", label = "Group variable", choices = c("L","Lt","Lp"), selected = "L")
})
summary_data <- reactive({
req(input$grouper)
mydata() %>%
dplyr::group_by(!!!rlang::syms(input$grouper)) %>%
dplyr::summarise(aantal = n()) %>%
dplyr::arrange(desc(aantal))
})
output$summary <- DT::renderDataTable({
DT::datatable(summary_data())
})
}
shinyApp(ui, server)
The above code works, but i tried to make a plot like this:
df2 <- readRDS("Data.rds")
library(shiny)
library(highcharter)
library(dplyr)
ui <- fluidPage(
titlePanel("Dashboard"),
sidebarLayout(
sidebarPanel(
uiOutput("groups")
),
mainPanel(
highchartOutput("plotje")
)
)
)
server <- function(input, output) {
mydata <- reactive({
data <- df2
data
})
output$groups <- renderUI({
df <- mydata()
selectInput(inputId = "grouper", label = "Group variable", choices = c("L","Lt","Lp"), selected = "L")
})
summary_data <- reactive({
req(input$grouper)
mydata() %>%
dplyr::group_by(!!!rlang::syms(input$grouper)) %>%
dplyr::summarise(aantal = n()) %>%
dplyr::arrange(desc(aantal))
})
output$plotje <- renderHighchart({
data <- summary_data()
hchart(data, "column", hcaes(x = "grouper" , y = aantal)) # --> de plot zelf komt in het output deel van de UI
})
}
shinyApp(ui, server)
Could someone help me out?!
Thanks in advance!
Kind regards,
Steffie
You have the grouper column in the input$grouper var.
It's just a matter of unquoting it.
The line hchart(data, "column", hcaes(x = "grouper" , y = aantal)) should be:
hchart(data, "column", hcaes(x = !!input$grouper , y = aantal))
Full example (with iris data as you didn't provide an example of your own data):
library(shiny)
library(DT)
library(highcharter)
library(dplyr)
ui <- fluidPage(titlePanel("Dashboard"),
sidebarLayout(
sidebarPanel(uiOutput("groups")),
mainPanel(DT::dataTableOutput("summary"),
highchartOutput("plot"))
))
server <- function(input, output) {
mydata <- reactive({
iris
})
output$groups <- renderUI({
df <- mydata()
selectInput(
inputId = "grouper",
label = "Group variable",
choices = c("Petal.Length", "Species"),
selected = "Species"
)
})
summary_data <- reactive({
req(input$grouper)
mydata() %>%
dplyr::group_by(!!!rlang::syms(input$grouper)) %>%
dplyr::summarise(aantal = n()) %>%
dplyr::arrange(desc(aantal))
})
output$summary <- DT::renderDataTable({
DT::datatable(summary_data())
})
output$plot <- renderHighchart({
req(input$grouper)
data <- summary_data()
hchart(data, "column", hcaes(x = !!input$grouper, y = aantal))
})
}
shinyApp(ui, server)
Related
I am trying to show the top ten highest temps from each year but the way I coded it, it will not change and just stays the same.
server.R
library(shiny)
library(dplyr)
library(ggplot2)
library(plotly)
library(readr)
library(tidyverse)
temp_df <-read_csv("~/Environment_Temperature_change_E_All_Data_NOFLAG.csv")
year_df <- temp_df[,8:66] #for the widget
info_df <- temp_df %>%
select(Area, Months, Element)
combine_df <- mutate(info_df, year_df)
combine_df <- na.omit(temp_df) # Get rid of NA rows
combine_df <- temp_df[!grepl("Standard Deviation",temp_df$Element), ] # Get rid of SD rows
top_ten_df <-top_n(combine_df, 10)
# Define server
server <-shinyServer(function(input, output) {
observe({
output$selected_var <- renderText({
paste("You have selected", input$year)
})
output$scatter <- renderPlot({
ggplot(data = top_ten_df, aes(x= Months, y = `Area`)) +
geom_point(aes(col=`Area`))
})
output$data <- renderTable({
final_df <-top_ten_df%>%
select(Area, Months, Element, input$year)
brushedPoints(final_df, input$plot_brush)
})
output$plotlyscatter <- renderPlotly({
plot_ly(data = top_ten_df, x = ~Area, y = ~Months, color=~Area, type = "scatter")
})
})
})
ui.R
library(shiny)
library(dplyr)
library(ggplot2)
library(plotly)
library(readr)
library(tidyverse)
temp_df <-read_csv("~/Environment_Temperature_change_E_All_Data_NOFLAG.csv")
year_df <- temp_df[,8:66] #for the widget
info_df <- temp_df %>%
select(Area, Months, Element)
combine_df <- mutate(info_df, year_df)
# Define UI
ui <- shinyUI(navbarPage(inverse = T, "Rising Temperatures",
tabPanel( "Top Ten Highest Tempratures",
sidebarLayout(
sidebarPanel(
h5("Selection"),
selectInput(inputId = "year",
label = "Select the year:",
choices = names(year_df),
),
textOutput("selected_var"),
),
mainPanel(
plotOutput(outputId = "scatter", brush = "plot_brush"),
tableOutput(outputId = "data"),
plotlyOutput(outputId = "plotlyscatter")
)
)
)
)
)
Also, I do not know where to use the app.R in this situation, sorry I am a bit new to all of this. I would like this to be an interactive scatter plot that when you pick an input from the widget.
I keep getting errors like Error in : object of type 'closure' is not subsettable or
'..1'. x Input '..1' must be of size 28 or 1, not size 0. I am trying to change the bar graph based on what options are selected or not in the checkbox.
I changed the column names for ease of use from where I got the data.
library(shiny)
library(dplyr)
library(plotly)
#dataset link: https://www.kaggle.com/mahirahmzh/starbucks-customer-retention-malaysia-survey?select=Starbucks+satisfactory+survey.csv
#c("Timestamp","Gender","age","currently","income","visit_freq","Enjoy","Time","Nearby","membership","freq_purchase","avg_spend","Ratevsother","rateprice","salesandpromotion","ambiance","wifi","service","meetup","heardaboutpromotions","continuepatronage")
data <-read.csv("Starbucks satisfactory survey.csv", header=TRUE)
Categorical.Variables <- c("visit_freq", "age", "income")
ui <- fluidPage(
sidebarPanel(
selectInput('category', choices = Categorical.Variables, label = 'Select filter options:'),
conditionalPanel(condition = "input.category != '-'",
uiOutput("select_category"))
)
)
server <- function(input, output) {
output$select_category <- renderUI({
choices <- as.list(unique(data[[input$category]]))
checkboxGroupInput('categorycheck', label = 'Select filter:',
choices = choices,selected = choices)
data2 <- reactive({
data %>%
group_by(gender,data[[input$category]], currently,membership) %>%
summarize(n = n(), .groups="drop") %>%
filter(data[[input$category]] %in% input$categorycheck) %>%
filter(membership == "Yes")})
renderPlotly({
data2 <- data2()
colnames(data2) <- c("gender","filtercategory","currently","membership","n")
plot_ly(data2, x = ~currently, y = ~n, type = "bar", color=~gender, colors="Dark2") %>%
layout(barmode = 'group')
})
})
}
shinyApp(ui, server)
You have several issues. You should close your renderUI prior to using input$categorycheck in the reactive object data2. In addition, columns names in the csv file are long. Once you define the column names of data the way you are analyzing, it will work. Try this
mydata <-read.csv("Starbucks satisfactory survey.csv", header=TRUE)
names(mydata)[1:10] <- c("Timestamp", "gender", "Age", "currently", "Income", "visit_freq","drink_freq","time_spent", "nearby","membership")
Categorical.Variables <- c("Age", "Income", "visit_freq")
ui <- fluidPage(
sidebarPanel(
selectInput('category', choices = Categorical.Variables, label = 'Select filter options:'),
#conditionalPanel(condition = "input.category != '-'",
uiOutput("select_category")
# )
),
mainPanel(plotlyOutput("myplot"),
DTOutput("t1")
)
)
server <- function(input, output) {
output$select_category <- renderUI({
req(input$category)
choices <- as.list(unique(mydata[[input$category]]))
checkboxGroupInput('categorycheck', label = 'Select filter:',
choices = choices,selected = choices)
})
data2 <- reactive({
req(input$category,input$categorycheck)
mydata %>%
group_by(gender,.data[[input$category]], currently,membership) %>%
dplyr::summarize(n = n(), .groups="drop") %>%
filter(.data[[input$category]] %in% input$categorycheck) %>%
filter(membership == "Yes")})
output$t1 <- renderDT(data2())
output$myplot <- renderPlotly({
req(data2())
data2 <- data2()
colnames(data2) <- c("gender","filtercategory","currently","membership","n")
plot_ly(data2, x = ~currently, y = ~n, type = "bar", color=~gender, colors="Dark2") %>%
layout(barmode = 'group')
})
}
shinyApp(ui, server)
I am trying to create a shiny app where depending on the dataset, ggvis will create a scatter plot. The app works fine at the beginning. But if I try to change the dataset to mtcars, shiny just disappears.
My ui.R -
library(ggvis)
library(shiny)
th.dat <<- rock
shinyUI(fluidPage(
titlePanel("Reactivity"),
sidebarLayout(
sidebarPanel(
selectInput("dataset", "Choose a dataset:",
choices = c("rock", "mtcars")),
selectInput("xvar", "Choose x", choices = names(th.dat), selected = names(th.dat)[1]),
selectInput("yvar", "Choose y", choices = names(th.dat), selected = names(th.dat)[2]),
selectInput("idvar", "Choose id", choices = names(th.dat), selected = names(th.dat)[3])
),
mainPanel(
ggvisOutput("yup")
)
)
))
server.R -
library(ggvis)
library(shiny)
library(datasets)
shinyServer(function(input, output, session) {
datasetInput <- reactive({
switch(input$dataset,
"rock" = rock,
"mtcars" = mtcars)
})
obs <- observe({
input$dataset
th.dat <<- datasetInput()
s_options <- list()
s_options <- colnames(th.dat)
updateSelectInput(session, "xvar",
choices = s_options,
selected = s_options[[1]]
)
updateSelectInput(session, "yvar",
choices = s_options,
selected = s_options[[2]]
)
updateSelectInput(session, "idvar",
choices = s_options,
selected = s_options[[3]]
)
})
xvarInput <- reactive({
input$dataset
input$xvar
print("inside x reactive," )
print(input$xvar)
xvar <- input$xvar
})
yvarInput <- reactive({
input$dataset
input$yvar
print("inside y reactive,")
print(input$yvar)
yvar <- input$yvar
})
dat <- reactive({
dset <- datasetInput()
xvar <- xvarInput()
# print(xvar)
yvar <- yvarInput()
# print(yvar)
x <- dset[, xvar]
y <- dset[,yvar]
df <- data.frame(x = x, y = y)
})
dat %>%
ggvis(~x, ~y) %>%
layer_points() %>%
bind_shiny("yup")
})
I have tried many ways, but still stuck. Any help will be greatly appreciated.
I left some pointers in the comments but it seems that ggvis evaluates everything quite early so there is a need for some test cases.
rm(list = ls())
library(shiny)
library(ggvis)
ui <- fluidPage(
titlePanel("Reactivity"),
sidebarPanel(
selectInput("dataset", "Choose a dataset:", choices = c("rock", "mtcars")),
uiOutput("xvar2"),uiOutput("yvar2"),uiOutput("idvar2")),
mainPanel(ggvisOutput("yup"))
)
server <- (function(input, output, session) {
dataSource <- reactive({switch(input$dataset,"rock" = rock,"mtcars" = mtcars)})
# Dynamically create the selectInput
output$xvar2 <- renderUI({selectInput("xvar", "Choose x",choices = names(dataSource()), selected = names(dataSource())[1])})
output$yvar2 <- renderUI({selectInput("yvar", "Choose y",choices = names(dataSource()), selected = names(dataSource())[2])})
output$idvar2 <- renderUI({selectInput("idvar", "Choose id",choices = names(dataSource()), selected = names(dataSource())[3])})
my_subset_data <- reactive({
# Here check if the column names correspond to the dataset
if(any(input$xvar %in% names(dataSource())) & any(input$yvar %in% names(dataSource())))
{
df <- subset(dataSource(), select = c(input$xvar, input$yvar))
names(df) <- c("x","y")
return(df)
}
})
observe({
test <- my_subset_data()
# Test for null as ggvis will evaluate this way earlier when the my_subset_data is NULL
if(!is.null(test)){
test %>% ggvis(~x, ~y) %>% layer_points() %>% bind_shiny("yup")
}
})
})
shinyApp(ui = ui, server = server)
Output 1 for rocks
Output 2 for mtcars
I have one problem with create dynamic UI (selectInput). I mean, I have two dataframes and one selectInput button which should change number of output (column name) depending on dataframe which I choose.
I just get error: Error: == only defined for equally-sized data frames when I choose df2 dataframe. Could anyone tell me what I do wrong? This is my if function:
output$xvars <- renderUI({
if (datasetInput() == df1){
axis_vars_x <- colnames(df1[c(1,2)])
selectInput("xvar", "X-axis variable", axis_vars_x, selected = "id")
}
else{
axis_vars_x <- colnames(df2[1])
selectInput("xvar", "X-axis variable", axis_vars_x, selected = "id")
}
})
ui.R
library(dplyr)
library(shiny)
library(ggvis)
shinyUI(fluidPage(
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
radioButtons("dataset", label = h4("Product level"),
choices = list("Item" = "df1", "Task" = "df2")),
uiOutput("xvars"),
),
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), ds = c(1,2,3,42,2))
df2 <- data.frame(id = c(1,2), number = c(33,40), ds = c(1,2))
shinyServer(function(input, output) {
datasetInput <- reactive({
switch(input$dataset,
df1 = df1,
df2 = df2)
})
output$xvars <- renderUI({
if (datasetInput() == df1){
axis_vars_x <- colnames(df1[c(1,2)])
selectInput("xvar", "X-axis variable", axis_vars_x, selected = "id")
}
else{
axis_vars_x <- colnames(df2[1])
selectInput("xvar", "X-axis variable", axis_vars_x, selected = "id")
}
})
data <- reactive({
df <- datasetInput()
})
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")
})
From you comments, I assumed you wanted to change the y-axis to whatever was selected in the selectInput boxes. To do this with ggvis you need to change the data you pass to the plot.
You can try the following code, I changed a few of your variables:
server.R
library(shiny)
library(dplyr)
df1 <- data.frame(id = c(1,2,3,4,5), number = c(20,30,23,25,34), ds = c(1,2,3,42,2))
df2 <- data.frame(id = c(1,2), number = c(33,40), ds = c(1,2))
shinyServer(function(input, output) {
datasetInput <- reactive({
switch(input$dataset,
"df1" = df1,
"df2" = df2)
})
output$yvars <- renderUI({
if (identical(df1,datasetInput())){
axis_vars_y <- colnames(df1[-1])
selectInput("yvar", "X-axis variable", axis_vars_y, selected = "id")
}
else{
axis_vars_y <- colnames(df2[-1])
selectInput("yvar", "X-axis variable", axis_vars_y, selected = "id")
}
})
yVarName<-reactive({
yValue<-"number"
if(!is.null(input$yvar)){
yValue<-input$yvar
}
yValue
})
data <- reactive({
df<-datasetInput()
yValue<-"number"
if(!is.null(input$yvar)){
yValue<-input$yvar
}
df <- datasetInput()[,c("id",yValue)]
names(df)<-c("id","yVar")
df
})
vis <- reactive({
data %>%
ggvis(~id, ~yVar) %>%
layer_points(fill = ~factor(id)) %>%
scale_nominal("fill", range = c("red","blue","green","yellow","black")) %>%
add_axis("y", title = yVarName())
})
vis %>% bind_shiny("plot")
})
ui.R
library(dplyr)
library(shiny)
library(ggvis)
shinyUI(fluidPage(
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
radioButtons("dataset", label = h4("Product level"),
choices = list("Item" = "df1", "Task" = "df2")),
uiOutput("yvars")
),
mainPanel(
ggvisOutput("plot")
)
)
))
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")
})