plotly R graph - символ маркера не отображается в легенде, если не добавлена ​​трассировка сегмента - PullRequest
Новая
       9

plotly R graph - символ маркера не отображается в легенде, если не добавлена ​​трассировка сегмента

0 голосов
/ 10 февраля 2020

У меня есть график с указанием следующего: - линейный график, на котором цензурированные значения отображаются в виде открытых кружков, а точки набора данных без цензуры равны solid. - на некоторых графиках будет показана линия тренда (добавлена ​​с использованием add_segment)

Не получается, чтобы легенда маркера отображалась, когда линия тренда не добавлена.

В идеале мне бы хотелось, чтобы в легенде отображались только «цензурированные точки данных», поэтому я добавил две трассировки для маркеров (1 для цензуры с showlegend = TRUE, а другой с showlegend = FALSE). Не уверен, есть ли другой способ сделать это - очень новый для plot_ly. 

# datasets
results <- structure(list(slope = 0, slope_p_val = 0.672652383888971, int_from_data = 0.06, 
    pct_cens = 9.3, annual_slope_units = 0, sigclass = "No evidence of trend", 
    sig = structure(2L, .Label = c("Significant", "Not significant"
    ), class = "factor"), slope_text = " ", trend_color = "#CBCBCB"), class = "data.frame", row.names = c(NA, 
-1L))

dataset <- dput(dataset)
structure(list(Date = structure(c(12794, 12823, 12863, 12893, 
12921, 12948, 12978, 13003, 13048, 13073, 13108, 13137, 13172, 
13199, 13230, 13263, 13291, 13318, 13349, 13375, 13405, 13432, 
13472, 13486, 13523, 13564, 13592, 13622, 13648, 13683, 13705, 
13746, 13775, 13810, 13838, 13852, 13929, 13957, 13986, 14014, 
14053, 14067, 14110, 14139, 14166, 14196, 14224, 14266, 14294, 
14321, 14348, 14377, 14405, 14446, 14476, 14501, 14532, 14566, 
14593, 14636, 14684, 14712, 14740, 14770, 14811, 14839, 14868, 
14896, 14929, 14952, 14993, 15020, 15050, 15077, 15105, 15146, 
15174, 15208, 15238, 15265, 15293, 15315, 15350, 15385, 15412, 
15441, 15482, 15511, 15537, 15566, 15600, 15631, 15658, 15685, 
15728, 15742, 15769, 15811, 15839, 15868, 15904, 15931, 15958, 
16001, 16030, 16042, 16091, 16119, 16149, 16174, 16204, 16230, 
16268, 16302, 16330, 16359, 16386, 16412), class = "Date"), cenTF = c(FALSE, 
FALSE, TRUE, FALSE, FALSE, FALSE, FALSE, TRUE, TRUE, FALSE, FALSE, 
FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, TRUE, 
FALSE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, 
FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, 
FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, 
FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, 
FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, 
FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, 
FALSE, FALSE, FALSE, TRUE, FALSE, TRUE, FALSE, FALSE, FALSE, 
FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, 
TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, 
TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, 
FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE), Value = c(0.05, 
0.06, 0.025, 0.08, 0.06, 0.07, 0.05, 0.025, 0.025, 0.1, 0.12, 
0.18, 0.14, 0.19, 0.36, 0.17, 0.09, 0.07, 0.05, 0.025, 0.05, 
0.025, 0.08, 0.05, 0.06, 0.06, 0.06, 0.05, 0.07, 0.06, 0.05, 
0.07, 0.06, 0.05, 0.05, 0.06, 0.05, 0.07, 0.1, 0.09, 0.025, 0.07, 
0.07, 0.14, 0.17, 0.11, 0.1, 0.14, 0.17, 0.17, 0.18, 0.09, 0.08, 
0.08, 0.1, 0.07, 0.07, 0.06, 0.025, 0.09, 0.07, 0.08, 0.06, 0.06, 
0.06, 0.08, 0.06, 0.06, 0.05, 0.05, 0.06, 0.06, 0.11, 0.1, 0.1, 
0.05, 0.06, 0.025, 0.06, 0.025, 0.06, 0.06, 0.07, 0.06, 0.05, 
0.07, 0.05, 0.06, 0.05, 0.05, 0.06, 0.06, 0.025, 0.05, 0.06, 
0.06, 0.06, 0.23, 0.06, 0.06, 0.06, 0.025, 0.05, 0.05, 0.1, 0.06, 
0.06, 0.06, 0.07, 0.08, 0.06, 0.07, 0.06, 0.05, 0.07, 0.06, 0.06, 
0.06)), row.names = c(NA, -118L), class = "data.frame")


plotly_1 <- function(dataset, results, 
                      cen_var="cenTF", val_var="Value", 
                      date_period =NULL  
                      ){


  dataset <- dataset %>%
   mutate(cenNM = case_when(!!ensym(cen_var) := FALSE ~ " ",
                            !!ensym(cen_var) := TRUE ~ "Value too low to detect"), 
          plotVal = !!ensym(val_var), 
          plotCen = !!ensym(cen_var), 
          pct_cens = round(sum(.data$plotCen, na.rm=TRUE)/sum(!is.na(.data$Value))*100, 1))

  #PLOTTING PARAMETERS
  legendFont <-  list(
    family = "sans-serif",
    size = 14,
    color = "#000")

  #font for axis
  axisFont <- list(
    family = "sans-serif",
    size = 17,
    color = "#000")

  #calculate trend line limits - confirm same fopr decdate as date...
  min_x <- date_period[1]
  max_x <- date_period[2]+1
  min_y <- results$slope *min_x + results$int_from_data  
  max_y <- results$slope*max_x + results$int_from_data

  #CREATE PLOT
  p <- plot_ly(dataset, x = ~Date, y = ~plotVal,
               color=I("#3182BD"),
               type='scatter',
               mode='lines', 
               showlegend=FALSE, 
               hoverinfo="none"
               ) %>%
    add_markers(data=dataset %>% filter(plotCen == FALSE),
                x = ~Date,y = ~plotVal, 
                      color=I("#3182BD"),
                symbol=I("circle"),
                size=1, 
                showlegend=FALSE, 
                hoverinfo="text", 
                text= ~paste("Value:",plotVal,"<br>Date:",Date,"<br>Censored:",plotCen)
                ) %>%
    add_markers(data=dataset %>% filter(plotCen == TRUE), 
               x = ~Date,y = ~plotVal, 
               size = 1,
               symbol = I("circle-open"),
               color=I("#3182BD"),
               showlegend=TRUE, 
               name="Value too low to detect",
               hoverinfo="text", 
               text=~paste("Value:",plotVal,"<br>Date:",Date,"<br>Censored:",plotCen)
              )

  #add trend line for significant trends only...
  if(!any(results$slope_pval > alpha,results$slope == 0)){
    p <- p %>% 
      add_segments(data=results,
                   x=min_x , xend=max_x, y=min_y , yend=max_y, 
                   color="#FCBA19",
                   name="Long-term trend", 
                   showlegend=TRUE, 
                   inherit=TRUE)
  }

  return(p)

}
tmp <- plotly_1(dataset, results, date_period = c(2005,2014))
#glimpse(tmp)

tmp

Выше не показаны маркеры в легенде, но если я закомментирую if ( ! any (результаты $ slope_pval> alpha, результаты $ slope == 0)) оператор, цензурированный маркер действительно отображается в легенде (по желанию)

1 Ответ

0 голосов
/ 13 февраля 2020

Проблема в том, что вы устанавливаете showlegend = FALSE в вызове plot_ly, что оказывает глобальное влияние на график. Если вы добавите еще add_lines вместо передачи данных для трассировки линии непосредственно в plot_ly, вы получите желаемый результат: 

library(plotly)
library(dplyr)

# datasets
alpha <- 0.6 # not defined  in question

results <- structure(list(slope = 0, slope_p_val = 0.672652383888971, int_from_data = 0.06, 
                          pct_cens = 9.3, annual_slope_units = 0, sigclass = "No evidence of trend", 
                          sig = structure(2L, .Label = c("Significant", "Not significant"
                          ), class = "factor"), slope_text = " ", trend_color = "#CBCBCB"), class = "data.frame", row.names = c(NA, -1L))

dataset <- structure(list(Date = structure(c(12794, 12823, 12863, 12893, 
                                             12921, 12948, 12978, 13003, 13048, 13073, 13108, 13137, 13172, 
                                             13199, 13230, 13263, 13291, 13318, 13349, 13375, 13405, 13432, 
                                             13472, 13486, 13523, 13564, 13592, 13622, 13648, 13683, 13705, 
                                             13746, 13775, 13810, 13838, 13852, 13929, 13957, 13986, 14014, 
                                             14053, 14067, 14110, 14139, 14166, 14196, 14224, 14266, 14294, 
                                             14321, 14348, 14377, 14405, 14446, 14476, 14501, 14532, 14566, 
                                             14593, 14636, 14684, 14712, 14740, 14770, 14811, 14839, 14868, 
                                             14896, 14929, 14952, 14993, 15020, 15050, 15077, 15105, 15146, 
                                             15174, 15208, 15238, 15265, 15293, 15315, 15350, 15385, 15412, 
                                             15441, 15482, 15511, 15537, 15566, 15600, 15631, 15658, 15685, 
                                             15728, 15742, 15769, 15811, 15839, 15868, 15904, 15931, 15958, 
                                             16001, 16030, 16042, 16091, 16119, 16149, 16174, 16204, 16230, 
                                             16268, 16302, 16330, 16359, 16386, 16412), class = "Date"), 
                          cenTF = c(FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, FALSE, TRUE, TRUE, FALSE, FALSE, 
                                    FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, TRUE, 
                                    FALSE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, 
                                    FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, 
                                    FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, 
                                    FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, 
                                    FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, 
                                    FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, 
                                    FALSE, FALSE, FALSE, TRUE, FALSE, TRUE, FALSE, FALSE, FALSE, 
                                    FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, 
                                    TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, 
                                    TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, 
                                    FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE), 
                          Value = c(0.05,                                                                                                      0.06, 0.025, 0.08, 0.06, 0.07, 0.05, 0.025, 0.025, 0.1, 0.12, 
                                                                                                       0.18, 0.14, 0.19, 0.36, 0.17, 0.09, 0.07, 0.05, 0.025, 0.05, 
                                                                                                       0.025, 0.08, 0.05, 0.06, 0.06, 0.06, 0.05, 0.07, 0.06, 0.05, 
                                                                                                       0.07, 0.06, 0.05, 0.05, 0.06, 0.05, 0.07, 0.1, 0.09, 0.025, 0.07, 
                                                                                                       0.07, 0.14, 0.17, 0.11, 0.1, 0.14, 0.17, 0.17, 0.18, 0.09, 0.08, 
                                                                                                       0.08, 0.1, 0.07, 0.07, 0.06, 0.025, 0.09, 0.07, 0.08, 0.06, 0.06, 
                                                                                                       0.06, 0.08, 0.06, 0.06, 0.05, 0.05, 0.06, 0.06, 0.11, 0.1, 0.1, 
                                                                                                       0.05, 0.06, 0.025, 0.06, 0.025, 0.06, 0.06, 0.07, 0.06, 0.05, 
                                                                                                       0.07, 0.05, 0.06, 0.05, 0.05, 0.06, 0.06, 0.025, 0.05, 0.06, 
                                                                                                       0.06, 0.06, 0.23, 0.06, 0.06, 0.06, 0.025, 0.05, 0.05, 0.1, 0.06, 
                                                                                                       0.06, 0.06, 0.07, 0.08, 0.06, 0.07, 0.06, 0.05, 0.07, 0.06, 0.06, 
                                                                                                       0.06)), row.names = c(NA, -118L), class = "data.frame")
plotly_1 <- function(dataset,
                     results,
                     cen_var = "cenTF",
                     val_var = "Value",
                     date_period = NULL) {
  dataset <- dataset %>%
    mutate(
      cenNM = case_when(
        !!ensym(cen_var) := FALSE ~ " ",!!ensym(cen_var) := TRUE ~ "Value too low to detect"
      ),
      plotVal = !!ensym(val_var),
      plotCen = !!ensym(cen_var),
      pct_cens = round(sum(.data$plotCen, na.rm = TRUE) / sum(!is.na(.data$Value)) *
                         100, 1)
    )

  #PLOTTING PARAMETERS
  legendFont <-  list(family = "sans-serif",
                      size = 14,
                      color = "#000")

  #font for axis
  axisFont <- list(family = "sans-serif",
                   size = 17,
                   color = "#000")

  #calculate trend line limits - confirm same fopr decdate as date...
  min_x <- date_period[1]
  max_x <- date_period[2] + 1
  min_y <- results$slope * min_x + results$int_from_data
  max_y <- results$slope * max_x + results$int_from_data

  #CREATE PLOT
  p <- plot_ly(dataset,
               type = 'scatter',
               mode = 'lines',
               hoverinfo = "none") %>%
    add_lines(
      x = ~ Date,
      y = ~ plotVal,
      color = I("#3182BD"),
      showlegend = FALSE
    ) %>%
    add_markers(
      data = dataset %>% filter(plotCen == FALSE),
      x = ~ Date,
      y = ~ plotVal,
      color = I("#3182BD"),
      symbol = I("circle"),
      size = 1,
      showlegend = FALSE,
      hoverinfo = "text",
      text = ~ paste(
        "Value:",
        plotVal,
        "<br>Date:",
        Date,
        "<br>Censored:",
        plotCen
      )
    ) %>%
    add_markers(
      data = dataset %>% filter(plotCen == TRUE),
      x = ~ Date,
      y = ~ plotVal,
      size = 1,
      symbol = I("circle-open"),
      color = I("#3182BD"),
      showlegend = TRUE,
      name = "Value too low to detect",
      hoverinfo = "text",
      text =  ~ paste(
        "Value:",
        plotVal,
        "<br>Date:",
        Date,
        "<br>Censored:",
        plotCen
      )
    )

  # add trend line for significant trends only...
  if (!any(results$slope_p_val > alpha, results$slope == 0)) {
    p <- p %>%
      add_segments(
        data = results,
        x = min_x ,
        xend = max_x,
        y = min_y ,
        yend = max_y,
        color = "#FCBA19",
        name = "Long-term trend",
        showlegend = TRUE,
        inherit = TRUE
      )
  }

  return(p)

}
tmp <- plotly_1(dataset, results, date_period = c(2005, 2014))
#glimpse(tmp)

tmp

Result

Еще два комментария: добавлено alpha <- 0.6, поскольку оно не было определено. Изменено if(!any(results$slope_pval > alpha,results$slope == 0)){ на results$slope_p_val

...