I have a strange problem in Shiny. My shiny app has one ggvis plot with layer_points() and several options to manipulate the plot . When I run my app sometimes everything works good even if I change all options, but sometimes ( I suppose there is no specific rule) plot disappers. Plot comes back when I change one of options but it is not cool.
I study this issue but I do not really know whether it is a solution for my problem.
When the plot disappears my Shiny app looks like:
This my code:
ui.R
library(ggvis)
library(markdown)
library(shiny)
library(dplyr)
library(magrittr)
shinyUI(
fluidPage(
h3("Title"),
fluidRow(
column(3,
wellPanel(
radioButtons("radio",h5("Select"),choices=list("All values","Selected values"),
selected="All values"),
conditionalPanel(
condition = "input.radio != 'All values'",
checkboxGroupInput("checkGroup",label = "",
choices,
selected = c("AT1","AT2"))
),
hr(),
radioButtons("dataset", label = h5("Drilldown"),
choices = list("2 Level" = "df1", "3 Level" = "df2")
),
hr(),
h5("Choice"),
selectInput("xvar", h6(""),
axis_vars_x,
selected = "value"),
selectInput("yvar", h6(""),
axis_vars_y,
selected = "number2"),
hr(),
uiOutput("slider")
)
),
column(9,
ggvisOutput("plot")
)
)
)
)
server.R
library(shiny)
shinyServer(function(input, output,session) {
datasetInput <- reactive({
switch(input$dataset,
df2 = df2,
df1 = df1)
})
axis_vara_y <- reactive({
switch(input$yvar,
number = 2,
number2 = 3)
})
output$slider <- renderUI({
sliderInput("inslider",h5(""), min = round(min(datasetInput()[,axis_vara_y()]),0)-1,
max = round(max(datasetInput()[,axis_vara_y()]),0)+1,
value = c(round(min(datasetInput()[,axis_vara_y()]),0)-1,
round(max(datasetInput()[,axis_vara_y()]),0)+1),
step = 0.5)
})
data <- reactive({
filteredData <- datasetInput()
axisData <- axis_vara_y()
if(!is.null(input$inslider)){
if(input$radio == "All values"){
filteredData <- filteredData %>%
filter(filteredData[,axisData] >= input$inslider[1],
filteredData[,axisData] <= input$inslider[2])
}
else {
filteredData <- filteredData %>%
filter(value %in% input$checkGroup,
filteredData[,axisData] >= input$inslider[1],
filteredData[,axisData] <= input$inslider[2])
}
}
return(filteredData)
})
data_point <- reactive({
data() %>%
mutate(id = row_number())
})
xvar <- reactive(as.symbol(input$xvar))
yvar <- reactive(as.symbol(input$yvar))
dotpoint_vis <- reactive({
xvar_name <- names(axis_vars_x)[axis_vars_x == input$xvar]
yvar_name <- names(axis_vars_y)[axis_vars_y == input$yvar]
data_point_detail <- data_point()
plot <- data_point_detail %>%
ggvis(x = xvar(),y = yvar()) %>%
layer_points(size := 120,fill = ~value) %>%
add_axis("x", title = xvar_name) %>%
add_axis("y", title = yvar_name) %>%
set_options(width = 750, height = 500, renderer = "canvas")
})
dotpoint_vis %>% bind_shiny("plot")
})
global.R
choices <- list("Value1" = "AT1", "Value2" = "AT2",
"Value3" = "AT3", "Value4" = "AT4",
"Value5" = "AT5", "Value6" = "RT1",
"Value7" = "AT6", "Value8" = "AT7",
"Value9" = "AT8", "Value10" = "AT9",
"Value11" = "AT10", "Value12" = "RT2")
levele <- c("AT1","AT2","AT3","AT4","AT5","RT1","AT6","AT7","AT8","AT9","AT10","RT2")
df1 <- data.frame(value = levele,number = seq(2,46,4), number2 = seq(2,24,2),order = 1:12)
df2 <- data.frame(value = levele,number = rep(4:15), number2 = rep(4:9,each = 2),order = 1:12)
df1$value <- factor(df1$value, levels = levele)
df2$value <- factor(df2$value, levels = levele)
axis_vars_y <- c("number","number2")
axis_vars_x <- c("value", "order","number","number2")
update
I also do not know what happened with animation in ggvis.
The problem was difficult to reproduce at first, but I found I can reproduce it by clicking back and forth between All Values and Selected Values. The graph disappears or reappears after some number of switches between the two radio buttons, but it varies seemingly randomly -- sometimes it takes 4 clicks to make the graph disappear or reappear and other times it takes 2 clicks or some other number of clicks.
There must be a bug in bind_shiny() or ggvisOutput(), because the following changes do create a graphic that does not seem to disappear:
In ui.R, make this change:
# ggvisOutput("plot")
plotOutput('plot')
In server.R, make this change:
plot(data_point_detail[ , c(input$xvar, input$yvar)], xlab=xvar_name, ylab=yvar_name)
# plot <- data_point_detail %>%
# ggvis(x = xvar(),y = yvar()) %>%
# layer_points(size := 120,fill = ~value) %>%
# add_axis("x", title = xvar_name) %>%
# add_axis("y", title = yvar_name) %>%
# set_options(width = 750, height = 500, renderer = "canvas")
# plot
and
output$plot <- renderPlot(dotpoint_vis())
# dotpoint_vis %>% bind_shiny("plot")
Related
I have a dataset and want to create an R Shiny app with if condition (based on RadioButton).
Additionally, after filtering my initial dataset, I want to replace all 2 values in Quantity column to 200 (Yes, it it possible to do it outside the server(), but in my case, it is necessary to do it inside).
I always get error here sales_by_mfr()$Quantity <- reactive(ifelse(sales_by_mfr()$Quantity == 2,200,sales_by_mfr()$Quantity))
Additionally, I tried to replace all 2 values in my dataset with sales_by_mfr()[sales_by_mfr() == 2] <- reactive({200}) , however got the same error.
Could you help to find a way to avoid "invalid (NULL) left side of assignment" error inside this code?
library(dplyr)
library(shiny)
data <- MASS::Cars93[18:47, ] %>%
mutate(ID = as.character(18:47), Date = seq(as.Date("2019-01-01"), by = "day", length.out = 30)) %>%
select(ID, Date, Manufacturer, Model, Type, Price)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
#sliderInput
radioButtons("dist", "Data:",
c("The most recent" = "most_recent",
"Historical" = "historical"))
),
# plot graphs
mainPanel(tabsetPanel(
tabPanel("Plot",
h3(helpText("Nordpool prices")),
#plotOutput("plot"),
reactableOutput("table")
#h3(helpText("Descr.statistics")),
#verbatimTextOutput("Descr.stat.price")
)
)
))
)
server <- function(input, output, session) {
sales_by_mfr<-reactive({
if (input$dist == "most_recent"){
data %>%
filter(Manufacturer %in% c("Chevrolet","Hyundai","Honda")) %>% group_by( Manufacturer) %>%
summarize(Quantity = n(), Sales = sum(Price))
}else{
data %>%
group_by( Manufacturer) %>%
summarize(Quantity = n(), Sales = sum(Price))
}
})
sales_by_mfr()$Quantity <- reactive(ifelse(sales_by_mfr()$Quantity == 2,200,sales_by_mfr()$Quantity))
#sales_by_mfr()[sales_by_mfr() == 2] <- reactive({200})
#Create columns in two rows (1-dat,2-diffs)
output$table <- renderReactable({
reactable(
sales_by_mfr(),#
# columns = columns(),columnGroups = columnGroups()
#defaultColDef = colDef(minWidth = 222,vAlign = "center"),
#defaultColDef = colDef(vAlign = "center", headerVAlign = "bottom"),
# Set a maximum width on the table:
#style = list(maxWidth = 650),
# Or a fixed width:
#width = 650,
)
})
}
shinyApp(ui = ui, server = server)
Try this
library(MASS)
library(reactable)
data <- MASS::Cars93[18:47, ] %>%
mutate(ID = as.character(18:47), Date = seq(as.Date("2019-01-01"), by = "day", length.out = 30)) %>%
dplyr::select(ID, Date, Manufacturer, Model, Type, Price)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
#sliderInput
radioButtons("dist", "Data:",
c("The most recent" = "most_recent",
"Historical" = "historical"))
),
# plot graphs
mainPanel(tabsetPanel(
tabPanel("Plot",
h3(helpText("Nordpool prices")),
#plotOutput("plot"),
reactableOutput("table")
#h3(helpText("Descr.statistics")),
#verbatimTextOutput("Descr.stat.price")
)
)
))
)
server <- function(input, output, session) {
sales_by_mfr<-reactive({
if (input$dist == "most_recent"){
data %>%
filter(Manufacturer %in% c("Chevrolet","Hyundai","Honda")) %>% group_by( Manufacturer) %>%
summarize(Quantity = n(), Sales = sum(Price))
}else{
data %>%
group_by( Manufacturer) %>%
summarize(Quantity = n(), Sales = sum(Price))
}
ifelse(data$Quantity == 2,200,data$Quantity)
data
})
#sales_by_mfr()$Quantity <- reactive(ifelse(sales_by_mfr()$Quantity == 2,200,sales_by_mfr()$Quantity))
#sales_by_mfr()[sales_by_mfr() == 2] <- reactive({200})
#Create columns in two rows (1-dat,2-diffs)
output$table <- renderReactable({
reactable(
sales_by_mfr(),#
# columns = columns(),columnGroups = columnGroups()
#defaultColDef = colDef(minWidth = 222,vAlign = "center"),
#defaultColDef = colDef(vAlign = "center", headerVAlign = "bottom"),
# Set a maximum width on the table:
#style = list(maxWidth = 650),
# Or a fixed width:
#width = 650,
)
})
}
shinyApp(ui = ui, server = server)
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 get my shinydashboard to plot a sankey chart within a box but when I run it it opens in another tab on my browser. Can I htmlOutput to have the sankey plot open in the box in the app? I tried changing it to DataTable and it works perfect, but with a sankey renderGvis and htmlOutput it doesn't seem to work.
Here's snipits on my code...
UI
tabItem("PatronTransactionFlow",
box(title = "Controls",
width = 12,
status = "success",
solidHeader = TRUE,
uiOutput("PurchaseColumnSankeyChoice"),
uiOutput("SankeyPurchaseFilterNum")),
box(title = paste0(eventname, " Patron Transaction Flow"),
width = 12,
status = "success",
solidHeader = TRUE,
htmlOutput("SankeyPurchasePlot")
)
)
Server
SankeyPurchaseData <- reactive({
sankey <- OverviewPurchaseData %>%
select(Time.y, Tag, Point) %>%
group_by(Time.y, Tag) %>%
arrange(Time.y) %>%
unique() %>%
group_by(Tag) %>%
mutate(n.order = paste('Transaction', c(1:n()), sep='')) %>%
dcast(Tag ~ n.order, value.var='Point', fun.aggregate = NULL)
sankey
})
output$PurchaseColumnSankeyChoice <- renderUI({
sankey <- SankeyPurchaseData()
colchoice <- mixedsort(colnames(sankey)[2:ncol(sankey)])
selectInput("PurchaseColumnSankeyChoice", "Choose Transactions to View",
choices = mixedsort(colnames(sankey)[2:ncol(sankey)]),
selected = mixedsort(colnames(sankey)[2:ncol(sankey)])[1:3],
selectize = TRUE,
multiple = TRUE)
})
SankeyPurchasePlotData <- reactive({
sankey <- SankeyPurchaseData()
sankeyplot <- sankey %>%
select_(.dots = input$PurchaseColumnSankeyChoice)
orders.plot <- data.frame()
for (i in 2:ncol(sankeyplot)) {
ord.cache <- sankeyplot %>%
group_by(sankeyplot[ , i-1], sankeyplot[ , i]) %>%
na.omit()%>%
summarise(n=n())
colnames(ord.cache)[1:2] <- c('from', 'to')
# adding tags to carts
ord.cache$from <- paste(ord.cache$from, '(', i-1, ')', sep='')
ord.cache$to <- paste(ord.cache$to, '(', i, ')', sep='')
orders.plot <- rbind(orders.plot, ord.cache)
}
orders.plot
})
output$SankeyPurchaseFilterNum <- renderUI({
data <- SankeyPurchasePlotData()
max1 <- max(data$n)
sliderInput("SankeyPurchaseFilterNum", "Choose Sequence Number to filter by:",
min = 1, max = max1, value = round(max1*0.7, digits = 0))
})
output$SankeyPurchasePlot <- renderGvis({
orders.plot <- SankeyPurchasePlotData()
orders.plot2 <- orders.plot[which(orders.plot$n >= as.numeric(input$SankeyPurchaseFilterNum)),]
plot <- plot(gvisSankey(orders.plot2, from='from', to='to', weight='n'))
plot
})
I am developing a Shiny app which I hope to look like the picture below:
However, as I try to achieve this, I am only able to get the following form:
I am looking for how to make the output neatly collected, and would appreciate any help. I have looked at a couple of other similar questions here, viz. this and this, but don't think they answer my question (the first talks about adding a mainPanel, but I am using FludiPage and FluidRows. I had thought the columns and rows would automatically adjust to screen size, and that 12 columns are designed to fit into a screen size, but apparently I am wrong?
Many thanks for the help.
The Server.R file for copying/pasting. Apologies, it is a bit long:
#
#
# load libraries, scripts, data
library(shiny)
library(shinyapps)
library(shinydashboard)
library(dplyr)
library(tidyr)
library(lubridate)
library(htmlwidgets)
options(shiny.trace = TRUE,
shiny.maxRequestSize=300*1024^2)
## body of shiny server side program
shinyServer(function(input, output, session) {
dataList <- reactive({
if(is.null(input$uploadFile)){
return(NULL)
}
uploadFileInfo <- input$uploadFile
uploadData <- read.csv(uploadFileInfo$datapath, header = TRUE, stringsAsFactors = FALSE)
uploadedData <- tbl_df(uploadData) %>%
mutate(yearValue = year(dateValues), monthValue = month(dateValues))
sumData1 <- uploadedData %>%
select(yearValue, earnPts, earnCount, redemPts, redemCount, churnCount, acquisCount) %>%
gather(metrics, totals, -yearValue) %>%
group_by(yearValue, metrics) %>%
summarise(yearlyTotals = sum(totals)) %>%
arrange(yearlyTotals)
sumData2 <- uploadedData %>%
select(yearValue, monthValue, earnPts, earnCount, redemPts, redemCount, churnCount, acquisCount) %>%
gather(metrics, totals, -c(yearValue, monthValue)) %>%
group_by(yearValue, monthValue, metrics) %>%
summarise(yearmonthTotals = sum(totals)) %>%
arrange(yearValue, monthValue) %>%
group_by(yearValue, metrics) %>%
mutate(cumulatives = cumsum(yearmonthTotals))
sumData3 <- uploadedData %>%
select(yearValue, monthValue, earnPts, earnCount, redemPts, redemCount, churnCount, acquisCount) %>%
group_by(yearValue, monthValue) %>%
summarise_each(funs(mean)) %>%
round()
sumData4 <- uploadedData %>%
group_by(dateValues) %>%
summarise_each(funs(sum))
earnData <- sumData4 %>%
select(earnPts, earnCount)
row.names(earnData) <- sumData4$dateValues
redempData <- sumData4 %>%
select(redemPts, redemCount)
row.names(earnData) <- sumData4$dateValues
custData <- sumData4 %>%
select(churnCount, acquisCount)
row.names(earnData) <- sumData4$dateValues
sumData5 <- uploadedData %>%
group_by(dateValues) %>%
summarise_each(funs(sum))
earnTSData <- sumData5 %>%
select(earnPts, earnCount)
row.names(earnTSData) <- sumData5$dateValues
redemTSData <- sumData5 %>%
select(redemPts, redemCount)
row.names(redemTSData) <- sumData5$dateValues
custTSData <- sumData5 %>%
select(acquisCount, churnCount)
row.names(custTSData) <- sumData5$dateValues
dfList <- list(sumData1 = sumData1, sumData2 = sumData2, sumData3 = sumData3,
sumData4 = sumData4, earnData = earnData, redempData = redempData,
custData = custData, sumData5 = sumData5, earnTSData = earnTSData,
redemTSData = redemTSData, custTSData = custTSData)
return(dfList)
})
### The main chart
output$outlinesChart <- renderChart2({
myData <- dataList()$sumData1
mainPlot <- nPlot(yearlyTotals ~ metrics,
group = 'yearValue', data = myData, type = 'multiBarChart')
mainPlot$chart(margin=list(left=100))
rm(myData)
return(mainPlot)
})
### Information boxes
output$infoBox1 <- renderInfoBox({
infoBox(
"Progress", 10*2, icon = icon("line-chart"),
color = "blue"
)
})
output$infoBox2 <- renderInfoBox({
infoBox(
"Progress", 10*2, icon = icon("line-chart"),
color = "blue"
)
})
output$infoBox3 <- renderInfoBox({
infoBox(
"Progress", 10*2, icon = icon("line-chart"),
color = "blue"
)
})
output$infoBox4 <- renderInfoBox({
infoBox(
"Progress", 10*2, icon = icon("line-chart"),
color = "blue"
)
})
output$infoBox5 <- renderInfoBox({
infoBox(
"Progress", 10*2, icon = icon("smile-o"),
color = "blue"
)
})
output$infoBox6 <- renderInfoBox({
infoBox(
"Progress", 10*2, icon = icon("frown-o"),
color = "purple", fill = TRUE
)
})
### Cumulative chart for points earned
output$cEarnPtsChart <- renderChart2({
myData <- dataList()$sumData2
interimData <- myData %>% filter( metrics == 'earnPts')
myPlot <- nPlot(cumulatives ~ monthValue, group = 'yearValue',
data = interimData, type = 'lineChart')
rm(myData)
rm(interimData)
return(myPlot)
})
### Cumulative chart for count of earn transactions
output$cEarnCountChart <- renderChart2({
myData <- dataList()$sumData2
interimData <- myData %>% filter( metrics == 'earnCount')
myPlot <- nPlot(cumulatives ~ monthValue, group = 'yearValue',
data = interimData, type = 'lineChart')
rm(myData)
rm(interimData)
return(myPlot)
})
### Cumulative chart for points redeemed
output$cRedemPtsChart <- renderChart2({
myData <- dataList()$sumData2
interimData <- myData %>% filter( metrics == 'redemPts')
myPlot <- nPlot(cumulatives ~ monthValue, group = 'yearValue',
data = interimData, type = 'lineChart')
rm(myData)
rm(interimData)
return(myPlot)
})
### Cumulative chart for count of redemption transactions
output$cRedemCountChart <- renderChart2({
myData <- dataList()$sumData2
interimData <- myData %>% filter( metrics == 'redemCount')
myPlot <- nPlot(cumulatives ~ monthValue, group = 'yearValue',
data = interimData, type = 'lineChart')
rm(myData)
rm(interimData)
return(myPlot)
})
### Cumulative chart for Customer Acquisition
output$cAcquisChart <- renderChart2({
myData <- dataList()$sumData2
interimData <- myData %>% filter( metrics == 'acquisCount')
myPlot <- nPlot(cumulatives ~ monthValue, group = 'yearValue',
data = interimData, type = 'lineChart')
rm(myData)
rm(interimData)
return(myPlot)
})
### Cumulative chart for Customer Acquisition
output$cChurnChart <- renderChart2({
myData <- dataList()$sumData2
interimData <- myData %>% filter( metrics == 'churnCount')
myPlot <- nPlot(cumulatives ~ monthValue, group = 'yearValue',
data = interimData, type = 'lineChart')
rm(myData)
rm(interimData)
return(myPlot)
})
})
The ui.R file:
### load libraries
library(shiny)
library(shinythemes)
### body for Shiny UI
shinyUI(navbarPage("My Sample Dashboard", theme = shinytheme('readable'), inverse = TRUE,
tabPanel("Overview Section",
fluidRow(
column(6,
##current app only supports CSV, since this is a proof of concept...
fileInput(inputId = 'uploadFile', label = 'Please upload your file')
)
),
fluidRow(
column(3,
h4('Main Chart goes here'),
showOutput('outlinesChart', 'nvd3')
),
column(3, offset = 5,
h5('Info boxes go here'),
infoBoxOutput('infoBox1'),
infoBoxOutput('infoBox2'),
infoBoxOutput('infoBox3'),
infoBoxOutput('infoBox4'),
infoBoxOutput('infoBox5'),
infoBoxOutput('infoBox6')
)
),
hr(),
fluidRow(
column(2,
h5('Earned Points chart goes here'),
showOutput('cEarnPtsChart', 'nvd3')
),
column(2, offset = 4,
h5('Earn Count chart goes here'),
showOutput('cEarnCountChart', 'nvd3')
)
),
fluidRow(
column(2,
h5('Redeemed Points chart goes here'),
showOutput('cRedemPtsChart', 'nvd3')
),
column(2, offset = 4,
h5('Redemption Count chart goes here'),
showOutput('cRedemCountChart', 'nvd3')
)
),
fluidRow(
column(2,
h5('Customer Acquisition chart goes here'),
showOutput('cAcquisChart', 'nvd3')
),
column(2, offset = 4,
h5('Customer Churn chart goes here'),
showOutput('cChurnChart', 'nvd3')
)
)
),
tabPanel("Details Section"),
tabPanel("Experiments Section"))
)
Edit:
Following is a code to generate the CSV file to be fed to this app.
earnPtsRange <- 12000:18000
earnCountRange <- 1000:10000
redemPtsRange <- 10000:20000
redemCountRange <- 10000:20000
churnRange <- 1000:10000
acquisitionRange <- 800:15000
### obtained from Dirk Eddelbuettel: https://stackoverflow.com/questions/14720983/efficiently-generate-a-random-sample-of-times-and-dates-between-two-dates
generateDates <- function(N, st="2014/01/01", et="2015/08/31") {
st <- as.POSIXct(as.Date(st))
et <- as.POSIXct(as.Date(et))
dt <- as.numeric(difftime(et,st,unit="sec"))
ev <- sort(runif(N, 0, dt))
rt <- st + ev
rt[order(rt)]
as.Date(rt)
}
## generate data; 10 readings for each month out of 20 months
dateValues <- generateDates(200)
earnPts <- sample(x = earnPtsRange, size = 190)
earnCount <- sample(x = earnCountRange, size = 190)
redemPts <- sample(x = redemPtsRange, size = 190)
redemCount <- sample(x = redemCountRange, size = 190)
churnCount <- sample(x = churnRange, size = 190)
acquisCount <- sample(x = acquisitionRange, size = 190)
## merge the generated data
toyData <- data.frame(dateValues = dateValues, earnPts = earnPts, earnCount = earnCount, redemPts = redemPts, redemCount = redemCount, churnCount = churnCount,
acquisCount = acquisCount)
## write the data to a CSV file
write.csv(x = toyData, file = './toyDataset.csv', row.names = FALSE)
Many thanks in advance.
I have just pushed what I think is a fix to your issue on my fork of rCharts. It solved my issues with responsiveness and auto-resizing with rCharts. The way you use it is by specifying a width and height parameter in showOutput. Default width is 100% and default height is 400px.
Example call would be showOutput("myGraph", "nvd3", height=555)
You can download from: https://github.com/clecocel/rCharts
And you can install it by using: devtools::install_github("clecocel/rCharts")
I have one problem with my Shiny app. Firstly, I have two dataframes in which there are two numeric columns ( number and number2). I also have dynamic ui sliderInput. Shiny app works fine till... when I choose Item dataframe, choose number in Y-axis variable and set range in sliderInput between e.g. 15 and 18, and after that I want to change Y-axis variable to number2 I get an error: Error in eval(substitute(expr), envir, enclos) : wrong result size (2), expected 0 or 1
I know that the problem is caused because number in number2 column is between 1 and 10 and previous settings does not included that numbers. Could anyone tell me how to improve it?
ui.R
library(ggvis)
shinyUI(fluidPage(
titlePanel(""),
sidebarLayout(
sidebarPanel(
radioButtons("dataset", label = h4("Choose dataframe"),
choices = list("Item" = "df1", "Task" = "df2")),
selectInput("yvar", "Y-axis variable", axis_vars_y, selected = "number"),
uiOutput("slider")
),
mainPanel(
ggvisOutput("plot")
)
)
))
server.R
library(shiny)
library(dplyr)
library(magrittr)
library(lazyeval)
df1_number <-sample(seq(1,20,0.01),20,replace = T)
df2_number <-sample(seq(1,20,0.01),20,replace = T)
df1_number2 <-sample(seq(1,10,0.01),20,replace = T)
df2_number2 <-sample(seq(1,10,0.01),20,replace = T)
df1 <- data.frame(name = rep(letters[1:4],each = 5), number = df1_number, number2 = df1_number2)
df2 <- data.frame(name = rep(letters[1:4],each = 5), number = df2_number, number2 = df2_number2)
axis_vars_y <- c("number" = "number", "number2" = "number2")
shinyServer(function(input, output) {
datasetInput <- reactive({
switch(input$dataset,
df1 = df1,
df2 = df2)
})
axis_vara_y <- reactive({
switch(input$yvar,
number = 2,
number2 = 3)
})
output$slider <- renderUI({
sliderInput("inslider","Slider", min = min(datasetInput()[,axis_vara_y()]),
max = max(datasetInput()[,axis_vara_y()]),
value = c(min(datasetInput()[,axis_vara_y()]),
max(datasetInput()[,axis_vara_y()])),
step = 0.5)
})
data <- reactive({
filteredData <- datasetInput()
if(!is.null(input$inslider)){
filteredData <- filteredData %>%
filter(filteredData[,axis_vara_y()] >= input$inslider[1],
filteredData[,axis_vara_y()] <= input$inslider[2])
}
filteredData
})
data_two <- reactive({
data() %>%
mutate(id = 1:n())
})
vis <- reactive({
yvar_name <- names(axis_vars_y)[axis_vars_y == input$yvar]
yvar <- prop("y", as.symbol(input$yvar))
data_two %>%
ggvis(x = ~name, y = yvar) %>%
layer_points(size := 120,
fill = ~name,
fillOpacity := 0.6,
key := ~id)
})
vis %>% bind_shiny("plot")
})
Update---------------------------------------------------------------------------------------------------
The same error occurs when I set a range which does not included any value from number column (e.g. between 13 and 14).
As you realize, you are getting the error because the filtered dataset has no rows. A simple workaround would be to return the full dataset. This will reset the inputSlider for you to continue working without error. You only need to change your reactive data function.
data <- reactive({
filteredData <- datasetInput()
axisData <- axis_vara_y()
if(!is.null(input$inslider)){
filteredData <- filteredData %>%
filter(filteredData[,axisData] >= input$inslider[1],
filteredData[,axisData] <= input$inslider[2])
}
# the new part to reset the slider
if(nrow(filteredData) == 0){
return(datasetInput())
}else{
return(filteredData)
}
})
I have taken the liberty of simplifying the code a little bit as you can assign your reactive data statements and not have the shiny app call them several times.