Skip to content

sunburst - child level not showing until click #2439

Open
@dhunt81

Description

@dhunt81

I have a sunburst plot with four levels. I'm finding that when zoomed out the most, showing all levels, the fourth level of two groups are not displaying until I zoom in on that specific group. Clicking on the group shows the children appropriately. The children of one group is displaying correctly however. See the video for a demonstration and a reproducible set of code below.

Recording.2025-05-31.090439.mp4
library("pharmaverseadam")
library("pharmaversesdtm")
library("dplyr")
library("plotly")

#Consenting 
      level_1 <- pharmaverseadam::adsl %>%
        mutate(order=1,level_1 = case_when(
          !is.na(RFICDTC) ~ "Consented",
          is.na(RFICDTC) ~ "Not Consented")
          ) %>%
        select(USUBJID, level_1)
      
      #level 2
      level_2_sf <- pharmaversesdtm::ds %>%
        filter(DSCAT == "DISPOSITION EVENT" & DSDECOD == "SCREEN FAILURE") %>%
        group_by(USUBJID) %>%
        slice_head(n=1) %>%
        ungroup() %>%
        mutate(level_2 = "Screen Failure") %>%
        select(USUBJID, level_2)
      
      level_2_rand <- pharmaversesdtm::ds %>%
        filter(DSCAT == "PROTOCOL MILESTONE" & DSDECOD == "RANDOMIZED") %>%
        group_by(USUBJID) %>%
        slice_head(n=1) %>%
        ungroup() %>%
        mutate(level_2 = "Randomized/Enrolled") %>%
        select(USUBJID, level_2)
      
      level_2 <- rbind(level_2_sf, level_2_rand)
      
      
      #Level 3
      
      level_3_arm <- pharmaverseadam::adsl %>%
        filter(toupper(ARM) != "SCREEN FAILURE") %>%
        mutate(level_3 = ARM) %>%
        select(USUBJID, level_3)
      
      level_3 <- rbind(level_3_arm)
      
      
      #Level 4
      
      level_4_ds <- pharmaversesdtm::ds %>%
     
        filter(DSCAT == "DISPOSITION EVENT" & DSDECOD != "SCREEN FAILURE") %>%
        mutate(level_4 = DSDECOD) %>%
        select(USUBJID, level_4)
                
      level_4 <- bind_rows(level_4_ds)
            
      # FINAL DATA (merge all levels)
      
      levels_all <- full_join(level_1, level_2, by = c("USUBJID") ) %>%
        full_join(level_3, by=c("USUBJID")) %>%
        full_join(level_4, by=c("USUBJID")) %>%
        group_by(level_1, level_2, level_3, level_4) %>%
        summarise(values = n()) %>%
        ungroup()
      
      level1_grps <- unique(levels_all$level_1)
      level2_grps <- unique(levels_all$level_2)
      level3_grps <- unique(levels_all$level_3)
      level4_grps <- unique(levels_all$level_4)
      
      levels_all$ord1 <- sprintf('%02d', match(levels_all$level_1, level1_grps))
      levels_all$ord2 <- sprintf('%02d', match(levels_all$level_2, level2_grps))
      levels_all$ord3 <- sprintf('%02d', match(levels_all$level_3, level3_grps))
      levels_all$ord4 <- sprintf('%02d', match(levels_all$level_4, level4_grps))
      
      levels_all <- levels_all %>%
        mutate(order_by = paste(ord1,ord2,ord3,ord4, sep="."))
      

      level_1_sum <- levels_all %>%
        mutate(id = substr(order_by, 1, 2)  ) %>%
        group_by(level_1, id) %>%
        summarize(n = sum(values) ) %>%
        mutate(parents=NA, labels=level_1, values=n) %>%
        select(parents, labels, values, id) %>%
        ungroup()
      
      level_2_sum <- levels_all %>%
        mutate(id = substr(order_by, 1, 5)  ) %>%
        group_by(level_1, level_2, id) %>%
        summarize(n = sum(values) ) %>%
        mutate(parents=level_1, labels=level_2, values=n) %>%
        select(id, parents, labels, values) %>%
        ungroup()
      
      level_3_sum <- levels_all %>%
        mutate(id = substr(order_by, 1, 8)  ) %>%
        group_by(level_2, level_3, id) %>%
        summarize(n = sum(values) ) %>%
        mutate(parents=level_2, labels=level_3, values=n) %>%
        select(id, parents, labels, values) %>%
        ungroup()
     
      level_4_sum <- levels_all %>%
        mutate(id = substr(order_by, 1, 11)  ) %>%
        group_by(level_3, level_4, id) %>%
        summarize(n = sum(values) ) %>%
        mutate(parents=level_3, labels=level_4, values=n) %>%
        select(id, parents, labels, values) %>%
        ungroup()
           
      levels_all_sum <- bind_rows( level_1_sum, level_2_sum, level_3_sum, level_4_sum) %>%
        filter(!is.na(parents) & !is.na(labels))
 
      plot_ly(data=levels_all_sum, type='sunburst', parents= ~parents, labels= ~labels, values= ~values, branchvalues = 'total')

Metadata

Metadata

Assignees

No one assigned

    Labels

    No labels
    No labels

    Type

    No type

    Projects

    No projects

    Milestone

    No milestone

    Relationships

    None yet

    Development

    No branches or pull requests

    Issue actions