CODEWITHSUNDEEP
rggplot2ggplotly
goingdeep
goingdeep

Reputation: 121

ggplotly dropdown menu incorrect plotting with fill aestetics

This question is kind of a follow-up to this one:

ggplotly dropdown menu default graph incorrect

I am opening a new one as it seems the more correct thing to do.

I need to perform a modification to my previous plotly object, by adding a fill aestetics, that will only affect 1 plot/group/Indicator out of the 8, with this desired output:

desired output

So this is the new data frame:

    structure(list(Indicator = 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, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 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, 4L, 4L, 4L, 4L, 4L, 
4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 5L, 5L, 5L, 5L, 
5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 
5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 
5L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 
6L, 6L, 6L, 6L, 6L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 
7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 
7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 8L, 8L, 8L, 8L, 8L, 8L, 8L, 8L, 
8L, 8L, 8L, 8L, 8L, 8L, 8L, 8L, 8L, 8L, 8L, 8L, 8L, 8L, 8L, 8L, 
8L, 8L, 8L, 8L, 8L, 8L, 8L, 8L, 8L, 8L), levels = c("Criminalisation of torture under domestic law", 
"Designation of the National Preventive Mechanism (in law)", 
"Existence of National Human Rights Institution that fully complies with Paris Principles", 
"Operationality of the National Preventive Mechanism", "Prohibition of torture in the constitution", 
"Ratification of Optional Protocol (OPCAT)", "Ratification of the UN Convention against Torture", 
"Submission of initial report to CAT"), class = "factor"), Input = c("Partially", 
"Partially", "Partially", "Partially", "Partially", "Partially", 
"Partially", "Partially", "Partially", "Partially", "Partially", 
"Partially", "Partially", "Partially", "Partially", "Partially", 
"Partially", "Partially", "Partially", "Partially", "Partially", 
"Partially", "Partially", "Partially", "Partially", "Partially", 
"Partially", "Partially", "Partially", "Partially", "Partially", 
"Partially", "Partially", "Partially", "Yes", "Yes", "Yes", "Yes", 
"Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", 
"Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", 
"Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", 
"Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", 
"Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", 
"Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", 
"Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", 
"Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", 
"Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", 
"Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", 
"Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", 
"Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", 
"Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", 
"Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", 
"Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", 
"Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", 
"Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", 
"Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", 
"Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", 
"Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", 
"Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", 
"Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", 
"Yes", "Yes", "Yes", "Yes"), Year = c(1984, 1986, 1987, 1990, 
1991, 1992, 1993, 1995, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 
2004, 2005, 2006, 2007, 2008, 2009, 2011, 2012, 2013, 2014, 2015, 
2016, 2017, 2018, 2019, 2020, 2021, 2023, 2024, 1984, 1985, 1987, 
1989, 1996, 1997, 2002, 2006, 2007, 2009, 2010, 2011, 2012, 2013, 
2014, 2015, 2017, 2018, 2020, 2022, 2005, 2006, 2007, 2008, 2009, 
2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 
2021, 2024, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 
2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 
2019, 2020, 2021, 2022, 2024, 2006, 2007, 2008, 2009, 2010, 2011, 
2012, 2013, 2014, 2016, 2017, 2018, 2019, 2020, 2021, 2022, 2024, 
1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993, 1994, 1995, 
1996, 1997, 1998, 1999, 2000, 2002, 2003, 2004, 2005, 2006, 2007, 
2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 
2019, 2020, 2022, 2023, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 
2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2021, 
2023, 2024, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 
1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 
2006, 2007, 2008, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 
2018, 2019, 2020, 2021, 1988, 1989, 1990, 1992, 1993, 1994, 1995, 
1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 
2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 
2018, 2019, 2022, 2023, 2024), number = c(8L, 2L, 1L, 1L, 1L, 
1L, 2L, 2L, 2L, 4L, 3L, 1L, 2L, 1L, 2L, 2L, 5L, 5L, 1L, 7L, 5L, 
1L, 3L, 4L, 2L, 2L, 1L, 5L, 6L, 6L, 3L, 5L, 3L, 1L, 2L, 1L, 1L, 
1L, 1L, 2L, 1L, 1L, 1L, 3L, 2L, 1L, 1L, 1L, 2L, 2L, 1L, 1L, 1L, 
2L, 2L, 1L, 9L, 3L, 9L, 4L, 6L, 7L, 7L, 5L, 3L, 2L, 5L, 7L, 2L, 
1L, 2L, 3L, 16L, 7L, 6L, 2L, 4L, 2L, 2L, 4L, 3L, 2L, 2L, 2L, 
3L, 1L, 1L, 2L, 2L, 3L, 3L, 2L, 2L, 5L, 3L, 5L, 2L, 1L, 3L, 5L, 
7L, 4L, 4L, 9L, 3L, 7L, 6L, 2L, 7L, 5L, 1L, 1L, 1L, 1L, 21L, 
1L, 3L, 6L, 1L, 3L, 10L, 9L, 5L, 5L, 8L, 8L, 2L, 2L, 4L, 1L, 
2L, 5L, 3L, 3L, 1L, 2L, 6L, 1L, 6L, 7L, 5L, 4L, 2L, 4L, 5L, 3L, 
4L, 2L, 1L, 1L, 1L, 3L, 3L, 11L, 14L, 3L, 8L, 7L, 7L, 5L, 4L, 
5L, 6L, 4L, 3L, 4L, 1L, 2L, 1L, 2L, 1L, 14L, 13L, 10L, 10L, 7L, 
8L, 7L, 8L, 7L, 7L, 8L, 3L, 6L, 7L, 4L, 6L, 5L, 2L, 5L, 2L, 3L, 
1L, 2L, 1L, 2L, 4L, 1L, 2L, 2L, 2L, 2L, 3L, 3L, 2L, 2L, 1L, 5L, 
2L, 12L, 11L, 6L, 3L, 13L, 3L, 8L, 7L, 6L, 7L, 4L, 1L, 3L, 7L, 
1L, 2L, 3L, 3L, 3L, 4L, 3L, 3L, 3L, 1L, 2L, 3L, 3L, 3L, 1L, 1L, 
1L), `Number of States` = c(8L, 10L, 11L, 12L, 13L, 14L, 16L, 
18L, 20L, 24L, 27L, 28L, 30L, 31L, 33L, 35L, 40L, 45L, 46L, 53L, 
58L, 59L, 62L, 66L, 68L, 70L, 71L, 76L, 82L, 88L, 91L, 96L, 99L, 
100L, 2L, 3L, 4L, 5L, 6L, 8L, 9L, 10L, 11L, 14L, 16L, 17L, 18L, 
19L, 21L, 23L, 24L, 25L, 26L, 28L, 2L, 3L, 12L, 15L, 24L, 28L, 
34L, 41L, 48L, 53L, 56L, 58L, 63L, 70L, 72L, 73L, 75L, 78L, 16L, 
23L, 29L, 31L, 35L, 37L, 39L, 43L, 46L, 48L, 50L, 52L, 55L, 56L, 
57L, 59L, 61L, 64L, 67L, 69L, 71L, 76L, 79L, 84L, 86L, 1L, 4L, 
9L, 16L, 20L, 24L, 33L, 36L, 43L, 49L, 51L, 58L, 63L, 64L, 65L, 
66L, 67L, 21L, 22L, 25L, 31L, 32L, 35L, 45L, 54L, 59L, 64L, 72L, 
80L, 82L, 84L, 88L, 89L, 91L, 96L, 99L, 102L, 103L, 105L, 111L, 
112L, 118L, 125L, 130L, 134L, 136L, 140L, 145L, 148L, 152L, 154L, 
155L, 156L, 157L, 3L, 6L, 17L, 31L, 34L, 42L, 49L, 56L, 61L, 
65L, 70L, 76L, 80L, 83L, 87L, 88L, 90L, 91L, 93L, 94L, 14L, 27L, 
37L, 47L, 54L, 62L, 69L, 77L, 84L, 91L, 99L, 102L, 108L, 115L, 
119L, 125L, 130L, 132L, 137L, 139L, 142L, 143L, 145L, 146L, 148L, 
152L, 153L, 155L, 157L, 159L, 161L, 164L, 167L, 169L, 171L, 1L, 
6L, 8L, 20L, 31L, 37L, 40L, 53L, 56L, 64L, 71L, 77L, 84L, 88L, 
89L, 92L, 99L, 100L, 102L, 105L, 108L, 111L, 115L, 118L, 121L, 
124L, 125L, 127L, 130L, 133L, 136L, 137L, 138L, 139L)), class = c("tbl_df", 
"tbl", "data.frame"), row.names = c(NA, -240L))

If I apply the fixer function

    fixer <- function(plt) {
  plt <- plotly_build(plt)            # ensure build is complete
  vis <- c(F, F, F, F, T, F, F, F)    # from `Prohibition...`
  lapply(1:length(plt$x$data), \(j) { # hide all but first data set
    plt$x$data[[j]]$visible <<- vis[[j]]
  })
  plt     # return updated plot
}

@Kat kindly provided in the previous answer to my new plot

    library(dplyr)
library(ggplot2)
library(plotly)
    cbbPalette <- c("Partially" = "#F1B5B5", 
                "Yes" = "#E36360")
plot_dropdown <- ggplot(plot_df, aes(Year, `Number of States`)) +
  lapply(levels(plot_df$Indicator), \(x) {
    list(geom_col(data = ~ subset(.x, Indicator == x), mapping = aes(fill = Input)))
         }) +
  scale_fill_manual(values = cbbPalette, name = "Compliant?") +
  labs(x = NULL,
       y = NULL) +
  theme_classic() +
  theme(panel.background = element_rect(fill = "#C5DAF8"),
        plot.background = element_rect(fill = "#C5DAF8"),
        legend.position = c(.15,.85),
        legend.background = element_blank())
ggplotly(plot_dropdown) %>%
  layout(showlegend = F,
         updatemenus = list(
           list(xanchor = "left",
                y = 1.1,
                active = 4,
                buttons = list(list(method = "restyle",
                                    args = list("visible", c(T, F, F, F, F, F, F, F)),
                                    label = "Criminalisation of torture under domestic law"),
                               list(method = "restyle",
                                    args = list("visible", c(F, T, F, F, F, F, F, F)),
                                    label = "Designation of the National Preventive Mechanism (in law)"),
                               list(method = "restyle",
                                    args = list("visible", c(F, F, T, F, F, F, F, F)),
                                    label = "Existence of National Human Rights Institution that fully complies with Paris Principles"),
                               list(method = "restyle",
                                    args = list("visible", c(F, F, F, T, F, F, F, F)),
                                    label = "Operationality of the National Preventive Mechanism"),
                               list(method = "restyle",
                                    args = list("visible", c(F, F, F, F, T, F, F, F)),
                                    label = "Prohibition of torture in the constitution"),
                               list(method = "restyle",
                                    args = list("visible", c(F, F, F, F, F, T, F, F)),
                                    label = "Ratification of Optional Protocol (OPCAT)"),
                               list(method = "restyle",
                                    args = list("visible", c(F, F, F, F, F, F, T, F)),
                                    label = "Ratification of the UN Convention against Torture"),
                               list(method = "restyle",
                                    args = list("visible", c(F, F, F, F, F, F, F, T)),
                                    label = "Submission of initial report to CAT"))))) %>%
  config(displayModeBar = FALSE) %>%
  fixer()

I receive this message:

Error in vis[[j]] : subscript out of bounds

and in fact now plt$x$data has 9 elements, not 8 anymore, meaning 1 more plot. This confuses me as the new element represents the new "Partially" fill aestetics. I tried to fix the error by adding a new F to the vis vector in the fixer() function, both before the T and at the end. That returns a graph, but of course it is not correct, besides missing the inside legend (but maybe this is just a plotly problem):

wrong_fill

Upvotes: 1

Views: 40

Answers (0)

Related Questions