What I want to do:
I want to plot few curves and fill in the areas between them
The problem
I use geom_ribbon() to fill in the areas. But it fills in more than what I want.
Incorrectly filled white area:
I want to fill in white only between "OPDV" and "SDV" lines (shown in plot).
Code and Data
I used following code for above plot:
library(ggplot2)
library(dplyr)
ggplot() +
geom_ribbon(data = ddf,aes(ymin=BX,ymax=60, x=dv), fill="green") +
geom_ribbon(data = ddf,aes(ymin=BX,ymax=s, x=SDV_1), fill="orange") +
geom_ribbon(data = ddf,aes(ymin=BX,ymax=SDX_1, x=dv), fill="white") +
geom_path(data = ddf,mapping = aes(x = CLDV_1, y = s), size=0.5)+
geom_path(data = ddf,mapping = aes(x = OPDV_1, y = s), size=0.5) +
geom_path(data = ddf,aes(x = SDV_1, y = s), size=0.5) +
#geom_path(data = ddf,aes(x = dv, y = AX), size=0.5) +
geom_path(data = ddf,aes(x = dv, y = BX), size=0.5) +
geom_path(data = ddf,aes(x = dv, y = SDX_1), size=0.5) +
annotate(geom = "text", x = -0.8, y = 29, label = "OPDV",size = 3) +
annotate(geom = "text", x = 1.5, y = 40, label = "SDV",size = 3) +
labs(y = "Spacing (m)", x = "Relative Speed (Vf - Vl), m/s") +
coord_cartesian(ylim = c(25, 50),
xlim = c(-2,3.2))
I also tried replacing the third line with following:
geom_ribbon(data = ddf %>%
filter(dv>OPDV_1 & dv<SDV_1),
aes(ymin=BX,ymax=SDX_1, x=dv), fill="white")
But, since some of the values in OPDV_1 and SDV_1 are NA, it didn't fill in white at all.
Following are my data:
structure(list(BX = c(27.5, 27.5, 27.5, 27.5, 27.5, 27.5, 27.5,
27.5, 27.5, 27.5, 27.5, 27.5, 27.5, 27.5, 27.5, 27.5, 27.5, 27.5,
27.5, 27.5, 27.5, 27.5, 27.5, 27.5, 27.5, 27.5, 27.5, 27.5, 27.5,
27.5, 27.5, 27.5, 27.5, 27.5, 27.5, 27.5, 27.5, 27.5, 27.5, 27.5,
27.5, 27.5, 27.5, 27.5, 27.5, 27.5, 27.5, 27.5, 27.5, 27.5, 27.5,
27.5, 27.5, 27.5, 27.5, 27.5, 27.5, 27.4804347826087, 27.4295652173913,
27.3786956521739, 27.3278260869565, 27.2769565217391, 27.2260869565217,
27.1752173913043, 27.124347826087, 27.0734782608696, 27.0226086956522,
26.9717391304348, 26.9208695652174, 26.87, 26.8191304347826,
26.7682608695652, 26.7173913043478, 26.6665217391304, 26.615652173913,
26.5647826086957, 26.5139130434783, 26.4630434782609, 26.4121739130435,
26.3613043478261, 26.3104347826087, 26.2595652173913, 26.2086956521739,
26.1578260869565, 26.1069565217391, 26.0560869565217, 26.0052173913043,
25.954347826087, 25.9034782608696, 25.8526086956522, 25.8017391304348,
25.7508695652174, 25.7), dv = c(3.2, 3.14347826086956, 3.08695652173913,
3.03043478260869, 2.97391304347826, 2.91739130434782, 2.86086956521739,
2.80434782608696, 2.74782608695652, 2.69130434782609, 2.63478260869565,
2.57826086956522, 2.52173913043478, 2.46521739130435, 2.40869565217391,
2.35217391304348, 2.29565217391304, 2.23913043478261, 2.18260869565217,
2.12608695652174, 2.0695652173913, 2.01304347826087, 1.95652173913043,
1.9, 1.84347826086956, 1.78695652173913, 1.7304347826087, 1.67391304347826,
1.61739130434783, 1.56086956521739, 1.50434782608696, 1.44782608695652,
1.39130434782609, 1.33478260869565, 1.27826086956522, 1.22173913043478,
1.16521739130435, 1.10869565217391, 1.05217391304348, 0.995652173913044,
0.939130434782609, 0.882608695652173, 0.826086956521738, 0.769565217391303,
0.713043478260868, 0.656521739130433, 0.600000000000001, 0.543478260869566,
0.486956521739131, 0.430434782608696, 0.373913043478261, 0.317391304347826,
0.260869565217391, 0.204347826086956, 0.14782608695652, 0.0913043478260853,
0.0347826086956502, -0.0217391304347814, -0.0782608695652165,
-0.134782608695652, -0.191304347826087, -0.247826086956522, -0.304347826086957,
-0.360869565217392, -0.417391304347827, -0.473913043478262, -0.530434782608694,
-0.586956521739133, -0.643478260869564, -0.699999999999999, -0.756521739130434,
-0.81304347826087, -0.869565217391305, -0.92608695652174, -0.982608695652175,
-1.03913043478261, -1.09565217391305, -1.15217391304348, -1.20869565217392,
-1.26521739130435, -1.32173913043478, -1.37826086956522, -1.43478260869565,
-1.49130434782609, -1.54782608695652, -1.60434782608696, -1.66086956521739,
-1.71739130434783, -1.77391304347826, -1.83043478260869, -1.88695652173913,
-1.94347826086956, -2), s = 8:100, SDV_1 = c(NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
-0.0875, 0.0375, 0.1625, 0.2875, 0.4125, 0.5375, 0.6625, 0.7875,
0.9125, 1.0375, 1.1625, 1.2875, 1.4125, 1.5375, 1.6625, 1.7875,
1.9125, 2.0375, 2.1625, 2.2875, 2.4125, 2.5375, 2.6625, 2.7875,
2.9125, 3.0375, 3.1625, 3.2875, 3.4125, 3.5375, 3.6625, 3.7875,
3.9125, 4.0375, 4.1625, 4.2875, 4.4125, 4.53994565217391, 4.67130434782609,
4.80266304347826, 4.93402173913043, 5.06538043478261, 5.19673913043478,
5.32809782608696, 5.45945652173913, 5.5908152173913, 5.72217391304348,
5.85353260869565, 5.98489130434783, 6.11625, 6.24760869565217,
6.37896739130435, 6.51032608695652, 6.6416847826087, 6.77304347826087,
6.90440217391304, 7.03576086956522, 7.16711956521739, 7.29847826086957,
7.42983695652174, 7.56119565217391, 7.69255434782609, 7.82391304347826,
7.95527173913043, 8.08663043478261, 8.21798913043478, 8.34934782608696,
8.48070652173913, 8.6120652173913, 8.74342391304348, 8.87478260869565,
9.00614130434783, 9.1375), SDX_1 = c(NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 31.5, 31.5, 31.5,
31.5, 31.5, 31.5, 31.5, 31.4804347826087, 31.4295652173913, 31.3786956521739,
31.3278260869565, 31.2769565217391, 31.2260869565217, 31.1752173913043,
31.124347826087, 31.0734782608696, 31.0226086956522, 30.9717391304348,
30.9208695652174, 30.87, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), CLDV_1 = c(NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, 0.619176470588235, 0.646767058823529, 0.675703529411765,
0.705985882352941, 0.737614117647059, 0.770588235294118, 0.804908235294118,
0.840574117647059, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA), OPDV_1 = c(NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, -0.619176470588235,
-0.646767058823529, -0.675703529411765, -0.705985882352941, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA)), row.names = c(NA, -93L), class = c("tbl_df",
"tbl", "data.frame"), .Names = c("BX", "dv", "s", "SDV_1", "SDX_1",
"CLDV_1", "OPDV_1"))
Please guide me if there is any other function in ggplot2 or extensions that I can use to fill in correctly. Or, if possible, how can I use geom_ribbon() effectively in this case?
Use geom_polygon to fill the white area between the OPDV, SDX, SDV and BX curves.
Create data to draw the white polygon
library(tidyr)
# Change data to a long format
ddflong <- ddf %>%
gather(key, value, -dv, -s)
# Extract data for each polygon side
sideOPDV <- ddflong %>%
filter(key =="OPDV_1" & !is.na(value)) %>%
transmute(x = value, y = s, key = key) %>%
arrange(y)
sideSDX <- ddflong %>%
filter(key =="SDX_1" & !is.na(value)) %>%
transmute(x = dv, y = value, key = key) %>%
arrange(x)
sideSDV <- ddflong %>%
filter(key =="SDV_1" & !is.na(value) & value < max(sideSDX$x)) %>%
transmute(x = value, y = s, key = key) %>%
arrange(desc(y))
sideBX <- ddflong %>%
filter(key == "BX" & dv > max(sideOPDV$x) & dv < min(sideSDV$x)) %>%
transmute(x = dv, y = value, key = key) %>%
arrange(desc(x))
# Combine all sides in one polygon
datapolygon <- rbind(sideOPDV, sideSDX, sideSDV, sideBX)
Draw the plot
ggplot(data = ddf) +
geom_ribbon(aes(ymin=BX,ymax=60, x=dv), fill="green") +
geom_ribbon(aes(ymin=BX,ymax=s, x=SDV_1), fill="orange") +
#### Here is the new instruction ####
geom_polygon(data = datapolygon, aes(x = x, y =y), fill="white") +
# Added colours to identify the lines
geom_path(aes(x = CLDV_1, y = s), colour = "yellow")+
geom_path(aes(x = OPDV_1, y = s), colour = "purple") +
geom_path(aes(x = SDV_1, y = s), colour = "dark green") +
geom_path(aes(x = dv, y = BX), colour = "blue") +
geom_path(aes(x = dv, y = SDX_1), colour = "red") +
annotate(geom = "text", x = 1, y = 30, label = "CLDV", colour = "yellow") +
annotate(geom = "text", x = -0.9, y = 29, label = "OPDV", colour = "purple") +
annotate(geom = "text", x = 1.2, y = 40, label = "SDV", colour = "dark green") +
annotate(geom = "text", x = -0.2, y = 26, label = "BX", colour = "blue") +
annotate(geom = "text", x = -0.3, y = 32, label = "SDX", colour = "red") +
labs(y = "Spacing (m)", x = "Relative Speed (Vf - Vl), m/s") +
coord_cartesian(ylim = c(25, 50),
xlim = c(-2,3.2))
Related
In continuation of my earlier question, I am facing issues w.r.t. to ordering the legends. The initially posted question had ordinal (ordered) values and hence worked perfectly. In real-time, the data rendered in the legend is being ordered alphabetically.
library(ggplot2)
library(tidyverse)
library(reshape2)
#Creating a dataframe with use-case specific variables.
df = data.frame(
Year = 2006:2025,
Survey = c(40.5, 39.0, NA, NA, NA, NA, 29.9, NA, NA, NA, 21.6,
NA, NA, NA, NA, NA, NA, NA, NA, NA),
Projected1 = c(NA, NA, NA, NA, NA, NA, 29.9, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, 14.9),
WhatIf= c(NA, NA, NA, NA, NA, NA, 29.9, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, 13.0),
Projected2 = c(NA, NA, NA, NA, NA, NA, 29.9, 27.6, 25.4, 23.4, 21.6,
19.9, 18.4, 16.9, 15.6, 14.4, 13.3, NA, 12.2, 11.3)
)
#Transforming data
df <- melt(df,id.vars = "Year")
ggplot(data = NULL, aes(x=factor(Year), y=value, group=variable)) +
geom_line(data = df[!is.na(df$value) & df$variable != "Survey",],
aes(linetype=variable, color = variable), size = 1, linetype = "dashed")+
geom_point(data = df[!is.na(df$value) & df$variable == "Survey",],
aes(color = variable), size = 4) +
scale_color_manual(values=c('#999999', 'orange2','turquoise2','blue2'))+
guides(color = guide_legend(override.aes = list(linetype = c("blank", "dashed", "dashed", "dashed"),
shape = c(16, NA, NA, NA)))) +
scale_y_continuous(
breaks=seq(0,100, 10), labels = seq(0, 100, 10), limits=c(0,70),
sec.axis = dup_axis()) +
theme(
legend.position = 'bottom', legend.direction = 'horizontal',
panel.grid.major.y = element_line(color='gray85'),
axis.title = element_text(face='bold')) +
labs(x='Year', y='measure (%)')
Created on 2020-07-11 by the reprex package (v0.3.0)
Output
Objective: Sequence in the legend and respective plots must be as follows: c("Survey", "WhatIf", "Projected1", "Projected2" )
I have tried the following methods alternatively but there's no difference in the output.
df$variable <- factor(df$variable, levels = c("Survey", "WhatIf", "Projected1", "Projected2" ))
scale_fill_discrete(breaks = c("Survey", "WhatIf", "Projected1", "Projected2" ))
I might be missing out on a trivial step and any suggestions would be greatly helpful.
You just need to add a breaks = argument to scale_color_manual and change the order of values = to match because you have the guide argument set to color =:
scale_color_manual(breaks = c("Survey", "WhatIf", "Projected1", "Projected2" ),
values=c('turquoise2','blue2','#999999', 'orange2'))+
I want to plot a figure with 2 lines (inner bay and outer bay), but I have 2 columns of data for inner bay. I need to set the date limits to switch columns on a certain date. In the data below, I want to plot IB.y from 2015-09-08 to 2015-09-23 and IB.x from 2015-09-24 to 2015-10-07. And then I want to plot all of OB.
The code below plots both IB.x and IB.y for the entire date range rather than split at 2015-09-24 as desired:
AllDailyMean = ggplot(AllMean, aes(x=Date)) + geom_line(aes(y=IB.x,
color = "Inner Bay"), size = 0.5) + geom_ribbon(aes(ymin=IBMin.x,
ymax = IBMax.x), fill = "coral2", alpha = 0.2, linetype = 3) +
scale_x_date(limits = as.Date(c("2015-09-08", "2015-09-23"))) +
geom_line(aes(y=IB.y, color = "Inner Bay"), size = 0.5) +
geom_line(aes(y=OB, color = "Outer Bay"), size = 0.5) +
geom_ribbon(aes(ymin=IBMin.y, ymax=IBMax.y), fill = "coral2", alpha
= 0.2, linetype = 3) + geom_ribbon(aes(ymin=OBMin, ymax=OBMax),
fill = "skyblue4", alpha = 0.2, linetype = 3) +
scale_x_date(labels = date_format("%b '%y"), date_breaks = "2
months") + labs(y = expression(atop("Mean Daily Temp",
paste(("°C"%+-%"Max/Min")))), x = "Date")
structure(list(Date = structure(c(16686, 16687, 16688, 16689,
16690, 16691, 16692, 16693, 16694, 16695, 16696, 16697, 16698,
16699, 16700, 16701, 16702, 16703, 16704, 16705, 16706, 16707,
16708, 16709, 16710, 16711, 16712, 16713, 16714, 16715, 16716
), class = "Date"), IB.x = c(29.7916666666667, 30.0166666666667,
30.075, 30.0875, 29.3666666666667, 29.2291666666667, 28.8875,
28.6826086956522, 28.6041666666667, 28.7125, 28.7416666666667,
28.5166666666667, 28.525, 28.525, 28.5166666666667
28.3916666666667, 28.3, 28.0875, 27.9541666666667, 27.475,
27.1458333333333, 26.9166666666667, 26.85, 26.9625,
26.4041666666667, 25.95, 25.7416666666667, 25.85,
25.6875, 25.7, 25.7958333333333), IBMax.x = c(30.1, 30.3, 30.4,
30.6, 29.7, 29.4, 29.2, 29, 28.9, 29, 29.1, 28.9, 28.8, 28.7,
28.7, 28.5, 28.5, 28.4, 28.1, 27.9, 27.6, 27.1, 27.1, 27.3, 27.1,
26.3, 26.2, 26.1, 25.9, 26.2, 26.1), IBMin.x = c(29.1, 29.7,
29.8, 29.7, 29, 29, 28.4, 28.2, 28.4, 28.5, 28.6, 27.9, 28.2,
28.3, 28.2, 28.2, 28.1, 27.7, 27.8, 27, 26.8, 26.7, 26.5, 26.7,
25.7, 25.5, 25.4, 25.4, 25.2, 25.2, 25.5), IB.y = c(NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 27.671,
27.6027395833333, 27.25271875, 26.7719895833333, 26.3682604166667,
26.3313229166667, 26.4141875, 26.2628020833333, 26.14065625,
26.1491041666667, 26.2293541666667, 25.7827604166667, 25.44615625,
25.6583854166667, 26.0718645833333), IBMax.y = c(NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 28.177, 28.151,
27.632, 27.187, 26.917, 26.843, 27.237, 26.77, 26.573, 26.622,
26.671, 26.059, 25.913, 26.279, 26.328), IBMin.y = c(NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 27.41, 26.917,
26.77, 26.23, 25.766, 25.717, 25.644, 25.352, 25.255, 25.231,
25.498, 25.523, 25.084, 25.036, 25.766), OB = c(NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 27.794625, 27.5463125,
27.0850208333333, 26.8009375, 26.7057083333333, 26.65728125,
26.535375, 26.46721875, 26.4802604166667, 26.7571145833333,
26.3706145833333, 26.0067395833333, 25.9274166666667,
25.8764895833333, 25.9058333333333), OBMax = c(NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 28.147, 27.998, 27.358,
27.014, 27.136, 27.014, 27.186, 26.965, 27.038, 27.308, 26.646,
26.231, 26.256, 26.329, 26.207), OBMin = c(NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 27.628, 27.21, 26.793,
26.524, 26.304, 26.28, 26.158, 26.158, 25.939, 26.329, 25.939,
25.768, 25.671, 25.574, 25.501)), row.names = 70:100, class =
"data.frame")
One option is to use a simple ifelse within your y aesthetic. I've removed a bunch of your code as it's superfluous to the problem at hand (it's helpful to provide a minimal reproducible example, removing any irrelevant details).
ggplot(df, aes(x=Date)) +
geom_line(aes(y=ifelse(Date <= "2015-09-23", IB.x, NA), color = "Inner Bay"), size = 0.5) +
geom_line(aes(y=ifelse(Date > "2015-09-23", IB.x, NA), color = "Outer Bay"), size = 0.5) +
labs(y = expression(atop("Mean Daily Temp", paste(("°C"%+-%"Max/Min")))), x = "Date")
Sorry for my English.
I'm creating a feature to display the NBA season moving average. I'm doing an animation, part of which is displaying the current rating. I do this with geom_text. The problem is that instead of displaying a single value, you get a jumble.
Code:
library(httr)
library(jsonlite)
library(tidyverse)
##Getting data via NBA API.
##Required link
adv_box_team <- "https://stats.nba.com/stats/teamgamelogs?DateFrom=&DateTo=&GameSegment=&LastNGames=0&LeagueID=00&Location=&MeasureType=Advanced&Month=0&OpponentTeamID=0&Outcome=&PORound=0&PaceAdjust=N&PerMode=Totals&Period=0&PlusMinus=N&Rank=N&Season=2018-19&SeasonSegment=&SeasonType=Regular+Season&ShotClockRange=&VsConference=&VsDivision="
##Adding headers
request_headers <- c(
"accept-encoding" = "gzip, deflate, sdch",
"accept-language" = "en-US,en;q=0.8",
"cache-control" = "no-cache",
"connection" = "keep-alive",
"host" = "stats.nba.com",
"pragma" = "no-cache",
"upgrade-insecure-requests" = "1",
"user-agent" = "Mozilla/5.0 (Macintosh; Intel Mac OS X 10_11_2) AppleWebKit/601.3.9 (KHTML, like Gecko) Version/9.0.2 Safari/601.3.9"
)
#Getting a response
request <- GET(adv_box_team, add_headers(request_headers))
#Convert to js.file to list
boxscore_data <- fromJSON(content(request, as = "text"))
#Convert to tibble data and assigning column names
table <- tbl_df(data.frame(boxscore_data$resultSets$rowSet[[1]], stringsAsFactors = FALSE))
names(table) <- toupper(boxscore_data$resultSets$headers[[1]])
library(tidyverse)
library(lubridate)
library(zoo)
library(ggthemes)
library(gganimate)
library(rlang)
library(data.table)
##Cleaning data
rating <- table %>%
select(TEAM_ID,
TEAM_ABBREVIATION,
TEAM_NAME,
GAME_ID,
GAME_DATE,
MATCHUP,
WL,
E_OFF_RATING,
E_DEF_RATING,
E_NET_RATING)
rating1 <- rating %>%
rename_at(vars(starts_with("E_")),
funs(str_c(str_sub(., start = 3, end = 3),
str_sub(., start = 7, end = 7),
str_sub(., start = 9, end = 9),
str_sub(., start = 12, end = 12))))
rolling_offnet_rating_nba <- function(table, variable, name, col1 = col1, col2 = col2){
quo_rating <- enquo(variable)
quo_col1 <- enquo(col1)
quo_col2 <- enquo(col2)
test1 <- rating1 %>%
mutate(GAME_DATE = as.Date(ymd_hms(GAME_DATE))) %>%
mutate_at(vars(ORTG:NRTG), list(~as.numeric))
team <- test1 %>%
filter(TEAM_ABBREVIATION == name) %>%
mutate(RATING = rollmeanr(!! quo_rating, k = 10, fill= NA)) %>%
na.omit(test1)
league <- test1 %>%
group_by(TEAM_NAME) %>%
summarise(ORTG = mean(ORTG),
DRTG = mean(DRTG),
NTRG = mean(NRTG))
average <- league %>%
mutate(average = mean(!! quo_rating)) %>%
select(average) %>%
unique() %>%
.$average
top10 <- league %>%
arrange(desc(!! quo_rating)) %>%
select(!! quo_rating) %>%
slice(10)
top10 <- top10[[1]]
bottom10 <- league %>%
arrange(desc(!! quo_rating)) %>%
select(!! quo_rating) %>%
slice(21)
bottom10 <- bottom10[[1]]
data <- team %>%
select(GAME_DATE) %>%
unique() %>%
arrange(GAME_DATE)
data <- data[[1,1]]
table_color <- data.table(TEAM_ID = c(1610612737, 1610612738, 1610612751, 1610612766, 1610612741, 1610612739, 1610612742,
1610612743, 1610612765, 1610612744, 1610612745, 1610612754, 1610612746, 1610612747,
1610612763, 1610612748, 1610612749, 1610612750, 1610612740, 1610612752, 1610612760,
1610612753, 1610612755, 1610612756, 1610612757, 1610612758, 1610612759, 1610612761,
1610612762, 1610612764),
TEAM_NAME = c("Atlanta Hawks", "Boston Celtics", "Brooklyn Nets",
"Charlotte Hornets", "Chicago Bulls", "Cleveland Cavaliers",
"Dallas Mavericks", "Denver Nuggets", "Detroit Pistons",
"Golden State Warriors", "Houston Rockets", "Indiana Pacers",
"LA Clippers", "Los Angeles Lakers", "Memphis Grizzlies",
"Miami Heat", "Milwaukee Bucks", "Minnesota Timberwolves",
"New Orleans Pelicans", "New York Knicks", "Oklahoma City Thunder",
"Orlando Magic", "Philadelphia 76ers", "Phoenix Suns",
"Portland Trail Blazers", "Sacramento Kings", "San Antonio Spurs",
"Toronto Raptors", "Utah Jazz", "Washington Wizards"),
TEAM_ABBREVIATION = c("ATL", "BOS", "BKN", "CHA", "CHI", "CLE", "DAL", "DEN", "DET", "GSW", "HOU", "IND", "LAC", "LAL",
"MEM", "MIA", "MIL", "MIN", "NOP", "NYK", "OKC", "ORL", "PHI", "PHX", "POR", "SAC", "SAS", "TOR",
"UTA", "WAS"),
col1 = c("#E03A3E", "#007A33", "#000000", "#1D1160", "#CE1141", "#6F263D", "#00538C", "#0E2240",
"#C8102E", "#006BB6", "#CE1141", "#002D62", "#C8102E", "#552583", "#5D76A9", "#98002E",
"#00471B", "#0C2340", "#0C2340", "#006BB6", "#007AC1", "#0077C0", "#006BB6", "#1D1160",
"#E03A3E", "#5A2D81", "#C4CED4", "#CE1141", "#002B5C", "#002B5C"),
name_col1 = c("HAWKS RED", "CELTICS GREEN", "BLACK",
"HORNETS PURPLE", "BULLS RED", "CAVALIERS WINE",
"ROYAL BLUE", "MIDNIGHT BLUE", "RED",
"WARRIORS ROYAL BLUE", "RED", "PACERS BLUE",
"RED", "LAKERS PURPLE", "BLUE",
"RED", "GOOD LAND GREEN", "MIDNIGHT BLUE",
"PELICANS NAVY", "KNICKS BLUE", "THUNDER BLUE",
"MAGIC BLUE", "BLUE", "PURPLE",
"RED", "PURPLE", "SILVER",
"RED", "NAVY", "NAVY BLUE"),
col2 = c("#C1D32F", "#BA9653", "#FFFFFF", "#00788C", "#000000", "#041E42", "#002B5E", "#FEC524",
"#006BB6", "#FDB927", "#000000", "#FDBB30", "#1D428A", "#FDB927", "#12173F", "#F9A01B",
"#EEE1C6", "#236192", "#C8102E", "#F58426", "#EF3B24", "#C4CED4", "#ED174C", "#E56020",
"#000000", "#63727A", "#000000", "#000000", "#00471B", "#E31837"),
name_col2 = c("VOLT GREEN", "CELTICS GOLD", "WHITE", "TEAL",
"BLACK", "CAVALIERS NAVY", "NAVY BLUE", "SUNSHINE YELLOW",
"ROYAL", "GOLDEN YELLOW", "BLACK", "YELLOW",
"BLUE", "GOLD", "NAVY", "YELLOW",
"CREAM CITY CREAM", "LAKE BLUE", "PELICANS RED", "KNICKS ORANGE",
"SUNSET", "SILVER", "RED", "ORANGE",
"BLACK", "GRAY", "BLACK", "BLACK",
"GREEN", "RED"),
col3 = c("#26282A", "#963821", NA, "#A1A1A4", NA, "#FFB81C", "#B8C4CA", "#8B2131",
"#BEC0C2", "#26282A", "#C4CED4", "#BEC0C2", "#BEC0C2", "#000000", "#F5B112", "#000000",
"#0077C0", "#9EA2A2", "#85714D", "#BEC0C2", "#002D62", "#000000", "#002B5C", "#000000",
NA, "#000000", NA, "#A1A1A4", "#F9A01B", "#C4CED4"),
name_col3 = c("HAWKS CHARCOAL", "CELTICS BROWN", NA, "GRAY",
NA, "CAVALIERS NAVY", "SILVER", "FLATIRONS RED",
"GRAY", "SLATE", "SILVER", "SILVER",
"SILVER", "BLACK", "YELLOW", "BLACK",
"GREAT LAKES BLUE", "MOONLIGHT GREY", "PELICANS GOLD", "KNICKS SILVER",
"BLUE", "BLACK", "NAVY", "BLACK",
NA, "BLACK", NA, "SILVER",
"YELLOW", "SILVER" ),
col4 = c( NA, "#E59E6D", NA, NA, NA, "#000000", "#000000", "#1D428A",
"#002D62", NA, NA, NA, "#000000", NA, "#707271", NA,
"#000000", "#78BE20", NA, "#000000", "#FDBB30", NA, "#C4CED4", "#63727A",
NA, NA, NA, "#B4975A", NA, NA ),
name_col4 = c( NA, "CELTICS BEIGE", NA, NA,
NA, "CAVALIERS BLACK", "BLACK", "SKYLINE BLUE",
"NAVY", NA, NA, NA,
"BLACK", NA, "GRAY", NA,
"BLACK", "AURORA GREEN", NA, "KNICKS BLACK",
"YELLOW", NA, "SILVER", "GRAY",
NA, NA, NA, "GOLD",
NA, NA ),
col5 = c(NA, "#000000", NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, "#F9AD1B",
NA, NA, NA, NA, NA, NA ),
name_col5 = c(NA, "CELTICS BLACK", NA, NA, NA,
NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA,
NA, NA, NA, "YELLOW", NA,
NA, NA, NA, NA, NA ),
col6 = c(NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, "#B95915",
NA, NA, NA, NA, NA, NA ),
name_col6 = c(NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, "DARK ORANGE",
NA, NA, NA, NA, NA, NA ),
col7 = c(NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, "#BEC0C2",
NA, NA, NA, NA, NA, NA ),
name_col7 = c(NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, "LIGHT GRAY",
NA, NA, NA, NA, NA, NA))
color1 <- table_color %>%
filter(TEAM_ABBREVIATION == name) %>%
select(!! quo_col1)
color1 <- color1[[1]]
color2 <- table_color %>%
filter(TEAM_ABBREVIATION == name) %>%
select(!! quo_col2)
color2 <- color2[[1]]
name1 <- paste0("name_", quo_name(quo_col1))
name2 <- paste0("name_", quo_name(quo_col2))
name_color1 <- table_color %>%
filter(TEAM_ABBREVIATION == name) %>%
select(name1)
name_color1 <- name_color1[[1]]
name_color2 <- table_color %>%
filter(TEAM_ABBREVIATION == name) %>%
select(name2)
name_color2 <- name_color2[[1]]
max <- team %>%
filter(RATING == max(RATING)) %>%
select(RATING)
max <- max[[1]]
Sys.setlocale("LC_ALL", "C")
gg <- ggplot(team, aes(GAME_DATE, RATING)) +
geom_hline(yintercept = c(top10, bottom10), col = c("red", "blue")) +
annotate(geom = "text", x = as.Date(data) + 2, y = top10 - 0.2,
label = "TOP 10", col = "red") +
annotate(geom = "text", x = as.Date(data) + 2, y = bottom10 + 0.2,
label = "BOTTOM 10", col = "blue") +
geom_line(size = 2, col = if_else(team$RATING > average, color1, color2)) +
theme_tufte() +
labs(title = paste0(team$TEAM_NAME, " 10-Game Rolling Luck-Adjusted ", quo_name(quo_rating)),
subtitle = paste0(paste0(name_color1, " - above average ", quo_name(quo_rating)),
"\n", paste0(name_color2, " - below average ",quo_name(quo_rating))),
caption = "Source: BBall Index Data & Tools\nTelegram: #NBAatlantic, twitter: #vshufinskiy")
theme(plot.title = element_text(size = 12, hjust = 0.5),
plot.caption = element_text(size = 10),
plot.subtitle = element_text(size = 9))
ggsave(paste0(unique(team$TEAM_NAME), quo_name(quo_rating), ".jpeg"), gg, width = 8, units = "in")
anim <- gg +
theme(plot.title = element_text(hjust = 0.5, size = 25),
plot.subtitle = element_text(size = 15),
plot.caption = element_text(size = 15),
axis.text = element_text(size = 15),
axis.title = element_text(size = 18)) +
geom_text(aes(x = as.Date(data), y = max + 0.5),
label = paste0(quo_name(quo_rating)," ", round(team$RATING, digits = 1)), size = 6,
col = if_else(team$RATING > average, color1, color2)) +
transition_reveal(GAME_DATE) +
labs(title = paste0(team$TEAM_NAME, " 10-Game Rolling Luck-Adjusted ", quo_name(quo_rating)),
subtitle = paste0(paste0(name_color1, " - above average ",quo_name(quo_rating)),
"\n", paste0(name_color2, " - below average ",quo_name(quo_rating)),
"\n", "Date: {frame_along}"),
caption = paste0("Source: BBall Index Data & Tools\nTelegram: #NBAatlantic, twitter: #vshufinskiy"))
animate(anim, fps = 5, duration = 5, width = 1280, height = 720,
renderer = gifski_renderer(paste0(unique(team$TEAM_NAME), quo_name(quo_rating), ".gif")))
}
rolling_offnet_rating_nba(rating1, ORTG, "GSW")
Result: https://c.radikal.ru/c40/1907/c8/37e210e3f31b.gif
I can see that there are a lot of questions similar to this, but I cant find solution for my particular problem.
Data:
risk_accum <- structure(list(date = structure(c(1465948800, 1465952400, 1465956000,
1465959600, 1465963200, 1465966800, 1465970400, 1465974000, 1465977600,
1465981200, 1465984800, 1465988400, 1465992000, 1465995600, 1465999200,
1466002800, 1466006400, 1466010000, 1466013600, 1466017200, 1466020800,
1466024400, 1466028000, 1466031600, 1466035200, 1466038800, 1466042400,
1466046000, 1466049600, 1466053200, 1466056800, 1466060400, 1466064000,
1466067600, 1466071200, 1466074800, 1466078400, 1466082000, 1466085600,
1466089200, 1466092800, 1466096400, 1466100000, 1466103600, 1466107200,
1466110800, 1466114400, 1466118000, 1466121600, 1466125200, 1466128800,
1466132400, 1466136000, 1466139600, 1466143200, 1466146800, 1466150400,
1466154000, 1466157600, 1466161200, 1466164800, 1466168400, 1466172000,
1466175600, 1466179200, 1466182800, 1466186400, 1466190000, 1466193600,
1466197200, 1466200800, 1466204400, 1466208000, 1466211600, 1466215200,
1466218800, 1466222400, 1466226000, 1466229600, 1466233200, 1466236800,
1466240400, 1466244000, 1466247600, 1466251200, 1466254800, 1466258400,
1466262000, 1466265600, 1466269200, 1466272800, 1466276400, 1466280000,
1466283600, 1466287200, 1466290800, 1466294400, 1466298000, 1466301600,
1466305200, 1466308800, 1466312400, 1466316000, 1466319600, 1466323200,
1466326800, 1466330400, 1466334000, 1466337600, 1466341200, 1466344800,
1466348400, 1466352000, 1466355600, 1466359200, 1466362800, 1466366400,
1466370000, 1466373600, 1466377200), class = c("POSIXct", "POSIXt"
), tzone = "UTC"), risk = c(NA, NA, NA, 1, 2, 3, 4, 5, 6, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 1, 2, 3, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 1, 2, 3,
4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, NA, NA)), .Names = c("date",
"risk"), row.names = c(NA, -120L), class = c("tbl_df", "tbl",
"data.frame"))
And code to generate graph:
#color variable
color_var <- vector(mode = "double",length = length(risk_accum$risk))
color_var[color_var== '0']<-NA
color_var[risk_accum$risk<6] <- "green4"
color_var[risk_accum$risk>=6 & risk_accum$risk<12] <- "yellow2"
color_var[risk_accum$risk>=12] <- "red"
#plot of Effective Blight Hours accumulation
ggplot(risk_accum)+
geom_line(aes(x = date, y = risk), color = color_var)+
scale_y_continuous(name = "EBH accumulation")+
scale_colour_manual(values=c("green", "yellow", "red"))+
geom_line(aes(date, y= 12), linetype= "dotted", size = 0.1)+
theme(axis.title.x = element_blank())
I need to get a legend which would explain the traffic light system (red is danger, etc) and manually added threshold risk line.
Add your color variable to the dataset, map to that variable inside aes, and use scale_*_identity to directly use the colors.
risk_accum$color_var <- NA
risk_accum$color_var[risk_accum$risk<6] <- "green4"
risk_accum$color_var[risk_accum$risk>=6 & risk_accum$risk<12] <- "yellow2"
risk_accum$color_var[risk_accum$risk>=12] <- "red"
ggplot(risk_accum)+
geom_line(aes(x = date, y = risk, color = color_var)) +
scale_y_continuous(name = "EBH accumulation")+
scale_color_identity(guide = 'legend') +
geom_line(aes(date, y= 12), linetype= "dotted", size = 0.1)+
theme(axis.title.x = element_blank())
You can also add your threshold to the legend:
ggplot(risk_accum)+
geom_line(aes(x = date, y = risk, color = color_var)) +
geom_line(aes(date, y= 12, linetype = "threshold"), size = 0.1)+
scale_y_continuous(name = "EBH accumulation")+
scale_color_identity(guide = 'legend') +
scale_linetype_manual(values = 2) +
theme(axis.title.x = element_blank())
I am trying to move the position of x-ticks and x-labels from the bottom of the figure to its top.
In addition, my data has a bunch of NAs. Currently, levelplot just remove them and leave them as white space in the plot. I wondering if it is possible to add this NAs to the legend as well.
Any suggestions? Thanks!
Here is my code and its output:
require(lattice)
# see data from dput() below
rownames(data)=data[,1]
data_matrix=as.matrix(data[,2:11])
color = colorRampPalette(rev(c("#D73027", "#FC8D59", "#FEE090", "#FFFFBF", "#E0F3F8", "#91BFDB", "#4575B4")))(100)
levelplot(data_matrix, scale=list(x=list(rot=45)), ylab="Days", xlab="Strains", col.regions = color)
Data
data <-
structure(list(X = structure(1:17, .Label = c("Arcobacter", "Bacillus",
"Bordetella", "Campylobacter", "Chlamydia", "Clostridium ", "Corynebacterium",
"Enterococcus", "Escherichia", "Francisella", "Legionella", "Mycobacterium",
"Pseudomonas", "Rickettsia", "Staphylococcus", "Streptococcus",
"Treponema"), class = "factor"), day.0 = c(NA, -3.823301154,
NA, NA, NA, -3.518606107, NA, NA, NA, NA, NA, -4.859479387, NA,
NA, NA, -2.588402346, -2.668136603), day.2 = c(-4.006281239,
-3.024823788, NA, -5.202804501, NA, -3.237622321, NA, NA, -5.296138823,
-5.105469059, NA, NA, -4.901775198, NA, NA, -2.979144202, -3.050083791
), day.4 = c(-2.880770182, -3.210165554, -4.749097175, -5.209064234,
NA, -2.946480184, NA, -5.264113795, -5.341881713, -4.435780293,
NA, -4.810650076, -4.152531609, NA, NA, -3.106172794, -3.543161966
), day.6 = c(-2.869833226, -3.293283924, -3.831346387, NA, NA,
-3.323947791, NA, NA, NA, NA, NA, -4.397581863, -4.068855504,
NA, NA, -3.27028378, -3.662618619), day.8 = c(-3.873589331, -3.446192193,
-3.616207965, NA, NA, -3.13869325, NA, -5.010807453, NA, NA,
NA, -4.091502649, -4.412399025, -4.681675749, NA, -3.404738625,
-3.955464159), day.15 = c(-5.176583159, -2.512963066, -3.392832457,
NA, NA, -3.194662968, NA, -3.60440455, NA, NA, -4.875554468,
-2.507376205, -4.727255906, -5.27116754, -3.200499549, -3.361296145,
-4.320554841), day.22 = c(-4.550052847, -3.654013004, -3.486879661,
NA, NA, -3.614890858, NA, NA, NA, NA, -4.706690492, -2.200533317,
-4.836957953, NA, -4.390423731, NA, NA), day.29 = c(-4.730006329,
-3.46707372, -3.594457287, NA, NA, -3.800757834, NA, NA, NA,
NA, -4.285154089, -2.121152491, -4.816807055, -5.064577888, -2.945243736,
-4.479177287, -5.226435146), day.43 = c(-4.398680025, -3.144603215,
-3.642065153, NA, NA, -3.8268662, NA, NA, NA, NA, -4.762539208,
-2.156862316, -4.118608495, NA, -4.030291084, -4.678213147, NA
), day.57 = c(-4.689982547, -2.713502214, -3.51279797, NA, -5.069579266,
-3.495580794, NA, NA, NA, NA, -4.515973639, -1.90591075, -4.134826117,
-4.479351427, -3.482134037, -4.538534489, NA)), .Names = c("X",
"day.0", "day.2", "day.4", "day.6", "day.8", "day.15", "day.22",
"day.29", "day.43", "day.57"), class = "data.frame", row.names = c("Arcobacter",
"Bacillus", "Bordetella", "Campylobacter", "Chlamydia", "Clostridium ",
"Corynebacterium", "Enterococcus", "Escherichia", "Francisella",
"Legionella", "Mycobacterium", "Pseudomonas", "Rickettsia", "Staphylococcus",
"Streptococcus", "Treponema"))
Figure
The request to move the labels to the top is pretty easy (after looking at the ?xyplot under the scales section):
levelplot(data_matrix, scale=list(x=list(rot=45,alternating=2)),
ylab="Days", xlab="Strains", col.regions = color)
Trying to get the NA values into the color legend may take a bit more thinking, but it seems as though sensible values for the colorkey arguments for at and col might suffice.
levelplot(data_matrix, scale=list(x=list(rot=45,alternating=2)),
ylab="Days", xlab="Strains", col.regions = color,
colorkey=list(at=as.numeric( factor( c( seq(-5.5, -2, by=0.5),
"NA"))),
labels=as.character( c( seq(-5.5, -2, by=0.5),
"NA")),
col=c(color, "#FFFFFF") ) )