在ggvis（和其他选项）中自定义填充颜色

Question

我正在尝试使用ggvis为2014赛季创建一个NFL的强度时间表图表。数据来自FootballOutsiders.com，稍后我将制作一款Shiny应用程序，该应用程序会在网站更新期间自动从网站上抓取数据。下面的例子非常接近，但我想做一些修改。我想...

1. 在图表的每个单元格中包含“防御”的数值，因此该图表与原始“df”数据框相似。

2. 自定义色标，使正值越来越橙，负值越来越蓝（即更负=更蓝）。

3. ＃2的替代方案可能是将渐变从橙色变为蓝色，并使“防御”值接近零时不透明度降低至0.5。

4. 能够选择NA的颜色，因为它现在在图表中显示为黑色。

我一直在add_scale()和props()摆弄周围，但没有迄今工作。

以下是图表：

这里的数据：

df <- structure(list(team = c("ARI", "ATL", "BAL", "BUF", "CAR", "CHI", 
"CIN", "CLE", "DAL", "DEN", "DET", "GB", "HOU", "IND", "JAX", 
"KC", "MIA", "MIN", "NE", "NO", "NYG", "NYJ", "OAK", "PHI", "PIT", 
"SD", "SEA", "SF", "STL", "TB", "TEN", "WAS"), w1 = c(17.5, -5.8, 
-12.6, 8.7, -6.8, -13.8, -8.7, 4, -4.6, 0.9, -11.4, -25.9, 4.2, 
-0.2, 4.9, 4.2, 4.2, -5.7, 2.4, 13.5, -0.8, 10.3, -5.6, 10.9, 
8.2, -16.4, 14.4, 13.8, 10.5, -15.7, -6.7, 2.5), w2 = c(-11.4, 
-12.6, 4, 2.4, -0.8, -4.6, 13.5, -5.8, 4.2, -6.7, -15.7, -5.6, 
10.3, 4.9, 4.2, -0.2, -13.8, 4.2, 10.5, 8.2, -16.4, 14.4, 2.5, 
0.9, -8.7, -25.9, 17.5, 8.7, -6.8, -5.7, 13.8, 10.9), w3 = c(-4.6, 
-6.8, 8.2, 17.5, 4, -5.6, 4.2, -8.7, -5.7, -25.9, 14.4, -0.8, 
-11.4, 10.9, 0.9, 2.4, -6.7, -5.8, 10.3, 10.5, 2.5, 8.7, 4.2, 
4.2, -15.7, -13.8, -0.2, -16.4, 13.8, 13.5, -12.6, 4.9), w4 = c(NA, 
10.5, -15.7, 2.5, -8.7, 14.4, NA, NA, -5.8, NA, -5.6, 8.7, -13.8, 
4.2, 17.5, 4.2, 10.3, 13.5, -6.7, 13.8, 4.2, -0.8, 2.4, -4.6, 
-6.8, 10.9, NA, 4.9, NA, 4, 0.9, -11.4), w5 = c(-0.2, -11.4, 
0.9, -0.8, 8.7, -15.7, 4.2, 4.2, 2.5, -16.4, -13.8, 10.5, 13.8, 
-8.7, 4, -4.6, NA, 14.4, -12.6, -6.8, 13.5, 17.5, NA, -5.7, 10.9, 
-5.6, 4.2, -6.7, 4.9, -5.8, 8.2, -25.9), w6 = c(4.2, 8.7, -6.8, 
4.2, -12.6, 13.5, -15.7, 4, -25.9, -5.6, 10.5, 2.4, 0.9, 2.5, 
4.2, NA, 14.4, -0.8, -13.8, NA, 4.9, -0.2, 17.5, -11.4, 8.2, 
10.3, 13.8, -5.7, -4.6, -8.7, 10.9, -16.4), w7 = c(10.3, -8.7, 
13.5, 10.5, 14.4, 2.4, 0.9, 10.9, -11.4, -4.6, -5.8, -15.7, 4, 
-12.6, 8.2, 17.5, 8.7, -13.8, -5.6, -0.8, 13.8, 4.2, -16.4, NA, 
2.5, -6.7, -5.7, -0.2, -25.9, NA, 4.2, 4.2), w8 = c(4.9, -0.8, 
-12.6, -5.6, -25.9, 4.2, -8.7, 10.3, 4.2, 17.5, 13.5, -5.8, 4.2, 
4, 2.4, -5.7, 10.9, -6.8, 8.7, 14.4, NA, -13.8, 8.2, -16.4, 0.9, 
-0.2, -15.7, NA, -6.7, 10.5, 2.5, 13.8), w9 = c(13.8, NA, 4, 
NA, -5.8, NA, 10.9, -6.8, -16.4, 4.2, NA, NA, 4.9, -11.4, -12.6, 
-5.6, 17.5, 4.2, -0.2, -15.7, 0.9, -6.7, -25.9, 2.5, -8.7, 2.4, 
10.3, -5.7, -4.6, 8.2, NA, 10.5), w10 = c(-5.7, -6.8, 4.2, -6.7, 
4.9, 14.4, 8.2, -12.6, 10.9, 10.3, 2.4, 8.7, NA, NA, 13.8, -13.8, 
-0.8, NA, NA, -4.6, -25.9, 4, -0.2, -15.7, -5.6, NA, -11.4, -5.8, 
-16.4, 13.5, -8.7, NA), w11 = c(-0.8, -15.7, NA, 2.4, 13.5, 10.5, 
-5.8, 2.5, NA, -5.7, -16.4, 4.9, 8.2, 4.2, NA, -25.9, -13.8, 
8.7, 0.9, -12.6, -4.6, NA, 17.5, 14.4, 4.2, 10.3, -6.7, -11.4, 
-0.2, 4.2, 4, -6.8), w12 = c(-25.9, 8.2, -5.8, -5.6, NA, -6.8, 
2.5, 13.5, -11.4, 2.4, 4.2, 10.5, -12.6, 10.9, 0.9, 10.3, -0.2, 
14.4, -0.8, -8.7, 13.8, -13.8, -6.7, 4.2, NA, -5.7, -16.4, 4.2, 
17.5, 8.7, 4.9, -4.6), w13 = c(13.5, -16.4, 17.5, 8.2, 10.5, 
-0.8, -6.8, -13.8, 4.9, -6.7, 8.7, 4.2, 4.2, 4.2, -11.4, -0.2, 
-5.6, -15.7, 14.4, 4, 10.9, 2.4, -5.7, 13.8, -5.8, -8.7, -4.6, 
-25.9, 10.3, -12.6, 2.5, 0.9), w14 = c(-6.7, 14.4, 2.4, -0.2, 
-5.8, 13.8, 4, 0.9, 8.7, -13.8, -6.8, 13.5, 10.9, 8.2, 2.5, -16.4, 
-8.7, -5.6, 17.5, -15.7, 4.2, 10.5, -4.6, -25.9, -12.6, 4.2, 
4.9, 10.3, 4.2, -0.8, -11.4, -5.7), w15 = c(-5.7, 4, 10.9, 14.4, 
-6.8, -5.8, 8.2, -12.6, 4.9, 17.5, 10.5, -13.8, 0.9, 2.5, -8.7, 
10.3, 4.2, -0.8, 2.4, 8.7, 4.2, 4.2, -6.7, 13.8, 13.5, -0.2, 
-4.6, -25.9, -16.4, -15.7, -5.6, -11.4), w16 = c(-25.9, -5.8, 
2.5, 10.3, 8.2, -0.8, -0.2, -15.7, 0.9, -12.6, 8.7, -6.8, -8.7, 
13.8, 4.2, 4, 10.5, 2.4, -5.6, 13.5, -5.7, 4.2, -13.8, 4.2, -6.7, 
-4.6, -16.4, 17.5, -11.4, 14.4, 10.9, 4.9), w17 = c(-4.6, -15.7, 
8.2, 4.2, 13.5, 10.5, 4, -8.7, 4.2, 10.3, 14.4, -0.8, 10.9, 4.2, 
2.5, 17.5, -5.6, 8.7, -13.8, -6.8, 4.9, 2.4, -0.2, -11.4, -12.6, 
-6.7, -5.7, -16.4, -25.9, -5.8, 0.9, 13.8)), .Names = c("team", 
"w1", "w2", "w3", "w4", "w5", "w6", "w7", "w8", "w9", "w10", 
"w11", "w12", "w13", "w14", "w15", "w16", "w17"), row.names = c(NA, 
32L), class = "data.frame") 

下面是到目前为止的代码：

require(dplyr) 
require(ggvis) 
require(tidyr) # For the gather function 

df2 <- df %>% gather(key, value, w1:w17) 
names(df2) <- c("team", "week", "defense") 

df2 %>% 
    ggvis(~week, ~team, fill = ~defense) %>% 
    layer_rects(width = band(), height = band()) %>% 
    scale_nominal("x", padding = 0, points = FALSE) %>% 
    scale_nominal("y", padding = 0, points = FALSE) 

Answer 1

我通过创建一个新的设置每个单元的颜色变量def.color，其将defense的每个值映射到特定颜色。在ggplot2中，您可以使用一行代码（如scale_fill_manual()）将呼叫中的颜色直接设置为ggplot，而不是将颜色变量添加到数据框。我希望在ggvis有办法做到这一点，但我还没有找到它。所以，现在，我们走吧：

# Create a new variable df2$def.color for mapping df2$defense values to colors 

# Functions to create color ramps for the blue and orange color ranges 
Blue = colorRampPalette(c("darkblue","lightblue")) 
Orange = colorRampPalette(c("orange","darkorange3")) 

# Negative values of defense get a blue color scale with 10 colors 
df2$def.color[!is.na(df2$defense) & df2$defense<0] = 
    as.character(cut(df2$defense[!is.na(df2$defense) & df2$defense<0], 
        seq(min(df2$defense - 0.1, na.rm=TRUE), 0, length.out=11), 
        labels=Blue(10))) 

# Positive values of defense get an orange color scale with 10 colors 
df2$def.color[!is.na(df2$defense) & df2$defense>=0] = 
    as.character(cut(df2$defense[!is.na(df2$defense) & df2$defense>=0], 
        seq(0, max(df2$defense, na.rm=TRUE)+0.1, length.out=11), 
        labels=Orange(10))) 

# Set NA values in df2$def.color to light gray in df2$def.color 
df2$def.color[is.na(df2$defense)] = "#E5E5E5" 

# Set NA values in df2$defense to blanks so that we won't get "NaN" in cells with 
# missing data 
df2$defense[is.na(df2$defense)] = "" 

现在我们创建该图。要获取颜色，请使用:=将def.color设置为fill以覆盖默认颜色。要添加defense的值，请使用layer_text。我对每个单元格中的文本位置都不满意，但这是我现在能够提出的最佳选择。

df2 %>% 
    ggvis(~week, ~team, fill:=~def.color) %>% 
    layer_rects(width = band(), height = band()) %>% 
    scale_nominal("x", padding = 0, points = FALSE) %>% 
    scale_nominal("y", padding = 0, points = FALSE) %>% 
    layer_text(text:=~defense, stroke:="white", align:="left", baseline:="top") 

Answer 2

溶液我发现显示图例，利用所述scale_ordinal功能。我使用了很多由@ eipi10编写的代码，谢谢！

# Functions to create color ramps for the blue and orange color ranges, 
# combined in a single palette with 10 colors of each ramp and gray for NAs 
Blue <- colorRampPalette(c("darkblue","lightblue")) 
Orange <- colorRampPalette(c("orange","darkorange3")) 
palette <- c(Blue(10), "#E5E5E5", Orange(10)) 

# Negative values of defense get a blue color scale with 10 colors, indexes 
# from 1 to 10 
df2$def.label[!is.na(df2$defense) & df2$defense<0] <- 
    as.character(cut(df2$defense[!is.na(df2$defense) & df2$defense<0], 
       seq(min(df2$defense - 0.1, na.rm = TRUE), 0, length.out = 11), 
       labels = palette[1:10])) 

# Positive values of defense get an orange color scale with 10 colors, 
# indexes from 12 to 21 
df2$def.label[!is.na(df2$defense) & df2$defense>=0] <- 
    as.character(cut(df2$defense[!is.na(df2$defense) & df2$defense>=0], 
       seq(0, max(df2$defense, na.rm = TRUE) + 0.1, length.out = 11), 
       labels = palette[12:21])) 

# Set NA values in df2$defense to 11 in def.label, the label for gray color 
df2$def.label[is.na(df2$defense)] <- palette[[11]] 

# Define the values to be displayed on the legend 
pos.cut.values <- seq(0, max(df2$defense, na.rm = TRUE) + 0.1, length.out = 11) 
neg.cut.values <- seq(min(df2$defense - 0.1, na.rm = TRUE), 0, length.out = 11) 
legend.values <- c(paste(neg.cut.values[1:10], '..', neg.cut.values[2:11]), 
        'NA', paste(pos.cut.values[1:10], '..', pos.cut.values[2:11])) 

# Set NA values in df2$defense to blanks so that we won't get "NaN" in cells 
# with missing data 
df2$defense[is.na(df2$defense)] <- "" 

df2 %>% 
    ggvis(~week, ~team, fill:=~def.label) %>% 
    scale_ordinal('fill', range = palette) %>% 
    add_legend(scales = 'fill', values = legend.values) %>% 
    layer_rects(width = band(), height = band()) %>% 
    scale_nominal("x", padding = 0, points = FALSE) %>% 
    scale_nominal("y", padding = 0, points = FALSE) %>% 
    layer_text(text := ~defense, stroke := "white", align := "left", 
       baseline := "top")