Как я могу привести легенду ggvis в соответствие с графиком?

Question

Я создал функцию, которая использует ggvis для графического отображения некоторых данных, которые мы регулярно просматриваем. В этом окончательная группа «В целом» перезаписывается, чтобы показать черную линию с шириной 3 вместо значения по умолчанию. К сожалению, шаги, которые я предпринял для переопределения значения по умолчанию, не отображаются в легенде. Я не уверен, что делать, чтобы сделать эту работу. Я попытался специально вызвать add_legend, но это не сработало.

Код, используемый для создания этого (также с некоторыми случайными данными):

CAL_DATE = seq(as.Date("10/1/2015", format = "%m/%d/%Y"), 
       as.Date("3/31/2016", format = "%m/%d/%Y"), by = 1) 
CAL_DATE = as.POSIXct(CAL_DATE) 
a = data.frame(cbind(ma_AHT = round(rweibull(length(CAL_DATE), 
             5, 500),0), CT_DS = rep("A",length(CAL_DATE)))) 
b = data.frame(cbind(ma_AHT = round(rweibull(length(CAL_DATE), 
             4, 540),0), CT_DS = rep("B", length(CAL_DATE)))) 
Overall = data.frame(cbind(ma_AHT = round(rweibull(length(CAL_DATE), 
              10, 475),0), CT_DS = rep("Overall", length(CAL_DATE)))) 
a$CAL_DATE = CAL_DATE 
b$CAL_DATE = CAL_DATE 
Overall$CAL_DATE = CAL_DATE 

data = rbind(a, b, Overall) 

plot_ma = function(x){ 
     x %>% 
       group_by(CT_DS) %>% 
       ggvis(~CAL_DATE, ~ma_AHT, stroke = ~CT_DS) %>% 
       layer_lines() %>% 
       filter(CT_DS == "Overall") %>% 
       layer_lines(stroke := "black", strokeWidth := 3) %>% 
       set_options(renderer = "canvas") %>% 
       add_legend("stroke", title = "~ CT") %>% 
       add_axis("x", title = "Date", title_offset = 60, 
         properties = axis_props(
           labels = list(
             angle = -50, 
             align = "right", 
             baseline = "middle" 
           ))) %>% 
       add_axis("y", title = "M.A. AHT (sec)") 
} 
plot_ma(data) 

Который должен генерировать что-то вроде ниже. Моя единственная проблема заключается в том, как сделать легендарное шоу «Общий» также черным.

Answer 1

Использование scale_nominal и предоставление range позволяет установить цвета как в графической и легенды.

В вашем простом примере это так же просто, как добавление, например, scale_nominal("stroke", range = c("blue", "orange", "black")) до конца вашего кода.

Похоже, что количество групп может отличаться. Однако группа Overall всегда имеет последнее значение (или вы установите ее последним с помощью factor), вы можете использовать что-то подобное выше и сделать ее частью вашей функции. В этом случае вы захотите установить цветовую палитру, которая вам нравится (и которая не содержит черный), которая имеет достаточно цветов для всех ваших групп.

Здесь я возьму одну из палитр, указанную в Cookbook for R с 8 различными цветами.

cbPalette = c("#999999", "#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#D55E00", "#CC79A7") 

Мы можем вытащить количество цветов, необходимых из палитры для конкретного набора данных с помощью числа уровней группирования фактора. Количество необходимых цветов - это минус 1, поскольку последний всегда будет черным.

Вот один из способов вычисления количества групп необходимо окрашивать минус 1.

ncol = nlevels(data[["CT_DS"]]) - 1 

Эта информация может быть использована, чтобы вытащить первый от 1 до «число уровней минус 1» цветов от cbPalette.

pal = cbPalette[1:ncol] 

Это может быть использовано для range аргумента scale_nominal, добавляя "black" до конца вектора.

scale_nominal("stroke", range = c(pal, "black"))

Этот процесс легко добавлен в вашей функции.

plot_ma = function(x){ 
    ncol = nlevels(x[["CT_DS"]]) - 1 
    pal = cbPalette[1:ncol] 
    x %>% 
     group_by(CT_DS) %>% 
     ggvis(~CAL_DATE, ~ma_AHT, stroke = ~CT_DS) %>% 
     layer_lines() %>% 
     filter(CT_DS == "Overall") %>% 
     layer_lines(stroke := "black", strokeWidth := 3) %>% 
     set_options(renderer = "canvas") %>% 
     add_legend("stroke", title = "~ CT") %>% 
     add_axis("x", title = "Date", title_offset = 60, 
       properties = axis_props(
        labels = list(
         angle = -50, 
         align = "right", 
         baseline = "middle" 
        ))) %>% 
     add_axis("y", title = "M.A. AHT (sec)") %>% 
     scale_nominal("stroke", range = c(pal, "black")) 
} 
plot_ma(data)