x and y labels with shiny and rCharts - r

I'm almost done creating the shiny app that I want.
How can I add labels to the x and y axis of my graph?
This is what I have right now:
library(rCharts)
library(shiny)
X <- data.frame(Var1 = c(1L, 2L, 3L, 4L, 5L, 6L, 7L,8L, 9L, 10L, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 1L, 2L,3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L),
Var2 = structure(c(1L,1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L), .Label = c("control","treatment1", "treatment2"), class = "factor"),
Freq = c(0L,0L, 3L, 2L, 6L, 9L, 13L, 36L, 50L, 497L, 0L, 2L, 1L, 3L, 6L, 4L, 11L, 29L, 50L, 499L, 1L, 2L, 0L, 2L, 5L, 6L, 12L, 22L, 63L,490L)
)
runApp(
list(ui = fluidPage(
titlePanel("Quiz 3 grades distribution"),
fluidRow(
column(3,
#helpText("Select grade in Quiz 1 before the treatment:"),
selectInput("select", label = h3("Grade Quiz 1 before the treatment:"),
choices = list("All" = 0, "Not Perfect" = 1, "Perfect" = 2),
selected = 0)
),
column(9, div(showOutput("histogram","nvd3")), style = 'align:center;')
)
),
server = shinyServer(
function(input, output, session) {
output$histogram <- renderChart2({
n2 <- nPlot(Freq ~ Var1, group = 'Var2', data = X, type = 'multiBarChart')
n2$params$width <- 500
n2$params$height <- 400
n2
})
}
)
)
)
Thanks!

The nPlot object has a xAxis and yAxis method which take an option axisLabel. You may need to adjust the width on the yaxis.
library(rCharts)
library(shiny)
X <- data.frame(Var1 = c(1L, 2L, 3L, 4L, 5L, 6L, 7L,8L, 9L, 10L, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 1L, 2L,3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L),
Var2 = structure(c(1L,1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L), .Label = c("control","treatment1", "treatment2"), class = "factor"),
Freq = c(0L,0L, 3L, 2L, 6L, 9L, 13L, 36L, 50L, 497L, 0L, 2L, 1L, 3L, 6L, 4L, 11L, 29L, 50L, 499L, 1L, 2L, 0L, 2L, 5L, 6L, 12L, 22L, 63L,490L)
)
runApp(
list(ui = fluidPage(
titlePanel("Quiz 3 grades distribution"),
fluidRow(
column(3,
#helpText("Select grade in Quiz 1 before the treatment:"),
selectInput("select", label = h3("Grade Quiz 1 before the treatment:"),
choices = list("All" = 0, "Not Perfect" = 1, "Perfect" = 2),
selected = 0)
),
column(9, div(showOutput("histogram","nvd3")), style = 'align:center;')
, tags$head(tags$style(HTML(".nv-axislabel {font: 22px Arial;}"))) # to style labels
)
),
server = shinyServer(
function(input, output, session) {
output$histogram <- renderChart2({
n2 <- nPlot(Freq ~ Var1, group = 'Var2', data = X, type = 'multiBarChart')
n2$params$width <- 500
n2$params$height <- 400
n2$xAxis(axisLabel = "my x axis label")
n2$yAxis(axisLabel = "my y axis label", width = 50)
n2
})
}
)
)
)

Related

Linking values of stacked barplot with a table in R Shiny

I have created a stacked barplot in the shiny app in R:
library(shiny)
library(ggplot2)
ui = shinyUI(fluidPage(
titlePanel("Competency"),
fluidRow(
column(6,
plotOutput("Competency.Name", click = "plot1_click")
),
column(5,
br(), br(), br(),
htmlOutput("x_value"),
verbatimTextOutput("selected_rows"))),
))
server <- function(input, output) {
report <- structure(list(Competency.Official.Rating = structure(c(1L, 2L,
3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L,
4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L,
5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L
), .Label = c("0", "1", "100", "2", "3"), class = "factor"),
Competency.Name = structure(c(1L, 1L, 1L, 1L, 1L, 2L, 2L,
2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 4L, 5L, 5L,
5L, 5L, 5L, 6L, 6L, 6L, 6L, 6L, 7L, 7L, 7L, 7L, 7L, 8L, 8L,
8L, 8L, 8L, 9L, 9L, 9L, 9L, 9L, 10L, 10L, 10L, 10L, 10L), .Label = c("Agile",
"Co-creating the future", "Collaboration", "Entrepreneurship",
"Feedback", "Impact", "One company", "One voice", "Responsibility",
"Simplification"), class = "factor"), Freq = c(2L, 9L, 308L,
221L, 95L, 7L, 76L, 310L, 191L, 51L, 2L, 12L, 308L, 193L,
120L, 2L, 43L, 310L, 220L, 60L, 2L, 49L, 311L, 211L, 62L,
3L, 58L, 310L, 208L, 56L, 4L, 22L, 312L, 182L, 115L, 3L,
11L, 310L, 196L, 115L, 2L, 9L, 309L, 161L, 154L, 3L, 38L,
309L, 226L, 59L)), class = "data.frame", row.names = c(NA,
-50L))
output$Competency.Name <- renderPlot({
ggplot(report, aes(x = Competency.Name, y = Freq, fill = Competency.Official.Rating, label = Freq)) +
geom_bar(stat = "identity") + # position = fill will give the %; stack will give #of people
geom_text(size = 3, position = position_stack(vjust = 0.5))
})
# Print the name of the x value
output$x_value <- renderText({
if (is.null(input$plot1_click$x)) return("")
else {
lvls <- levels(report$Competency.Name)
name <- lvls[round(input$plot1_click$x)]
HTML("You've selected <code>", name, "</code>",
"<br><br>Here are the first 10 rows that ",
"match that category:")
}
})
# Print the rows of the data frame which match the x value
output$selected_rows <- renderPrint({
if (is.null(input$plot1_click$x)) return()
else {
keeprows <- round(input$plot1_click$x) == as.numeric(report$Competency.Name)
head(report[keeprows, ], 10)
}
})
}
shinyApp(ui, server)
In the app, when I select a column on my barplot it shows the table for the whole bar (the fact that it is a stacked barplot with different values is not taken in account by my code). In the table I would like to see values only for a selected stack. I know in this example it does not male sense but I have a bigger table with more variables and I could use this modification there.
Thank you!
You need to calculate the cumulative sum of your input and then you can compare it to input$plot1_click$y like this:
library(shiny)
library(ggplot2)
library(dplyr)
report <- structure(
list(Competency.Official.Rating =
structure(c(1L, 2L,
3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L,
4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L,
5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L
), .Label = c("0", "1", "100", "2", "3"), class = "factor"),
Competency.Name =
structure(c(1L, 1L, 1L, 1L, 1L, 2L, 2L,
2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 4L, 5L, 5L,
5L, 5L, 5L, 6L, 6L, 6L, 6L, 6L, 7L, 7L, 7L, 7L, 7L, 8L, 8L,
8L, 8L, 8L, 9L, 9L, 9L, 9L, 9L, 10L, 10L, 10L, 10L, 10L),
.Label =
c("Agile",
"Co-creating the future", "Collaboration", "Entrepreneurship",
"Feedback", "Impact", "One company", "One voice",
"Responsibility", "Simplification"), class = "factor"),
Freq = c(2L, 9L, 308L,
221L, 95L, 7L, 76L, 310L, 191L, 51L, 2L, 12L, 308L, 193L,
120L, 2L, 43L, 310L, 220L, 60L, 2L, 49L, 311L, 211L, 62L,
3L, 58L, 310L, 208L, 56L, 4L, 22L, 312L, 182L, 115L, 3L,
11L, 310L, 196L, 115L, 2L, 9L, 309L, 161L, 154L, 3L, 38L,
309L, 226L, 59L)), class = "data.frame",
row.names = c(NA,
-50L))
report_stats <- report %>%
arrange(Competency.Name, desc(Competency.Official.Rating)) %>%
group_by(Competency.Name) %>%
mutate(cumsum = cumsum(Freq))
ui = shinyUI(fluidPage(
titlePanel("Competency"),
fluidRow(
column(6,
plotOutput("Competency.Name", click = "plot1_click")
),
column(5,
br(), br(), br(),
htmlOutput("x_value"),
verbatimTextOutput("selected_rows"))),
))
server <- function(input, output) {
x_val <- reactive({
x <- req(input$plot1_click$x)
lvls <- levels(report$Competency.Name)
lvls[round(input$plot1_click$x)]
})
y_val <- reactive({
x <- req(x_val())
y <- req(input$plot1_click$y)
report_stats %>%
filter(Competency.Name == x,
y <= cumsum) %>%
slice(1L) %>%
pull(Competency.Official.Rating)
})
output$Competency.Name <- renderPlot({
ggplot(report, aes(x = Competency.Name, y = Freq,
fill = Competency.Official.Rating, label = Freq)) +
geom_bar(stat = "identity") +
geom_text(size = 3, position = position_stack(vjust = 0.5))
})
# Print the name of the x value
output$x_value <- renderText({
HTML("You've selected <code>", req(x_val()), "</code>",
"<br><br>Here are the first 10 rows that ",
"match that category:")
})
# Print the rows of the data frame which match the x value
output$selected_rows <- renderPrint({
x <- req(x_val())
y <- req(y_val())
head(report[report$Competency.Name == x & report$Competency.Official.Rating == y, ], 10)
})
}
shinyApp(ui, server)

Merge and edit multiple legends when facets and geom_line are plotted separately

Following this guide I have plotted the following graph using the following code. I did split my dataset into one that contains the data that goes in all plots 'control', and the rest 'dfnocontrol'.
ggplot(dfnocontrol,aes(y=value,x=year)) + geom_line(data=dfnocontrol,
aes(color=survivorship),size=1.5) + facet_wrap(~density,nrow=2) +
geom_line(data=dfcontrol,aes(linetype=simulname),color='grey',size=1.5)
I have tried many ways to have only one legend, or to edit the existing two legend but nothing seems to work. scale_fill_manual() seems to be ignored, even though I don't get any error message. I was forced to use linetype to make the 'control' appear in the legend. How can I merge these two legends?
edit: these are the data for control
structure(list(year = 1:2, psize = structure(c(6L, 6L), .Label = c("all plants",
"all plants no-seedl", "seedlings", "SmallerT10", "SmallerT10 no-seedl",
"LargerT10", "10-30", "30-50", "50+"), class = "factor"), value = c(392.884450281975,
392.76842677951), simulname = structure(c(1L, 1L), .Label = c("control",
"d02s70", "d02s80", "d02s90", "d05s70", "d05s80", "d05s90", "d07s70",
"d07s80", "d07s90", "d1s70", "d1s80", "d1s90", "d2s70", "d2s80",
"d2s90", "d3s70", "d3s80", "d3s90", "d4s70", "d4s80", "d4s90",
"d5s70", "d5s80", "d5s90"), class = "factor"), survivorship = structure(c(1L,
1L), .Label = c("control", "s70", "s80", "s90"), class = "factor")), .Names = c("year",
"psize", "value", "simulname", "survivorship"), row.names = 2501:2502, class = "data.frame")
and data for the rest
structure(list(year = c(1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L,
1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L,
1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L,
1L, 2L, 1L, 2L, 1L, 2L), psize = structure(c(6L, 6L, 6L, 6L,
6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L,
6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L,
6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L), .Label = c("all plants",
"all plants no-seedl", "seedlings", "SmallerT10", "SmallerT10 no-seedl",
"LargerT10", "10-30", "30-50", "50+"), class = "factor"), value = c(391.933827876557,
390.784233661738, 391.931768654094, 390.777949423224, 391.930831801103,
390.775125884957, 391.904131913644, 390.671681105517, 391.903377880798,
390.669377819171, 391.902842713777, 390.667498067697, 391.874743014214,
390.557893743236, 391.874006362415, 390.555639401299, 391.8735511448,
390.554149478021, 391.84367266143, 390.443618794749, 391.843064602404,
390.442149462261, 391.842594963982, 390.440725187945, 391.72267802326,
388.998242801555, 391.722309813432, 388.996838950063, 391.721745089041,
388.995715149179, 384.967818982887, 383.215849576989, 384.967407490871,
383.214728664341, 384.96689031843, 383.213390281481, 391.897592532656,
389.445606459513, 391.897234485415, 389.444632515097, 391.89681267375,
389.443358475326, 391.402389493961, 388.987279260992, 391.401979078947,
388.985920091544, 391.401583421483, 388.984891027315), simulname = structure(c(2L,
2L, 3L, 3L, 4L, 4L, 5L, 5L, 6L, 6L, 7L, 7L, 8L, 8L, 9L, 9L, 10L,
10L, 11L, 11L, 12L, 12L, 13L, 13L, 14L, 14L, 15L, 15L, 16L, 16L,
17L, 17L, 18L, 18L, 19L, 19L, 20L, 20L, 21L, 21L, 22L, 22L, 23L,
23L, 24L, 24L, 25L, 25L), .Label = c("control", "d02s70", "d02s80",
"d02s90", "d05s70", "d05s80", "d05s90", "d07s70", "d07s80", "d07s90",
"d1s70", "d1s80", "d1s90", "d2s70", "d2s80", "d2s90", "d3s70",
"d3s80", "d3s90", "d4s70", "d4s80", "d4s90", "d5s70", "d5s80",
"d5s90"), class = "factor"), density = structure(c(2L, 2L, 2L,
2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 4L, 4L, 5L,
5L, 5L, 5L, 5L, 5L, 6L, 6L, 6L, 6L, 6L, 6L, 7L, 7L, 7L, 7L, 7L,
7L, 8L, 8L, 8L, 8L, 8L, 8L, 9L, 9L, 9L, 9L, 9L, 9L), .Label = c("control",
"d02", "d05", "d07", "d1", "d2", "d3", "d4", "d5"), class = "factor"),
survivorship = structure(c(2L, 2L, 3L, 3L, 4L, 4L, 2L, 2L,
3L, 3L, 4L, 4L, 2L, 2L, 3L, 3L, 4L, 4L, 2L, 2L, 3L, 3L, 4L,
4L, 2L, 2L, 3L, 3L, 4L, 4L, 2L, 2L, 3L, 3L, 4L, 4L, 2L, 2L,
3L, 3L, 4L, 4L, 2L, 2L, 3L, 3L, 4L, 4L), .Label = c("control",
"s70", "s80", "s90"), class = "factor")), .Names = c("year",
"psize", "value", "simulname", "density", "survivorship"), row.names = c(6081L,
6082L, 9845L, 9846L, 14345L, 14346L, 17985L, 17986L, 21797L,
21798L, 26297L, 26298L, 30567L, 30568L, 34528L, 34529L, 38744L,
38745L, 43144L, 43145L, 47519L, 47520L, 51983L, 51984L, 56483L,
56484L, 60983L, 60984L, 65483L, 65484L, 69983L, 69984L, 74483L,
74484L, 78983L, 78984L, 83483L, 83484L, 87983L, 87984L, 92483L,
92484L, 96983L, 96984L, 101483L, 101484L, 105983L, 105984L), class = "data.frame")
Since you provided no data, I will give you an example using the economics data set.
library(wesanderson) # for the colours
library(tidyverse)
data("economics")
We will need two data sets for this task. Variable unemploy will serve as our 'control' (6th column). All variables will be scaled.
First data set:
economics_gathered <- economics[, 1:5] %>% # exclude unemploy
modify_if(is.numeric, scale) %>%
gather(key, value, -date)
Second data set:
economics_control <- economics[, c(1, 6)] %>%
dplyr::rename(control = unemploy) %>%
gather(some_other_key, value, 2) %>%
mutate(value = scale(value))
Now we can plot:
ggplot() +
geom_line(data = economics_control, aes(x = date, y = value, col = some_other_key)) +
geom_line(data = economics_gathered, aes(date, value, col = key)) +
scale_colour_manual(values = c("grey", wes_palette("GrandBudapest"))) +
facet_wrap(~key, scales = "free_y")
To which the result is the plot below.
EDIT
With the data provided by the OP the following code
ggplot() +
geom_line(data = dfcontrol, aes(year, value, col = survivorship), size = 1.5) +
geom_line(data = dfnocontrol, aes(year, value, col = survivorship), size = 1.5) +
facet_wrap( ~ density, nrow = 2) +
scale_colour_manual(values = c("grey", "forestgreen", "red", "blue"))
gives this plot:
DATA
1)
dfcontrol <- structure(list(year = 1:2, psize = structure(c(6L, 6L), .Label = c("all plants",
"all plants no-seedl", "seedlings", "SmallerT10", "SmallerT10 no-seedl",
"LargerT10", "10-30", "30-50", "50+"), class = "factor"), value = c(392.884450281975,
392.76842677951), simulname = structure(c(1L, 1L), .Label = c("control",
"d02s70", "d02s80", "d02s90", "d05s70", "d05s80", "d05s90", "d07s70",
"d07s80", "d07s90", "d1s70", "d1s80", "d1s90", "d2s70", "d2s80",
"d2s90", "d3s70", "d3s80", "d3s90", "d4s70", "d4s80", "d4s90",
"d5s70", "d5s80", "d5s90"), class = "factor"), survivorship = structure(c(1L,
1L), .Label = c("control", "s70", "s80", "s90"), class = "factor")), .Names = c("year",
"psize", "value", "simulname", "survivorship"), row.names = 2501:2502, class = "data.frame")
2)
dfnocontrol <- structure(list(year = c(1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L,
1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L,
1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L,
1L, 2L, 1L, 2L, 1L, 2L), psize = structure(c(6L, 6L, 6L, 6L,
6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L,
6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L,
6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L), .Label = c("all plants",
"all plants no-seedl", "seedlings", "SmallerT10", "SmallerT10 no-seedl",
"LargerT10", "10-30", "30-50", "50+"), class = "factor"), value = c(391.933827876557,
390.784233661738, 391.931768654094, 390.777949423224, 391.930831801103,
390.775125884957, 391.904131913644, 390.671681105517, 391.903377880798,
390.669377819171, 391.902842713777, 390.667498067697, 391.874743014214,
390.557893743236, 391.874006362415, 390.555639401299, 391.8735511448,
390.554149478021, 391.84367266143, 390.443618794749, 391.843064602404,
390.442149462261, 391.842594963982, 390.440725187945, 391.72267802326,
388.998242801555, 391.722309813432, 388.996838950063, 391.721745089041,
388.995715149179, 384.967818982887, 383.215849576989, 384.967407490871,
383.214728664341, 384.96689031843, 383.213390281481, 391.897592532656,
389.445606459513, 391.897234485415, 389.444632515097, 391.89681267375,
389.443358475326, 391.402389493961, 388.987279260992, 391.401979078947,
388.985920091544, 391.401583421483, 388.984891027315), simulname = structure(c(2L,
2L, 3L, 3L, 4L, 4L, 5L, 5L, 6L, 6L, 7L, 7L, 8L, 8L, 9L, 9L, 10L,
10L, 11L, 11L, 12L, 12L, 13L, 13L, 14L, 14L, 15L, 15L, 16L, 16L,
17L, 17L, 18L, 18L, 19L, 19L, 20L, 20L, 21L, 21L, 22L, 22L, 23L,
23L, 24L, 24L, 25L, 25L), .Label = c("control", "d02s70", "d02s80",
"d02s90", "d05s70", "d05s80", "d05s90", "d07s70", "d07s80", "d07s90",
"d1s70", "d1s80", "d1s90", "d2s70", "d2s80", "d2s90", "d3s70",
"d3s80", "d3s90", "d4s70", "d4s80", "d4s90", "d5s70", "d5s80",
"d5s90"), class = "factor"), density = structure(c(2L, 2L, 2L,
2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 4L, 4L, 5L,
5L, 5L, 5L, 5L, 5L, 6L, 6L, 6L, 6L, 6L, 6L, 7L, 7L, 7L, 7L, 7L,
7L, 8L, 8L, 8L, 8L, 8L, 8L, 9L, 9L, 9L, 9L, 9L, 9L), .Label = c("control",
"d02", "d05", "d07", "d1", "d2", "d3", "d4", "d5"), class = "factor"),
survivorship = structure(c(2L, 2L, 3L, 3L, 4L, 4L, 2L, 2L,
3L, 3L, 4L, 4L, 2L, 2L, 3L, 3L, 4L, 4L, 2L, 2L, 3L, 3L, 4L,
4L, 2L, 2L, 3L, 3L, 4L, 4L, 2L, 2L, 3L, 3L, 4L, 4L, 2L, 2L,
3L, 3L, 4L, 4L, 2L, 2L, 3L, 3L, 4L, 4L), .Label = c("control",
"s70", "s80", "s90"), class = "factor")), .Names = c("year",
"psize", "value", "simulname", "density", "survivorship"), row.names = c(6081L,
6082L, 9845L, 9846L, 14345L, 14346L, 17985L, 17986L, 21797L,
21798L, 26297L, 26298L, 30567L, 30568L, 34528L, 34529L, 38744L,
38745L, 43144L, 43145L, 47519L, 47520L, 51983L, 51984L, 56483L,
56484L, 60983L, 60984L, 65483L, 65484L, 69983L, 69984L, 74483L,
74484L, 78983L, 78984L, 83483L, 83484L, 87983L, 87984L, 92483L,
92484L, 96983L, 96984L, 101483L, 101484L, 105983L, 105984L), class = "data.frame")

Error in multiple selectInput in Shiny

This app is meant to create a subset of a larger dataset based on the 2 inputs selection in Shiny app. I have used a dropdownbutton function I found on here.
# func --------------------------------------------------------------------
dropdownButton <- function(label = "", status = c("default", "primary", "success", "info", "warning", "danger"), ..., width = NULL) {
status <- match.arg(status)
# dropdown button content
html_ul <- list(
class = "dropdown-menu",
style = if (!is.null(width))
paste0("width: ", validateCssUnit(width), ";"),
lapply(X = list(...), FUN = tags$li, style = "margin-left: 10px; margin-right: 10px;")
)
# dropdown button apparence
html_button <- list(
class = paste0("btn btn-", status," dropdown-toggle"),
type = "button",
`data-toggle` = "dropdown"
)
html_button <- c(html_button, list(label))
html_button <- c(html_button, list(tags$span(class = "caret")))
# final result
tags$div(
class = "dropdown",
do.call(tags$button, html_button),
do.call(tags$ul, html_ul),
tags$script(
"$('.dropdown-menu').click(function(e) {
e.stopPropagation();
});")
)
}
My app is meant to create a subset of a larger dataset based on the 2 inputs selection in Shiny app. For both dropdown menu, I want multiple select option similar to multiple=TRUE in selectInput. Although dropdownbutton menu allows me to select multiple options, it randomly omits data in output that should be included. I get the correct subset when I use selectInput. Any solutions?
Second, my selectAll button doesn't work.
The problem is that when I select
ou1 <- levels(df$OperatingUnit)
ou <- setNames(as.list(ou1),ou1)
indi1 <- levels(df$indicator)
indi <- setNames(as.list(indi1),indi1)
ui->...
inputPanel(
dropdownButton(
label = "Select OU", status = "default", width = 120,
actionButton(inputId = "all", label = "Select all"),
checkboxGroupInput(inputId = "check1", label = "Choose", choices = paste(ou))
),
dropdownButton(
label = "Select Indicators", status = "default", width = 150,
checkboxGroupInput(inputId = "check2", label = "Choose", choices = paste(indi))
),
tableOutput("tab1")
))
Server -->
shinyServer(function(input, output, session) {
dataset - changes based on menu selections
df1 <- reactive({
df[df$OperatingUnit==input$check1 & df$indicator==input$check2,]
})
output$tab1<- renderTable({
head(df1(), n = 10)
})
output$downloadData <- downloadHandler(
filename = function() {
paste("PSNU_IM", '.csv', sep='')
},
content = function(file) {
write.csv(df1(), file)
}
)
# Select all / Unselect all
observeEvent(input$all, {
if (is.null(input$check1)) {
updateCheckboxGroupInput(
session = session, inputId = "check1", selected = paste(ou)
)
} else {
updateCheckboxGroupInput(
session = session, inputId = "check1", selected = ""
)
}
})
})
)`
Subset of my data:
structure(list(Region = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L), .Label = "Africa", class = "factor"), OperatingUnit = structure(c(3L,
3L, 3L, 3L, 3L, 3L, 1L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L,
3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L,
3L, 3L, 3L, 3L, 2L, 2L, 2L, 2L), .Label = c("Angola", "Botswana",
"Cameroon"), class = "factor"), SNU1Uid = structure(c(5L, 5L,
9L, 9L, 4L, 5L, 1L, 4L, 5L, 4L, 4L, 5L, 4L, 9L, 3L, 9L, 4L, 9L,
4L, 4L, 4L, 3L, 4L, 4L, 5L, 5L, 9L, 5L, 4L, 4L, 3L, 3L, 9L, 4L,
4L, 9L, 4L, 7L, 8L, 6L, 2L), .Label = c("", "BTRiZA58YEx", "HxXMyMSODnm",
"IaFLxtEwIwk", "Jm3YTCERxvX", "MERiZA58YEx", "MTRiZA58YEx", "MTRiZA68YEx",
"MTRiZG58YEx"), class = "factor"), PSNUuid = structure(c(29L,
11L, 23L, 23L, 10L, 29L, 1L, 13L, 18L, 30L, 8L, 2L, 9L, 7L, 15L,
19L, 33L, 16L, 27L, 31L, 21L, 3L, 20L, 25L, 14L, 32L, 7L, 28L,
22L, 22L, 24L, 12L, 16L, 8L, 9L, 5L, 10L, 4L, 6L, 17L, 26L), .Label = c("",
"a2nQs7VmYiD", "AbJXFBhkc4U", "AFX0cjkDX6A", "AFX0djkDX6A", "AFX0djkFX6A",
"AW764lDxjdr", "clasYX5teTV", "fHkrk3yL1uU", "gOaZeiwAoCD", "GP5qeoiXMtA",
"hvNtuMClAXW", "hz2Tdvrxqbp", "JIcgSOsSpSV", "js5vRAkkqxB", "k7lIVnxWbm7",
"KFX0djkDX6A", "MIvAFWhI9Yc", "Ns6ZJi0iwJj", "oAgxCCStCQe", "PJKaNADvNfi",
"r5xWCJ4ZqYQ", "rjDWLPMhaY0", "VaHOXJU4rir", "vewKgey8sOW", "VFX0djkDX6A",
"Vq1CnJNw46x", "vqaBeYFtUn0", "VZPPWeDuJqU", "YuCzvkHV2X5", "YXiMSh7CqES",
"zU7eKPwFr69", "ZxJNWnk4hYW"), class = "factor"), indicator = structure(c(5L,
5L, 1L, 5L, 1L, 1L, 4L, 1L, 1L, 2L, 5L, 1L, 1L, 5L, 1L, 5L, 5L,
5L, 5L, 3L, 1L, 5L, 1L, 1L, 5L, 5L, 1L, 5L, 1L, 3L, 1L, 1L, 5L,
5L, 1L, 5L, 5L, 6L, 6L, 5L, 5L), .Label = c("CARE_CURR", "GEND_GBV",
"GEND_NORM", "HRH_PRE", "TX_CURR", "TX_NEW"), class = "factor"),
numeratorDenom = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L), .Label = "N", class = "factor"), indicatorType = structure(c(1L,
1L, 1L, 2L, 1L, 2L, 1L, 2L, 2L, 1L, 1L, 2L, 1L, 2L, 1L, 2L,
1L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 1L, 2L, 1L, 2L, 2L,
2L, 1L, 2L, 1L, 2L, 1L, 1L, 1L, 1L, 1L), .Label = c("DSD",
"TA"), class = "factor"), disaggregate = structure(c(4L,
1L, 1L, 6L, 6L, 1L, 5L, 1L, 2L, 1L, 6L, 1L, 1L, 3L, 1L, 6L,
6L, 1L, 1L, 6L, 1L, 1L, 1L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), .Label = c("Age/Sex",
"Age/Sex Aggregated", "Age/Sex, Aggregated", "Aggregated Age/Sex",
"Grad Cadre", "Total Numerator"), class = "factor"), categoryOptionComboName = structure(c(8L,
7L, 16L, 13L, 13L, 23L, 19L, 14L, 9L, 3L, 13L, 16L, 21L,
2L, 17L, 13L, 13L, 2L, 11L, 13L, 18L, 1L, 14L, 4L, 1L, 10L,
23L, 12L, 20L, 6L, 22L, 15L, 7L, 12L, 16L, 5L, 2L, 12L, 16L,
5L, 2L), .Label = c("<1, Female", "<1, Male", "<10, Female",
"<15, Male", "1-4, Male", "10-14, Male", "15-19, Female",
"15+, Female", "15+, Male", "20+, Female", "20+, Male", "5-14, Male",
"default", "Female, 15-19", "Female, 20-24", "Female, 25-49",
"Female, 5-9", "Female, 50+", "Lab Professionals", "Male, <1",
"Male, 1-4", "Male, 20-24", "Male, 50+"), class = "factor"),
Age = structure(c(10L, 9L, 13L, 1L, 1L, 14L, 1L, 9L, 10L,
3L, 1L, 13L, 5L, 2L, 6L, 1L, 1L, 2L, 12L, 1L, 14L, 2L, 9L,
4L, 2L, 12L, 14L, 7L, 2L, 8L, 11L, 11L, 9L, 7L, 13L, 5L,
2L, 7L, 13L, 5L, 2L), .Label = c(" ", " <01", " <10",
" <15", " 01-04", " 05-09", " 05-14", " 10-14", " 15-19",
" 15+", " 20-24", " 20+", " 25-49", " 50+"), class = "factor"),
Sex = structure(c(2L, 2L, 2L, 1L, 1L, 3L, 1L, 2L, 3L, 2L,
1L, 2L, 3L, 3L, 2L, 1L, 1L, 3L, 3L, 1L, 2L, 2L, 2L, 3L, 2L,
2L, 3L, 3L, 3L, 3L, 3L, 2L, 2L, 3L, 2L, 3L, 3L, 3L, 2L, 3L,
3L), .Label = c("", "Female", "Male"), class = "factor"),
FY2016Q4 = c(60L, 42L, 144L, 606L, 977L, 509L, 475L, 827L,
455L, 966L, 432L, 372L, 333L, 0L, 583L, 339L, 423L, 107L,
341L, 45L, 818L, 299L, 679L, 261L, 964L, 338L, 470L, 879L,
421L, 351L, 490L, 464L, 416L, 844L, 752L, 708L, 506L, 889L,
230L, 586L, 576L), FY2016APR = c(4L, 471L, 106L, 876L, 873L,
490L, 65L, 360L, 232L, 673L, 646L, 548L, 495L, 846L, 215L,
11L, 405L, 953L, 411L, 610L, 907L, 755L, 580L, 967L, 594L,
213L, 227L, 54L, 25L, 930L, 266L, 512L, 277L, 150L, 454L,
478L, 720L, 666L, 249L, 886L, 781L), FY2017_TARGETS = c(464L,
853L, 907L, 598L, 685L, 791L, 232L, 981L, 217L, 705L, 920L,
890L, 144L, 545L, 159L, 615L, 72L, 570L, 325L, 138L, 919L,
743L, 316L, 673L, 867L, 488L, 652L, 683L, 805L, 616L, 701L,
911L, 985L, 595L, 576L, 132L, 396L, 856L, 721L, 353L, 105L
)), .Names = c("Region", "OperatingUnit", "SNU1Uid", "PSNUuid",
"indicator", "numeratorDenom", "indicatorType", "disaggregate",
"categoryOptionComboName", "Age", "Sex", "FY2016Q4", "FY2016APR",
"FY2017_TARGETS"), class = "data.frame", row.names = c(NA, -41L
))
Hi when you filter your data.frame use %in% instead of == because the two vectors you compare don't have the same length, e.g. :
df1 <- reactive({
df[df$OperatingUnit %in% input$check1 & df$indicator %in% input$check2, ]
})
For the second "select all" button you have to put an observeEvent in your server if you want that something happen if you click on it :
observeEvent(input$all1, {
if (is.null(input$check2)) {
updateCheckboxGroupInput(
session = session, inputId = "check2", selected = paste(indi)
)
} else {
updateCheckboxGroupInput(
session = session, inputId = "check2", selected = ""
)
}
})

Shiny and Rcharts y-axis marks?

I have the following code working:
library(rCharts)
library(shiny)
X <- data.frame(Var1 = c(1L, 2L, 3L, 4L, 5L, 6L, 7L,8L, 9L, 10L, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 1L, 2L,3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L),
Var2 = structure(c(1L,1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L), .Label = c("control","treatment1", "treatment2"), class = "factor"),
Freq = c(0L,0L, 3L, 2L, 6L, 9L, 13L, 36L, 50L, 497L, 0L, 2L, 1L, 3L, 6L, 4L, 11L, 29L, 50L, 499L, 1L, 2L, 0L, 2L, 5L, 6L, 12L, 22L, 63L,490L)
)
runApp(
list(ui = fluidPage(
titlePanel("Quiz 3 grades distribution"),
fluidRow(
column(3,
#helpText("Select grade in Quiz 1 before the treatment:"),
selectInput("select", label = h3("Grade Quiz 1 before the treatment:"),
choices = list("All" = 0, "Not Perfect" = 1, "Perfect" = 2),
selected = 0)
),
column(9, div(showOutput("histogram","nvd3")), style = 'align:center;')
, tags$head(tags$style(HTML(".nv-axislabel {font: 22px Arial;}"))) # to style labels
)
),
server = shinyServer(
function(input, output, session) {
output$histogram <- renderChart2({
n2 <- nPlot(Freq ~ Var1, group = 'Var2', data = X, type = 'multiBarChart')
n2$params$width <- 500
n2$params$height <- 400
n2$xAxis(axisLabel = "my x axis label")
n2$yAxis(axisLabel = "my y axis label", width = 50)
n2
})
}
)
)
)
How can I change the marks in the y axis to appear, for example, every 25 instead of every 50 counts?
Thanks a lot!
Use tickValues passed as an option to yAxis
library(rCharts)
library(shiny)
X <- data.frame(Var1 = c(1L, 2L, 3L, 4L, 5L, 6L, 7L,8L, 9L, 10L, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 1L, 2L,3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L),
Var2 = structure(c(1L,1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L), .Label = c("control","treatment1", "treatment2"), class = "factor"),
Freq = c(0L,0L, 3L, 2L, 6L, 9L, 13L, 36L, 50L, 497L, 0L, 2L, 1L, 3L, 6L, 4L, 11L, 29L, 50L, 499L, 1L, 2L, 0L, 2L, 5L, 6L, 12L, 22L, 63L,490L)
)
runApp(
list(ui = fluidPage(
titlePanel("Quiz 3 grades distribution"),
fluidRow(
column(3,
#helpText("Select grade in Quiz 1 before the treatment:"),
selectInput("select", label = h3("Grade Quiz 1 before the treatment:"),
choices = list("All" = 0, "Not Perfect" = 1, "Perfect" = 2),
selected = 0)
),
column(9, div(showOutput("histogram","nvd3")), style = 'align:center;')
,tags$head(tags$style(HTML(".nv-axislabel {font: 22px Arial;}")))
)
),
server = shinyServer(
function(input, output, session) {
output$histogram <- renderChart2({
n2 <- nPlot(Freq ~ Var1, group = 'Var2', data = X, type = 'multiBarChart')
n2$params$width <- 500
n2$params$height <- 400
n2$xAxis(axisLabel = "my x axis label")
n2$yAxis(axisLabel = "my y axis label", width = 50)
n2$yAxis(tickValues = do.call(seq, c(as.list(range(X$Freq)), 25)))
n2
})
}
)
)
)

R shiny app with rCharts

I'm able to create this graph with rCharts:
library(rCharts)
X <- structure(list(Var1 = structure(c(1L, 2L, 3L, 4L, 5L, 6L, 7L,
8L, 9L, 10L, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 1L, 2L,
3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L), .Label = c("1", "2", "3", "4",
"5", "6", "7", "8", "9", "10"), class = "factor"), Var2 = structure(c(1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,
2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L), .Label = c("control",
"treatment1", "treatment2"), class = "factor"), Freq = c(0L,
0L, 3L, 2L, 6L, 9L, 13L, 36L, 50L, 497L, 0L, 2L, 1L, 3L, 6L,
4L, 11L, 29L, 50L, 499L, 1L, 2L, 0L, 2L, 5L, 6L, 12L, 22L, 63L,
490L)), .Names = c("Var1", "Var2", "Freq"), row.names = c(NA,
-30L), class = "data.frame")
n1<-nPlot(Freq ~ Var1, group = 'Var2', data = X, type = 'multiBarChart')
print(n1)
Now I'm trying to embeded in a Shiny app. I can do a shiny app with ggplot2, but I'm not sure how to print the rCharts graph.
This is the shiny code that I have right now:
#server.R
library(rCharts)
X <- structure(list(Var1 = structure(c(1L, 2L, 3L, 4L, 5L, 6L, 7L,
8L, 9L, 10L, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 1L, 2L,
3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L), .Label = c("1", "2", "3", "4",
"5", "6", "7", "8", "9", "10"), class = "factor"), Var2 = structure(c(1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,
2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L), .Label = c("control",
"treatment1", "treatment2"), class = "factor"), Freq = c(0L,
0L, 3L, 2L, 6L, 9L, 13L, 36L, 50L, 497L, 0L, 2L, 1L, 3L, 6L,
4L, 11L, 29L, 50L, 499L, 1L, 2L, 0L, 2L, 5L, 6L, 12L, 22L, 63L,
490L)), .Names = c("Var1", "Var2", "Freq"), row.names = c(NA,
-30L), class = "data.frame")
shinyServer(
function(input, output) {
output$histogram <- renderPlot({
# You can access the value of the widget with input$select, e.g.
output$value <- renderPrint({ input$select })
n2 <- nPlot(Freq ~ Var1, group = 'Var2', data = X, type = 'multiBarChart')
n2$set(dom = "histogram")
return(n2)
})
}
)
#ui.R
shinyUI(fluidPage(
titlePanel("Quiz 3 grades distribution"),
sidebarLayout(
sidebarPanel(
helpText("Quiz 3 grade distribution by treatment group"),
selectInput("select", label = h3("Select box"),
choices = list("All" = 0, "Not Perfect" = 1, "Perfect" = 2),
selected = 0)
),
mainPanel(plotOutput("histogram"))
)
))
What am I doing wrong? Thanks!
Use renderChart2 and showOutput to display nvd3 plots in shiny. Using renderChart2 doesn't require the using $set(dom = ....
library(rCharts)
library(shiny)
X <- data.frame(Var1 = c(1L, 2L, 3L, 4L, 5L, 6L, 7L,8L, 9L, 10L, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 1L, 2L,3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L),
Var2 = structure(c(1L,1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L), .Label = c("control","treatment1", "treatment2"), class = "factor"),
Freq = c(0L,0L, 3L, 2L, 6L, 9L, 13L, 36L, 50L, 497L, 0L, 2L, 1L, 3L, 6L, 4L, 11L, 29L, 50L, 499L, 1L, 2L, 0L, 2L, 5L, 6L, 12L, 22L, 63L,490L)
)
runApp(
list(ui = fluidPage(
titlePanel("Quiz 3 grades distribution"),
sidebarLayout(
sidebarPanel(
helpText("Quiz 3 grade distribution by treatment group"),
selectInput("select", label = h3("Select box"),
choices = list("All" = 0, "Not Perfect" = 1, "Perfect" = 2),
selected = 0)
),
mainPanel(
showOutput("histogram","Nvd3")
)
)
),
server = shinyServer(
function(input, output, session) {
output$histogram <- renderChart2({
n2 <- nPlot(Freq ~ Var1, group = 'Var2', data = X, type = 'multiBarChart')
n2
})
}
)
)
)

Resources