Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

multiple drop downs using e_morph #570

Closed
oobd opened this issue Sep 15, 2023 · 1 comment
Closed

multiple drop downs using e_morph #570

oobd opened this issue Sep 15, 2023 · 1 comment
Assignees
Labels
bug Something isn't working

Comments

@oobd
Copy link

oobd commented Sep 15, 2023

I'm trying to get multiple dropdowns to work using e_morph but am noticing some behaviour that I can't figure out

Namely:

  1. when I click the top drop down so it becomes the value 2, the graph defaults to what I've set it to be for top drop down = 2 and bottom drop down = 3 and only fixes itself when I play around with the bottom drop down.
  2. when i set top to be 2 and bottom to be 3 then change the top to be 1, the drop downs break

reprex below, anyone got any ideas / tips?
i don't fully understand the javascript in the cb part so guessing that's where the issue is but can't figure it out on my own

library(echarts4r)
library(tidyverse)
library(htmlwidgets)
library(htmltools)
df <- Titanic
mtcars2 <- mtcars %>%
  #head() %>%
  tibble::rownames_to_column("model")
max <- list(
  name = "Max",
  type = "max"
)
min <- list(
  name = "Min",
  type = "min"
)
 
e1 <- mtcars2 %>% slice(1:2) %>%
  e_charts(model) %>%
  e_title("Pie chart alert!\n\nThese are 'qsec' scores of two cars\nBut okay, two categories... We will keep the pie...\n\nBut what if we add a car?\nIs the pie still readable...?", top = 40) %>%
  e_grid(top = 100) %>%
  e_legend(right = 10) %>%
   e_pie(
    qsec,
    universalTransition = TRUE,
    animationDurationUpdate = 1000L
  )
 
e2 <- mtcars2 %>% slice(1:3) %>%
  e_charts(model) %>%
  e_title("Well I don't think so.\n\nI guess it all gets even worse if we add another car", top = 40) %>%
  e_grid(top = 100) %>%
  e_legend(right = 10) %>%
   e_pie(
    qsec,
    universalTransition = TRUE,
    animationDurationUpdate = 1000L
  )
 
e3 <- mtcars2 %>% slice(1:4) %>%
  e_charts(model) %>%
  e_title("Yes... here you go :(.\n\nFor most people the pie fails to be easy to read.\n\nLet's turn it into a rose. Is that better?", top = 40) %>%
  e_grid(top = 100) %>%
  e_legend(right = 10) %>%
   e_pie(
    qsec,
    universalTransition = TRUE,
    animationDurationUpdate = 1000L
  )
 
 
 
 
cb <- "() => {
  let x = 0;
  let elements = document.getElementsByClassName('echarts-input');
  Array.from(elements).forEach(function(element) {
    element.addEventListener('change', (e) => {
      // Check both dropdown values before updating the chart
      let dropdown1Value = document.getElementById('echarts-select').value;
      let dropdown2Value = document.getElementById('echarts-select2').value;
 
     
      // Update the main chart based on dropdown1Value
      if (dropdown1Value === '1' & dropdown2Value == '1') {
        chart.setOption(opts[e.target.value - 1], true);
      }      
 
      if (dropdown1Value === '1' & dropdown2Value == '2') {
        chart.setOption(opts[e.target.value], true);
      }      
            
            
      if (dropdown1Value === '1' & dropdown2Value == '3') {
        chart.setOption(opts[e.target.value - 2], true);
      }      
                  
      
      if (dropdown1Value === '2' & dropdown2Value == '1') {
        chart.setOption(opts[e.target.value - 1], true);
      }
      if (dropdown1Value === '2' & dropdown2Value == '2') {
        chart.setOption(opts[e.target.value], true);
      }      
      if (dropdown1Value === '2' & dropdown2Value == '3') {
        chart.setOption(opts[e.target.value - 2], true);
      }         
 
 
     
    });
  });
}"
 
 
 
 
e_morph(e1, e2, e3, callback = cb) %>%
  htmlwidgets::prependContent(
    div(
      tags$select(
        id = "echarts-select",
        class = "form-select echarts-input",
        tags$option(value = "1", "1"),
        tags$option(value = "2", "2")))) %>%
  htmlwidgets::prependContent(div(tags$select(
  id = "echarts-select2",  # Give it a unique ID
  class = "form-select echarts-input",
  tags$option(value = "1", "1"),
  tags$option(value = "2", "2"),
  tags$option(value = "3", "3")  # Add an option for "test2"
)
))
 
 
 
@munoztd0 munoztd0 self-assigned this Oct 2, 2023
@munoztd0 munoztd0 added the bug Something isn't working label Oct 2, 2023
@oobd
Copy link
Author

oobd commented Oct 21, 2023

I think this works 😃
Now just need some table package that works similarly / looks good

library(echarts4r)
library(tidyverse)
library(htmlwidgets)
library(htmltools)



df <- data.frame(
  x = seq(50),
  y = rnorm(50, 10, 3),
  z = rnorm(50, 11, 2),
  w = rnorm(50, 9, 2)
)


e1  <- df |> 
  e_charts(x) |> 
  e_line(z) |> 
  e_area(w) |> 
  e_title("1-1")

 
e2  <- df |> 
  e_charts(x) |> 
  e_bar(y, name = "Serie 1") |> 
  e_step(z, name = "Serie 2") |> 
  e_title("1-2")

e3  <- df |> 
  e_charts(x) |> 
  e_scatter(y, z) |> 
  e_visual_map(z, scale = e_scale) |> # scale color
  e_legend(FALSE) |>
  e_title("1-3")

e4  <- df |> 
  e_charts(x) |> 
  e_polar() |> 
  e_angle_axis(x) |> # angle = x
  e_radius_axis() |> 
  e_bar(y, coord_system = "polar") |> 
  e_scatter(z, coord_system = "polar") %>% 
  e_title("2-1")


funnel <- data.frame(stage = c("View", "Click", "Purchase"), value = c(80, 30, 20))

e5 <- funnel |> 
  e_charts() |> 
  e_funnel(value, stage) |> 
  e_title("2-2")


e6  <- iris |> 
  group_by(Species) |> 
  e_charts(Sepal.Length) |> 
  e_line(Sepal.Width) |> 
  e_title("2-3")

 
cb <- "() => {
  let x = 0;
  let elements = document.getElementsByClassName('echarts-input');
  Array.from(elements).forEach(function(element) {
    element.addEventListener('change', (e) => {
      // Check both dropdown values before updating the chart
      let dropdown1Value = document.getElementById('echarts-select').value;
      let dropdown2Value = document.getElementById('echarts-select2').value;

      // Define the chart option to set
      let chartOption = null;

      if (dropdown1Value === '1' && dropdown2Value === '1') {
        chartOption = opts[0]; // Display e1
      } else if (dropdown1Value === '1' && dropdown2Value === '2') {
        chartOption = opts[1]; // Display e2
      } else if (dropdown1Value === '1' && dropdown2Value === '3') {
        chartOption = opts[2]; // Display e3
      } else if (dropdown1Value === '2' && dropdown2Value === '1') {
        chartOption = opts[3]; // Display e4
      } else if (dropdown1Value === '2' && dropdown2Value === '2') {
        chartOption = opts[4]; // Display e5
      } else if (dropdown1Value === '2' && dropdown2Value === '3') {
        chartOption = opts[5]; // Display e6
      }

      // Update the chart option if defined
      if (chartOption !== null) {
        chart.setOption(chartOption, true);
      }
    });
  });
}"

# Create a container div for both select elements with a gap
dropdown_container <- div(
  tags$select(
    id = "echarts-select",
    class = "form-select echarts-input",
    style = "width: 150px;", # Increase the width here
    tags$option(value = "1", "1"),
    tags$option(value = "2", "2")
  ),
  div(style = "width: 30px;"), # Add a 10px gap between the dropdowns
  tags$select(
    id = "echarts-select2",
    class = "form-select echarts-input",
    style = "width: 150px;", # Increase the width here
    tags$option(value = "1", "1"),
    tags$option(value = "2", "2"),
    tags$option(value = "3", "3")
  ),
  style = "display: flex; flex-direction: row;" # Use flexbox to position elements horizontally
)

e_morph(e1, e2, e3, e4, e5, e6, callback = cb) %>%
  htmlwidgets::prependContent(dropdown_container)

# setup charts for second overall chart area
liquid <- data.frame(val = c(0.6, 0.5, 0.4))

e1 <- liquid |> 
  e_charts() |> 
  e_liquid(val) %>% 
  e_title('1-1')


dates <- seq.Date(Sys.Date() - 30, Sys.Date(), by = "day")

river <- data.frame(
  dates = dates,
  apples = runif(length(dates)),
  bananas = runif(length(dates)),
  pears = runif(length(dates))
)

e2 <- river |> 
  e_charts(dates) |> 
  e_river(apples) |> 
  e_river(bananas) |> 
  e_river(pears) |> 
  e_tooltip(trigger = "axis") |> 
  e_title("1-2")


dates <- seq.Date(as.Date("2017-01-01"), as.Date("2018-12-31"), by = "day")
values <- rnorm(length(dates), 20, 6)

year <- data.frame(date = dates, values = values)

e3 <- year |> 
  e_charts(date) |> 
  e_calendar(range = "2018") |> 
  e_heatmap(values, coord_system = "calendar") |> 
  e_visual_map(max = 30) |> 
  e_title("1-3")

e4 <- e_charts() |> 
  e_gauge(41, "PERCENT") |> 
  e_title("2-1")

df <- data.frame(
  parents = c("","earth", "earth", "mars", "mars", "land", "land", "ocean", "ocean", "fish", "fish", "Everything", "Everything", "Everything"),
  labels = c("Everything", "land", "ocean", "valley", "crater", "forest", "river", "kelp", "fish", "shark", "tuna", "venus","earth", "mars"),
  value = c(0, 30, 40, 10, 10, 20, 10, 20, 20, 8, 12, 10, 70, 20)
)

# create a tree object
universe <- data.tree::FromDataFrameNetwork(df)

# use it in echarts4r
e5 <- universe |> 
  e_charts() |> 
  e_sunburst() %>% 
  e_title('2-2')



e6 <- mtcars |> 
  head() |> 
  tibble::rownames_to_column("model") |> 
  e_charts(model) |> 
  e_pie(carb, radius = c("50%", "70%")) |> 
  e_title("2-3")



e_morph(e1, e2, e3, e4, e5, e6, callback = cb) 

@oobd oobd closed this as completed Oct 23, 2023
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
bug Something isn't working
Projects
None yet
Development

No branches or pull requests

2 participants