How to plot wind direction with lat lon and arrow in ggplot2 - r

I have a data frame with Lat Lon mean_wind and wind_dir in each grid cells.
I am trying to make a spatial plot with mean wind in background and wind direction as arrow on each grid cells.
I have tried following on sample data-frame wind.dt
win.plt<- ggplot(wind.dt,aes(x=Lon,y=Lat))+
#Mean wind plot : OK
geom_tile(aes(fill=mean_wind),alpha=1)+
geom_tile(aes(color=mean_wind), fill=NA) +
scale_fill_gradientn(colours=(brewer.pal(9,rev("RdYlGn"))))+
scale_color_gradientn(colours=(brewer.pal(9,rev("RdYlGn"))),guide=F)
#Wind Direction : doesnot work
geom_segment(arrow = arrow(),aes(yend = Lon + wind_dir, xend = Lat + wind_dir))
win.plt
wind.dt<-structure(list(Lon = c(170.25, 171, 171.75, 172.5, 173.25, 174,
174.75, 175.5, 176.25, 177, 177.75, 178.5, 179.25, 180, 180.75,
181.5, 182.25, 183, 183.75, 184.5, 185.25, 186, 186.75, 187.5,
188.25, 189, 189.75, 190.5, 191.25, 192, 192.75, 193.5, 194.25,
170.25, 171, 171.75, 172.5, 173.25, 174, 174.75, 175.5, 176.25,
177, 177.75, 178.5, 179.25, 180, 180.75, 181.5, 182.25, 183,
183.75, 184.5, 185.25, 186, 186.75, 187.5, 188.25, 189, 189.75,
190.5, 191.25, 192, 192.75, 193.5, 194.25, 170.25, 171, 171.75,
172.5, 173.25, 174, 174.75, 175.5, 176.25, 177, 177.75, 178.5,
179.25, 180, 180.75, 181.5, 182.25, 183, 183.75, 184.5, 185.25,
186, 186.75, 187.5, 188.25, 189, 189.75, 190.5, 191.25, 192,
192.75, 193.5, 194.25, 170.25, 171, 171.75, 172.5, 173.25, 174,
174.75, 175.5, 176.25, 177, 177.75, 178.5, 179.25, 180, 180.75,
181.5, 182.25, 183, 183.75, 184.5, 185.25, 186, 186.75, 187.5,
188.25, 189, 189.75, 190.5, 191.25, 192, 192.75, 193.5, 194.25,
170.25, 171, 171.75, 172.5, 173.25, 174, 174.75, 175.5, 176.25,
177, 177.75, 178.5, 179.25, 180, 180.75, 181.5, 182.25, 183,
183.75, 184.5, 185.25, 186, 186.75, 187.5, 188.25, 189, 189.75,
190.5, 191.25, 192, 192.75, 193.5, 194.25, 170.25, 171, 171.75,
172.5, 173.25, 174, 174.75, 175.5, 176.25, 177, 177.75, 178.5,
179.25, 180, 180.75, 181.5, 182.25, 183, 183.75, 184.5, 185.25,
186, 186.75, 187.5, 188.25, 189, 189.75, 190.5, 191.25, 192,
192.75, 193.5, 194.25), Lat = c(14.25, 14.25, 14.25, 14.25, 14.25,
14.25, 14.25, 14.25, 14.25, 14.25, 14.25, 14.25, 14.25, 14.25,
14.25, 14.25, 14.25, 14.25, 14.25, 14.25, 14.25, 14.25, 14.25,
14.25, 14.25, 14.25, 14.25, 14.25, 14.25, 14.25, 14.25, 14.25,
14.25, 13.5, 13.5, 13.5, 13.5, 13.5, 13.5, 13.5, 13.5, 13.5,
13.5, 13.5, 13.5, 13.5, 13.5, 13.5, 13.5, 13.5, 13.5, 13.5, 13.5,
13.5, 13.5, 13.5, 13.5, 13.5, 13.5, 13.5, 13.5, 13.5, 13.5, 13.5,
13.5, 13.5, 12.75, 12.75, 12.75, 12.75, 12.75, 12.75, 12.75,
12.75, 12.75, 12.75, 12.75, 12.75, 12.75, 12.75, 12.75, 12.75,
12.75, 12.75, 12.75, 12.75, 12.75, 12.75, 12.75, 12.75, 12.75,
12.75, 12.75, 12.75, 12.75, 12.75, 12.75, 12.75, 12.75, 12, 12,
12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12,
12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 11.25,
11.25, 11.25, 11.25, 11.25, 11.25, 11.25, 11.25, 11.25, 11.25,
11.25, 11.25, 11.25, 11.25, 11.25, 11.25, 11.25, 11.25, 11.25,
11.25, 11.25, 11.25, 11.25, 11.25, 11.25, 11.25, 11.25, 11.25,
11.25, 11.25, 11.25, 11.25, 11.25, 10.5, 10.5, 10.5, 10.5, 10.5,
10.5, 10.5, 10.5, 10.5, 10.5, 10.5, 10.5, 10.5, 10.5, 10.5, 10.5,
10.5, 10.5, 10.5, 10.5, 10.5, 10.5, 10.5, 10.5, 10.5, 10.5, 10.5,
10.5, 10.5, 10.5, 10.5, 10.5, 10.5), mean_wind = c(8.34, 8.33,
8.31, 8.29, 8.27, 8.24, 8.22, 8.2, 8.19, 8.16, 8.14, 8.13, 8.1,
8.08, 8.06, 8.02, 7.99, 7.96, 7.93, 7.89, 7.85, 7.81, 7.78, 7.73,
7.7, 7.67, 7.63, 7.62, 7.6, 7.58, 7.56, 7.53, 7.54, 8.65, 8.64,
8.61, 8.59, 8.56, 8.53, 8.51, 8.48, 8.46, 8.43, 8.41, 8.39, 8.38,
8.37, 8.33, 8.31, 8.28, 8.24, 8.2, 8.15, 8.12, 8.07, 8.03, 8.01,
7.97, 7.94, 7.92, 7.89, 7.87, 7.85, 7.85, 7.83, 7.8, 8.85, 8.84,
8.81, 8.8, 8.77, 8.74, 8.72, 8.69, 8.67, 8.65, 8.63, 8.61, 8.59,
8.58, 8.55, 8.54, 8.5, 8.46, 8.44, 8.4, 8.37, 8.33, 8.29, 8.26,
8.21, 8.18, 8.16, 8.13, 8.12, 8.09, 8.06, 8.06, 8.03, 9.01, 8.99,
8.96, 8.94, 8.91, 8.89, 8.86, 8.83, 8.82, 8.79, 8.78, 8.77, 8.75,
8.75, 8.73, 8.7, 8.68, 8.66, 8.63, 8.59, 8.55, 8.52, 8.47, 8.43,
8.4, 8.38, 8.35, 8.32, 8.31, 8.29, 8.26, 8.25, 8.23, 9.07, 9.06,
9.04, 9.01, 8.99, 8.97, 8.94, 8.92, 8.91, 8.9, 8.89, 8.88, 8.88,
8.87, 8.86, 8.84, 8.83, 8.8, 8.75, 8.74, 8.7, 8.67, 8.63, 8.59,
8.57, 8.53, 8.52, 8.51, 8.47, 8.47, 8.45, 8.42, 8.41, 9.1, 9.08,
9.06, 9.04, 9.02, 9, 8.98, 8.97, 8.96, 8.96, 8.95, 8.95, 8.97,
8.96, 8.96, 8.94, 8.91, 8.89, 8.86, 8.84, 8.8, 8.76, 8.73, 8.69,
8.67, 8.64, 8.63, 8.63, 8.61, 8.59, 8.57, 8.54, 8.53), wind_dir = c(81.27,
81.34, 81.38, 81.44, 81.47, 81.34, 81.31, 81.51, 81.56, 81.46,
81.54, 81.53, 81.42, 81.53, 81.66, 81.76, 81.86, 81.96, 82.02,
82.28, 82.65, 82.77, 83.07, 83.46, 83.78, 84.15, 84.52, 84.92,
85.39, 85.87, 86.15, 86.38, 86.53, 81.34, 81.34, 81.38, 81.31,
81.2, 81.25, 81.39, 81.36, 81.31, 81.4, 81.47, 81.48, 81.59,
81.64, 81.58, 81.62, 81.75, 81.98, 82.13, 82.26, 82.52, 82.77,
82.97, 83.15, 83.49, 83.74, 84.23, 84.78, 85.04, 85.49, 85.73,
86.05, 86.35, 81.5, 81.41, 81.32, 81.28, 81.32, 81.31, 81.24,
81.17, 81.28, 81.33, 81.24, 81.3, 81.44, 81.46, 81.55, 81.76,
81.8, 81.88, 82.11, 82.31, 82.4, 82.61, 82.88, 82.95, 83.29,
83.59, 83.93, 84.46, 84.8, 85.26, 85.47, 85.78, 86.11, 81.3,
81.29, 81.29, 81.28, 81.32, 81.22, 81.24, 81.32, 81.31, 81.23,
81.34, 81.47, 81.37, 81.42, 81.5, 81.6, 81.78, 81.98, 82.06,
82.26, 82.49, 82.52, 82.7, 82.79, 83.05, 83.46, 83.79, 84.18,
84.5, 84.91, 85.23, 85.49, 85.7, 81.31, 81.33, 81.28, 81.19,
81.26, 81.29, 81.36, 81.24, 81.16, 81.18, 81.23, 81.23, 81.23,
81.47, 81.5, 81.55, 81.73, 81.99, 82.14, 82.18, 82.41, 82.46,
82.63, 82.83, 82.97, 83.27, 83.62, 84.01, 84.34, 84.64, 85.01,
85.38, 85.55, 81.14, 81.14, 81.1, 81.15, 81.2, 81.1, 81.14, 81.06,
81.21, 81.26, 81.13, 81.16, 81.17, 81.22, 81.28, 81.63, 81.71,
81.77, 82.13, 82.22, 82.37, 82.48, 82.56, 82.7, 82.92, 83.19,
83.43, 83.74, 84.15, 84.59, 84.89, 85.22, 85.39)), row.names = c(NA,
-198L), .Names = c("Lon", "Lat", "mean_wind", "wind_dir"), class = c("tbl_df",
"tbl", "data.frame"))

geom_spoke was made for this particular sort of plot. Cleaned up a little,
library(ggplot2)
ggplot(wind.dt,
aes(x = Lon ,
y = Lat,
fill = mean_wind,
angle = wind_dir,
radius = scales::rescale(mean_wind, c(.2, .8)))) +
geom_raster() +
geom_spoke(arrow = arrow(length = unit(.05, 'inches'))) +
scale_fill_distiller(palette = "RdYlGn") +
coord_equal(expand = 0) +
theme(legend.position = 'bottom',
legend.direction = 'horizontal')
Adjust scaling and sizes as desired.
Edit: Controlling the number of arrows
To adjust the number of arrows, a quick-and-dirty route is to subset one of the aesthetics passed to geom_spoke with a recycling vector that will cause some rows to be dropped, e.g.
library(ggplot2)
ggplot(wind.dt,
aes(x = Lon ,
y = Lat,
fill = mean_wind,
angle = wind_dir[c(TRUE, NA, NA, NA, NA)], # causes some values not to plot
radius = scales::rescale(mean_wind, c(.2, .8)))) +
geom_raster() +
geom_spoke(arrow = arrow(length = unit(.05, 'inches'))) +
scale_fill_distiller(palette = "RdYlGn") +
coord_equal(expand = 0) +
theme(legend.position = 'bottom',
legend.direction = 'horizontal')
#> Warning: Removed 158 rows containing missing values (geom_spoke).
This depends on your data frame being in order and is not infinitely flexible, but if it gets you a nice plot with minimal effort, can be useless nonetheless.
A more robust approach is to make a subsetted data frame for use by geom_spoke, say, selecting every other value of Lon and Lat, here using recycling subsetting on a vector of distinct values:
library(dplyr)
wind.arrows <- wind.dt %>%
filter(Lon %in% sort(unique(Lon))[c(TRUE, FALSE)],
Lat %in% sort(unique(Lat))[c(TRUE, FALSE)])
ggplot(wind.dt,
aes(x = Lon ,
y = Lat,
fill = mean_wind,
angle = wind_dir,
radius = scales::rescale(mean_wind, c(.2, .8)))) +
geom_raster() +
geom_spoke(data = wind.arrows, # this is the only difference in the plotting code
arrow = arrow(length = unit(.05, 'inches'))) +
scale_fill_distiller(palette = "RdYlGn") +
coord_equal(expand = 0) +
theme(legend.position = 'bottom',
legend.direction = 'horizontal')
This approach makes getting (and scaling) a grid fairly easy, but getting a diamond pattern will take a bit more logic:
wind.arrows <- wind.dt %>%
filter(( Lon %in% sort(unique(Lon))[c(TRUE, FALSE)] &
Lat %in% sort(unique(Lat))[c(TRUE, FALSE)] ) |
( Lon %in% sort(unique(Lon))[c(FALSE, TRUE)] &
Lat %in% sort(unique(Lat))[c(FALSE, TRUE)] ))

Related

GGplot + Shiny changing a line color based off slope of line

I am trying to have multiple lines each of which changes between red and green depending on its slope. So if one changes from positive to negative it will change from green to red at that point. I have tried splitting the data so that red lines are formed between negative points and vice versa for green, but I encounter a problem. When a line goes from positive to negative back to positive; it is red. This is because red needs to know all points in that sequence to build the red lines but I want to avoid it connecting the positive slope line with red. An example of this is the bottom line in the below graph at Mar 15 I don't know if it makes a difference but I am using shiny whit ggplot.
output$pen_performance_graphs <- renderPlotly({
#subsets data to date range selected
#five_year_disp <-subset(five_year_weekly, as.Date(Date)>=input$pen_dates[1]&date<=input$pen_dates[2])
five_year_disp <- five_year_weekly[five_year_weekly$Date >= input$pen_dates[1],]
five_year_disp <- five_year_disp[five_year_disp$Date <= input$pen_dates[2],]
ggp <- ggplot(five_year_disp, aes(x = as.Date(Date), y = Yeild,
label = Date,
label2 = Animal_ID,
label3 = Precent_Change,
label4 = Yeild,
label5 = Treatment,
group = Animal_ID,xmin = as.Date(input$pen_dates[1], "%Y-%m-%d"),
xmax = as.Date(input$pen_dates[2], "%Y-%m-%d"),)) +
geom_line() +
#GREEN LINES
geom_line(data=five_year_disp, aes(x=as.Date(Date), y=posY, col="green")) +
#RED LINES
geom_line(data=five_year_disp, aes(x=as.Date(Date), y=negY, col="red")) +
scale_color_identity() +
geom_point() +
labs(x = "Date", y = "Milk Yeild (LBS)")
#ggp <- ggp + scale_x_date(limits = as.Date(c(input$pen_dates[1], input$pen_dates[2])), date_breaks = "month")
p <- ggplotly(ggp, tooltip = c("label", "label2", "label3", "label4", "label5"))
p
})
dput(five_year_disp)
structure(list(Animal_ID = c(578L, 578L, 578L, 578L, 578L, 578L,
578L, 578L, 578L, 578L, 578L, 578L, 578L, 579L, 579L, 579L, 579L,
579L, 579L, 579L, 579L, 579L, 579L, 579L, 579L, 579L, 618L, 618L,
618L, 618L, 618L, 618L, 618L, 618L, 618L, 618L, 618L, 618L, 618L,
5082L, 5082L, 5082L, 5082L, 5082L, 5082L, 5082L, 5082L, 5082L,
5082L, 5082L, 5082L, 5082L, 5451L, 5451L, 5451L, 5451L, 5451L,
5451L, 5451L, 5451L, 5451L, 5451L, 5451L, 5451L, 5451L, 5570L,
5570L, 5570L, 5570L, 5570L, 5570L, 5570L, 5570L, 5570L, 5570L,
5570L, 5570L, 5570L, 5836L, 5836L, 5836L, 5836L, 5836L, 5836L,
5836L, 5836L, 5836L, 5836L, 5836L, 5836L, 5836L, 5842L, 5842L,
5842L, 5842L, 5842L, 5842L, 5842L, 5842L, 5842L, 5842L, 5842L,
5842L, 5842L, 5868L, 5868L, 5868L, 5868L, 5868L, 5868L, 5868L,
5868L, 5868L, 5868L, 5868L, 5868L, 5868L, 5883L, 5883L, 5883L,
5883L, 5883L, 5883L, 5883L, 5883L, 5883L, 5883L, 5883L, 5883L,
5883L), Date = c("2021/02/08", "2021/02/13", "2021/02/20", "2021/02/27",
"2021/03/01", "2021/03/08", "2021/03/13", "2021/03/20", "2021/03/27",
"2021/04/01", "2021/04/08", "2021/04/13", "2021/04/20", "2021/02/08",
"2021/02/13", "2021/02/20", "2021/02/27", "2021/03/01", "2021/03/08",
"2021/03/13", "2021/03/20", "2021/03/27", "2021/04/01", "2021/04/08",
"2021/04/13", "2021/04/20", "2021/02/08", "2021/02/13", "2021/02/20",
"2021/02/27", "2021/03/01", "2021/03/08", "2021/03/13", "2021/03/20",
"2021/03/27", "2021/04/01", "2021/04/08", "2021/04/13", "2021/04/20",
"2021/02/08", "2021/02/13", "2021/02/20", "2021/02/27", "2021/03/01",
"2021/03/08", "2021/03/13", "2021/03/20", "2021/03/27", "2021/04/01",
"2021/04/08", "2021/04/13", "2021/04/20", "2021/02/08", "2021/02/13",
"2021/02/20", "2021/02/27", "2021/03/01", "2021/03/08", "2021/03/13",
"2021/03/20", "2021/03/27", "2021/04/01", "2021/04/08", "2021/04/13",
"2021/04/20", "2021/02/08", "2021/02/13", "2021/02/20", "2021/02/27",
"2021/03/01", "2021/03/08", "2021/03/13", "2021/03/20", "2021/03/27",
"2021/04/01", "2021/04/08", "2021/04/13", "2021/04/20", "2021/02/08",
"2021/02/13", "2021/02/20", "2021/02/27", "2021/03/01", "2021/03/08",
"2021/03/13", "2021/03/20", "2021/03/27", "2021/04/01", "2021/04/08",
"2021/04/13", "2021/04/20", "2021/02/08", "2021/02/13", "2021/02/20",
"2021/02/27", "2021/03/01", "2021/03/08", "2021/03/13", "2021/03/20",
"2021/03/27", "2021/04/01", "2021/04/08", "2021/04/13", "2021/04/20",
"2021/02/08", "2021/02/13", "2021/02/20", "2021/02/27", "2021/03/01",
"2021/03/08", "2021/03/13", "2021/03/20", "2021/03/27", "2021/04/01",
"2021/04/08", "2021/04/13", "2021/04/20", "2021/02/08", "2021/02/13",
"2021/02/20", "2021/02/27", "2021/03/01", "2021/03/08", "2021/03/13",
"2021/03/20", "2021/03/27", "2021/04/01", "2021/04/08", "2021/04/13",
"2021/04/20"), Yeild_gr = c(50670, 46065, 40101, 32613, 37695,
37036, 30634, 33787, 31460, 30826, 26050, 27395, 28957, 38375,
40061, 34028, 25966, 28609, 33850, 27921, 31511, 30946, 28963,
26031, 27421, 27754, 49306, 51508, 44800, 37900, 41330, 44519,
38556, 41680, 43477, 40167, 32131, 39124, 40348, 50872, 49346,
42075, 45195, 44415, 46700, 44372, 44211, 39444, 37177, 39067,
36270, 37110, 52265, 45753, 42932, 40839, 39943, 43049, 42969,
44352, 43141, 35598, 30473, 29328, 29415, 42137, 39911, 33229,
28658, 29314, 42391, 31544, 35591, 32331, 31842, 21259, 27222,
21272, 33986, 36264, 28851, 34661, 32127, 32005, 27759, 29025,
27663, 26708, 26692, 26025, 24856, 32255, 30794, 29464, 32200,
32139, 26482, 24468, 26563, 25800, 24214, 21352, 23367, 20130,
38088, 39296, 35180, 35936, 39282, 37509, 38335, 33096, 38771,
36884, 34456, 29630, 34145, 44728, 51297, 39168, 45407, 50389,
45554, 47758, 48574, 47675, 34608, 43766, 37066, 40068), Conductivity = c(9.8,
9.6, 10.4, 10.8, 10.4, 10, 10.4, 10.2, 10.2, 10.6, 10.1, 10.5,
10, 9.9, 9.6, 11.1, 9.9, 9.9, 10.1, 10.5, 9.8, 10.3, 11.6, 10.8,
12.1, 10.7, 8.6, 8.8, 8.8, 9.1, 10.2, 8.9, 9, 8.8, 8.8, 9.8,
8.4, 10.1, 8.8, 10, 9.7, 9.7, 10.1, 10.1, 9.9, 9.7, 10, 10.2,
9.8, 9.8, 10.2, 9.9, 8.5, 8.9, 8.9, 9, 8.8, 8.7, 8.9, 8.8, 8.6,
8.5, 8.8, 8.6, 8.8, 10.1, 10.7, 10.8, 11.4, 10.5, 10.1, 10.7,
10.3, 10.2, 10.2, 10.5, 11.1, 11.4, 8.4, 9, 9, 8.6, 9.2, 8.6,
9, 9.2, 8.7, 9.6, 9.4, 9.3, 9.3, 9.9, 8.4, 10.5, 11.2, 9.7, 8.5,
9.6, 10.3, 8.9, 10.3, 10.6, 10.5, 9.9, 8.7, 8.7, 9.1, 9.4, 9.1,
8.6, 8.9, 8.9, 9.1, 9.2, 9.3, 9.6, 9.1, 10.3, 9.6, 10.3, 10.6,
10.5, 10.4, 10.8, 9.9, 9.3, 10, 10, 10.6, 10.3), FatPct = c(4.7,
4.4, 5.1, 4.5, 5.1, 4.6, 5, 5, 5.2, 4.6, 4.8, 4.8, 4.9, 4.2,
4.4, 4.5, 4.4, 4.7, 4.8, 4.8, 4.6, 3.9, 5.3, 5.2, 5.1, 4.3, 4.1,
3.9, 3.8, 4.2, 4, 4.5, 4.2, 4, 4.6, 4.2, 4.8, 4.1, 4.2, 4.2,
3.6, 4.2, 4, 3.6, 3.6, 3.4, 3.5, 3.9, 3.9, 4.2, 4.4, 4.1, 3.7,
4.7, 5.2, 4.6, 4.3, 5.1, 3.8, 4, 4.2, 6, 5.4, 5.4, 5.4, 3.2,
4.8, 3.5, 3.7, 5.1, 3.9, 4.6, 3.5, 3.7, 4, 3.9, 4.1, 3.7, 3.9,
3.9, 4.3, 4.1, 3.9, 4.9, 4.1, 4.1, 3.9, 4.1, 4.2, 4.7, 3.8, 3.6,
4.3, 4.1, 3.7, 3.4, 3.9, 3.4, 4.6, 3.6, 3.5, 4, 3.5, 4.2, 5.2,
5.7, 5.8, 4.9, 5.5, 5.5, 4.5, 5.4, 6, 4.5, 5.6, 6.5, 4.5, 4.2,
4, 3.8, 4.7, 4.3, 4, 4.9, 3.6, 4, 4.3, 4.2, 4.3, 3.9), ProPct = c(3,
3.1, 3.8, 4, 3.2, 3.9, 2.8, 3.2, 3.3, 3.1, 4, 3, 3.4, 4.3, 4.1,
3.7, 4.4, 3.5, 2.7, 3.2, 3.9, 3.8, 2.9, 2.9, 3, 3.2, 3.5, 3.7,
3.2, 3.6, 3.6, 3.1, 3.9, 3.4, 2.8, 3.9, 4.2, 4, 4.2, 3.4, 4.7,
2.8, 3.8, 3.5, 4.4, 4.2, 4.1, 3.5, 4.3, 3.9, 3.6, 3.7, 4.2, 4.6,
3.6, 3.1, 3.7, 3.4, 4.1, 4.4, 4.1, 3.6, 3.4, 3.9, 3.4, 4.3, 4,
4.7, 4.5, 4, 3.9, 4.1, 4.1, 4.5, 3.7, 4.4, 4, 4.3, 3.7, 3.8,
3.2, 2.9, 3.8, 3.5, 3.6, 4.2, 3.7, 3.8, 3, 3.3, 3.8, 4.1, 3.1,
3.9, 4.3, 4.1, 3.6, 4.2, 3.4, 3.1, 4, 4.1, 3.4, 3.3, 3.7, 4.9,
4.4, 3.7, 4.3, 2.9, 3.3, 4, 2.7, 4.3, 4.4, 4, 4.3, 3.6, 3.3,
3.7, 2.7, 3.3, 2.5, 3.1, 3.1, 3.2, 4.3, 3.5, 2.6, 3), Yeild = c(111.71,
101.56, 88.41, 71.9, 83.1, 81.65, 67.54, 74.49, 69.36, 67.96,
57.43, 60.4, 63.84, 84.6, 88.32, 75.02, 57.25, 63.07, 74.63,
61.56, 69.47, 68.22, 63.85, 57.39, 60.45, 61.19, 108.7, 113.56,
98.77, 83.56, 91.12, 98.15, 85, 91.89, 95.85, 88.55, 70.84, 86.25,
88.95, 112.15, 108.79, 92.76, 99.64, 97.92, 102.96, 97.82, 97.47,
86.96, 81.96, 86.13, 79.96, 81.81, 115.22, 100.87, 94.65, 90.03,
88.06, 94.91, 94.73, 97.78, 95.11, 78.48, 67.18, 64.66, 64.85,
92.9, 87.99, 73.26, 63.18, 64.63, 93.46, 69.54, 78.46, 71.28,
70.2, 46.87, 60.01, 46.9, 74.93, 79.95, 63.61, 76.41, 70.83,
70.56, 61.2, 63.99, 60.99, 58.88, 58.85, 57.38, 54.8, 71.11,
67.89, 64.96, 70.99, 70.85, 58.38, 53.94, 58.56, 56.88, 53.38,
47.07, 51.52, 44.38, 83.97, 86.63, 77.56, 79.23, 86.6, 82.69,
84.51, 72.96, 85.48, 81.32, 75.96, 65.32, 75.28, 98.61, 113.09,
86.35, 100.11, 111.09, 100.43, 105.29, 107.09, 105.11, 76.3,
96.49, 81.72, 88.33), Treatment = c(78, 73, 66, 59, 57, 50, 45,
38, 31, 26, 19, 14, 7, 78, 73, 66, 59, 57, 50, 45, 38, 31, 26,
19, 14, 7, 78, 73, 66, 59, 57, 50, 45, 38, 31, 26, 19, 14, 7,
78, 73, 66, 59, 57, 50, 45, 38, 31, 26, 19, 14, 7, 78, 73, 66,
59, 57, 50, 45, 38, 31, 26, 19, 14, 7, 78, 73, 66, 59, 57, 50,
45, 38, 31, 26, 19, 14, 7, 78, 73, 66, 59, 57, 50, 45, 38, 31,
26, 19, 14, 7, 78, 73, 66, 59, 57, 50, 45, 38, 31, 26, 19, 14,
7, 78, 73, 66, 59, 57, 50, 45, 38, 31, 26, 19, 14, 7, 78, 73,
66, 59, 57, 50, 45, 38, 31, 26, 19, 14, 7), Precent_Change = c("12.6",
"-9.1", "-12.9", "-18.7", "15.6", "-1.7", "-17.3", "10.3", "-6.9",
"-2.0", "-15.5", "5.2", "5.7", "-0.2", "4.4", "-15.1", "-23.7",
"10.2", "18.3", "-17.5", "12.8", "-1.8", "-6.4", "-10.1", "5.3",
"1.2", "-9.4", "4.5", "-13.0", "-15.4", "9.0", "7.7", "-13.4",
"8.1", "4.3", "-7.6", "-20.0", "21.8", "3.1", "-4.0", "-3.0",
"-14.7", "7.4", "-1.7", "5.1", "-5.0", "-0.4", "-10.8", "-5.7",
"5.1", "-7.2", "2.3", "4.7", "-12.5", "-6.2", "-4.9", "-2.2",
"7.8", "-0.2", "3.2", "-2.7", "-17.5", "-14.4", "-3.8", "0.3",
"14.7", "-5.3", "-16.7", "-13.8", "2.3", "44.6", "-25.6", "12.8",
"-9.2", "-1.5", "-33.2", "28.0", "-21.8", "3.6", "6.7", "-20.4",
"20.1", "-7.3", "-0.4", "-13.3", "4.6", "-4.7", "-3.5", "-0.1",
"-2.5", "-4.5", "4.1", "-4.5", "-4.3", "9.3", "-0.2", "-17.6",
"-7.6", "8.6", "-2.9", "-6.2", "-11.8", "9.5", "-13.9", "4.0",
"3.2", "-10.5", "2.2", "9.3", "-4.5", "2.2", "-13.7", "17.2",
"-4.9", "-6.6", "-14.0", "15.2", "-6.2", "14.7", "-23.6", "15.9",
"11.0", "-9.6", "4.8", "1.7", "-1.8", "-27.4", "26.5", "-15.3",
"8.1"), posY = c(111.71, NA, NA, 71.9, 83.1, NA, 67.54, 74.49,
NA, NA, 57.43, 60.4, 63.84, 84.6, 88.32, NA, 57.25, 63.07, 74.63,
61.56, 69.47, NA, NA, 57.39, 60.45, 61.19, 108.7, 113.56, NA,
83.56, 91.12, 98.15, 85, 91.89, 95.85, NA, 70.84, 86.25, 88.95,
NA, NA, 92.76, 99.64, 97.92, 102.96, NA, NA, NA, 81.96, 86.13,
79.96, 81.81, 115.22, NA, NA, NA, 88.06, 94.91, 94.73, 97.78,
NA, NA, NA, 64.66, 64.85, 92.9, NA, NA, 63.18, 64.63, 93.46,
69.54, 78.46, NA, NA, 46.87, 60.01, 46.9, 74.93, 79.95, 63.61,
76.41, NA, NA, 61.2, 63.99, NA, NA, NA, NA, 54.8, 71.11, NA,
64.96, 70.99, NA, NA, 53.94, 58.56, NA, NA, 47.07, 51.52, 44.38,
83.97, 86.63, 77.56, 79.23, 86.6, 82.69, 84.51, 72.96, 85.48,
NA, NA, 65.32, 75.28, 98.61, 113.09, 86.35, 100.11, 111.09, 100.43,
105.29, 107.09, NA, 76.3, 96.49, 81.72, 88.33), negY = c(111.71,
101.56, 88.41, 71.9, 83.1, 81.65, 67.54, 74.49, 69.36, 67.96,
57.43, NA, NA, 84.6, 88.32, 75.02, 57.25, NA, 74.63, 61.56, 69.47,
68.22, 63.85, 57.39, NA, NA, 108.7, 113.56, 98.77, 83.56, NA,
98.15, 85, NA, 95.85, 88.55, 70.84, NA, NA, 112.15, 108.79, 92.76,
99.64, 97.92, 102.96, 97.82, 97.47, 86.96, 81.96, 86.13, 79.96,
NA, 115.22, 100.87, 94.65, 90.03, 88.06, 94.91, 94.73, 97.78,
95.11, 78.48, 67.18, 64.66, NA, 92.9, 87.99, 73.26, 63.18, NA,
93.46, 69.54, 78.46, 71.28, 70.2, 46.87, 60.01, 46.9, NA, 79.95,
63.61, 76.41, 70.83, 70.56, 61.2, 63.99, 60.99, 58.88, 58.85,
57.38, 54.8, 71.11, 67.89, 64.96, 70.99, 70.85, 58.38, 53.94,
58.56, 56.88, 53.38, 47.07, 51.52, 44.38, NA, 86.63, 77.56, NA,
86.6, 82.69, 84.51, 72.96, 85.48, 81.32, 75.96, 65.32, NA, 98.61,
113.09, 86.35, NA, 111.09, 100.43, NA, 107.09, 105.11, 76.3,
96.49, 81.72, NA)), row.names = c(38819L, 35876L, 32913L, 28959L,
27969L, 24993L, 22013L, 19023L, 15022L, 13008L, 8983L, 6986L,
3003L, 38411L, 36285L, 32500L, 29370L, 28382L, 24579L, 22430L,
18606L, 15443L, 12587L, 9399L, 6570L, 3418L, 38818L, 35877L,
32912L, 28960L, 27970L, 24992L, 22014L, 19022L, 15023L, 13007L,
8984L, 6985L, 3004L, 38815L, 35880L, 32909L, 28963L, 27973L,
24989L, 22017L, 19019L, 15026L, 13004L, 8987L, 6982L, 3007L,
38469L, 35976L, 32798L, 29056L, 28066L, 24881L, 22109L, 18905L,
15118L, 12886L, 9076L, 6865L, 3099L, 38794L, 35901L, 32888L,
28984L, 27994L, 24968L, 22038L, 18997L, 15048L, 12982L, 9009L,
6960L, 3029L, 38775L, 35920L, 32869L, 29002L, 28012L, 24950L,
22056L, 18980L, 15065L, 12965L, 9025L, 6944L, 3047L, 38774L,
35921L, 32868L, 29003L, 28013L, 24949L, 22057L, 18979L, 15066L,
12964L, 9026L, 6943L, 3048L, 38769L, 35926L, 32863L, 29008L,
28018L, 24944L, 22062L, 18974L, 15071L, 12959L, 9031L, 6938L,
3053L, 38764L, 35931L, 32858L, 29013L, 28023L, 24939L, 22067L,
18969L, 15076L, 12954L, 9035L, 6934L, 3057L), class = "data.frame")
Here is one solution, based on duplicating the rows where the current direction of yield changes.
library(data.table)
library(ggplot2)
# Set five_year_display as data.table
setDT(five_year_display)
#Order the five year display, and create an row identifier
five_year_display[order(Animal_ID, Date),rowid:=.I]
# Create a version that duplicates rows when the next row changes direction
fyd <- rbindlist(list(
five_year_display,
five_year_display[five_year_display[,dup_row:=sign(Yeild-shift(Yeild,-1))!=sign(shift(Yeild,1)-Yeild), by = Animal_ID][dup_row==TRUE, rowid]]
),idcol = "src")[order(Animal_ID, Date, src)]
# Function to set the colors, based on yield and rowid
# This function first finds the initial direction of the yield,
# sets the color for that direction, and then
# looks at the changes in row id to determine toggle in colors
find_colors <- function(yield, rowid) {
colors=as.numeric(yield[1]>=yield[2])
for(i in seq(2,length(rowid))) {
if(rowid[i]>rowid[i-1]) colors = c(colors, colors[i-1])
else colors = c(colors, 1-colors[i-1])
}
return(colors)
}
# Use function above to assign colors to each row
fyd[,colors:=find_colors(Yeild,rowid), by=Animal_ID]
# create a colorgrp over animal and color, using rleid
fyd[,colorgrp:=rleid(Animal_ID,colors)]
# plot the fyd using the colorgrp in geom_line, and manually setting the color scale
ggplot(fyd, aes(as.Date(Date), Yeild)) +
geom_point()+
geom_line(aes(group=colorgrp,color=factor(colors, labels=c("Increasing", "Decreasing")))) +
scale_color_manual(values=c("green", "red")) +
labs(x = "Date", color="Slope") +
theme(legend.position="bottom")
Here is the resulting plot

R how to lag 4000 columns 50 times

I have a data frame with 4000 columns and daily observations sorted by time. I want to create new columns that lag all existing columns 50 times in the past. So for a column Y create 50 additional columns that are Y-1day,Y-2days,Y-3days...Y-50days.
So far I've wrapped the following loop which does what I need to make.
The issue is that it's not very fast. Is there a more efficient way I can test?
for(i in 2:ncol(Data)){
for(j in 1:50){
Data<- slide(Data, Var = names(Data[i]), slideBy = -j)
}}
I'm attaching a snapshot of my data frame for reproducible example:
structure(list(time = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12,
13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28,
29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44,
45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60,
61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76,
77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92,
93, 94, 95, 96, 97, 98, 99, 100), A = c(17.081545, 16.630901,
16.623749, 16.258942, 16.244635, 16.165951, 15.886981, 15.865522,
15.529327, 15.772532, 16.04435, 15.779685, 15.915594, 15.593705,
15.336195, 15.593705, 15.736767, 15.736767, 15.457797, 15.815451,
16.108727, 16.237482, 15.808297, 16.058655, 16.53791, 16.988556,
16.516453, 16.480686, 16.967096, 17.181688, 17.446352, 17.11731,
16.952789, 16.8598, 16.795422, 16.437769, 16.587982, 16.845493,
17.167381, 17.510729, 17.410587, 17.474964, 17.246065, 17.703863,
17.424892, 17.174536, 17.103004, 16.695278, 16.93133, 16.638054,
16.115879, 16.20887, 15.987124, 16.151646, 16.151646, 16.115879,
16.173105, 16.101574, 16.080114, 15.9299, 15.879828, 15.786839,
15.314735, 15.27897, 15.493563, 15.436337, 15.286123, 15.121602,
15.27897, 14.88555, 14.785408, 14.592275, 14.785408, 14.856938,
14.670959, 15.243204, 15.09299, 15.250358, 15.264664, 15.18598,
14.771102, 14.842632, 15, 15.150214, 15.200286, 15.078684, 15.379113,
15.658083, 15.636623, 15.879828, 15.715307, 15.729613, 15.422031,
16.080114, 16.39485, 16.502146, 16.74535, 16.902718, 17.088697,
16.831188), AAP = c(29.033333, 28.84, 28.893333, 28.866667, 28.700001,
28.799999, 28.973333, 28.866667, 28.806667, 28.973333, 29.713333,
29.033333, 28.626667, 28.546667, 28.173334, 28.166666, 28.24,
28.553333, 28.366667, 28.733334, 28.833334, 28.9, 29.166666,
29.846666, 30.08, 30.093334, 29.673334, 29.860001, 30.053333,
30.186666, 29.833334, 29.673334, 34.533333, 33.82, 33.373333,
33.633335, 33.593334, 33.833332, 33.586666, 33.946667, 34.66,
34.599998, 34.84, 34.779999, 34.093334, 33.713333, 33.560001,
33.933334, 33.086666, 33.139999, 33.279999, 33.200001, 33.259998,
32.466667, 32.713333, 32.686668, 33.053333, 33.806667, 33.333332,
33.613335, 33.633335, 33.799999, 34.206665, 34.5, 34.166668,
34.206665, 33.933334, 34, 34.373333, 33.700001, 33.173332, 32.633335,
32.639999, 34.013332, 33.566666, 34.053333, 34.053333, 34.826668,
35.106667, 35.68, 35.653332, 35.566666, 35.380001, 35.419998,
35.966667, 36.573334, 36.673332, 36.486668, 36.286667, 36.099998,
35.433334, 35.419998, 35.84, 36.533333, 36.779999, 38.98, 39.633335,
39.646667, 39.486668, 39.433334), AAPL = c(4.520714, 4.567143,
4.607143, 4.610714, 4.946429, 4.925714, 4.611429, 4.675714, 4.985714,
5.014286, 5.046429, 4.991428, 5.032857, 5.035, 5.054286, 5.146429,
5.160714, 5.188571, 5.284286, 5.492857, 5.537857, 5.687857, 5.557857,
5.631429, 5.638571, 5.778572, 5.624286, 5.597143, 5.800714, 6.045,
6.315, 6.437857, 6.272143, 6.200714, 6.092143, 6.302143, 6.352143,
6.356429, 6.408571, 6.357143, 6.302857, 5.97, 6.115714, 6.107143,
5.79, 5.621428, 5.69, 5.752857, 5.76, 5.851429, 5.882857, 6.035714,
6.137143, 6.242857, 6.118571, 6.078571, 6.071429, 6.075714, 5.964286,
6.114286, 5.952857, 5.841429, 5.87, 5.984286, 6.047143, 6.222857,
6.248571, 5.988572, 6.094285, 5.862857, 5.322857, 5.05, 5.088572,
5.298572, 5.072857, 5.311429, 5.071429, 5.282857, 5.17, 5.135714,
5.077143, 5.151429, 5.204286, 5.172857, 5.307143, 5.24, 5.32,
5.281428, 5.202857, 5.087143, 4.875714, 4.967143, 5.078571, 5.051429,
5.12, 5.364286, 5.364286, 5.68, 5.671429, 5.682857), ABC = c(14.5375,
14.4225, 14.395, 14.5175, 14.475, 14.475, 14.51, 14.515, 14.275,
14.3175, 14.4875, 14.375, 14.5025, 14.2525, 14.3925, 14.13, 14.47,
14.365, 14.5925, 14.57, 14.74, 14.71, 14.995, 14.9, 14.8625,
15.0325, 14.78, 14.875, 15.085, 15.0525, 15.4275, 15.3075, 14.9225,
15, 14.7025, 14.7975, 15, 15, 14.975, 15.3775, 15.435, 15.5325,
15.6625, 15.6575, 15.695, 15.1275, 15.1025, 15.0775, 15.265,
15.0325, 14.905, 15.1975, 15.215, 15.2025, 15.1025, 15.3775,
15.2775, 13.5075, 13.5275, 13.95, 14.3225, 14.09, 14.4275, 14.735,
14.6475, 14.8, 14.4575, 14.62, 14.7525, 14.7, 14.9, 15.125, 14.83,
14.9525, 14.825, 14.9625, 15, 14.975, 14.9675, 15.0975, 15.0875,
15.32, 15.5125, 15.38, 15.51, 15.575, 15.7475, 15.9975, 15.9175,
15.895, 15.955, 15.98, 16.209999, 16.459999, 16.5725, 16.514999,
16.4925, 16.5, 16.495001, 16.4825), ABMD = c(15.01, 14.98, 14.69,
14.52, 14.29, 14.42, 14.31, 14.17, 12.45, 12.05, 11.87, 11.97,
11.41, 11.16, 11.06, 11.2, 11.1, 11.57, 11.43, 11.88, 11.58,
11.12, 11.16, 11.32, 10.97, 10.88, 10.72, 10.3, 10.75, 10.25,
10.29, 10.41, 10.02, 10.05, 10.08, 10, 10.24, 10.89, 10.7, 10.8,
10.66, 10.71, 11.12, 11.18, 11.2, 10.95, 11.07, 11.12, 11.3,
11.19, 10.83, 10.56, 10.37, 10.47, 10.33, 10.17, 10.51, 10.4,
10.56, 10.74, 10.58, 10.6, 10.57, 10.71, 11.23, 11.28, 11.51,
11.15, 10.98, 10.98, 11.05, 10.76, 10.96, 11.1, 10.62, 11.1,
10.53, 10.69, 10.65, 10.73, 10.15, 10.15, 9.52, 9.6, 9.6, 9.52,
9.47, 9.44, 9.35, 9.27, 9.13, 8.92, 9.26, 9.45, 9.97, 10.25,
10.28, 9.99, 10.16, 10.17), ABT = c(22.392265, 22.166759, 21.912466,
22.40666, 22.790501, 23.011208, 22.588984, 22.517014, 22.085194,
22.19075, 22.089993, 22.09479, 21.95085, 22.061205, 22.037214,
22.027618, 22.018023, 21.811708, 21.720547, 21.600595, 21.854891,
21.898071, 21.907667, 21.840496, 21.874083, 21.725344, 21.667768,
21.581404, 22.166759, 22.305902, 22.488226, 22.469034, 22.339487,
22.26272, 21.802113, 21.946053, 22.243528, 22.200346, 22.066002,
22.051607, 22.099588, 22.075598, 22.267517, 22.382669, 22.310699,
22.02282, 22.209942, 22.070801, 22.128376, 21.907667, 21.792517,
21.365494, 21.336706, 21.048826, 20.996048, 21.39908, 21.562212,
21.677364, 21.95085, 22.430651, 22.368277, 22.161963, 22.157164,
22.646561, 22.843279, 23.19833, 22.963228, 22.91045, 22.98242,
23.049591, 23.169542, 23.927626, 23.500605, 23.111965, 22.69454,
23.078381, 22.824085, 22.920046, 23.001612, 23.255905, 23.073582,
23.586967, 23.692524, 23.634949, 23.850859, 23.601362, 23.519796,
23.543785, 23.438231, 23.634949, 23.567776, 23.395048, 23.735706,
23.706919, 23.678129, 23.529392, 23.452623, 23.366261, 23.351866,
23.145552), ACN = c(26.370001, 25.75, 25.65, 25.42, 26.610001,
26.959999, 26.5, 26.389999, 26.18, 26.290001, 26.1, 26, 25.67,
25.16, 24.9, 25.200001, 25.4, 25.68, 25.6, 26.049999, 25.99,
25.83, 25.48, 25.73, 25.77, 25.85, 25.51, 25.42, 25.200001, 24.639999,
24.9, 25.049999, 24.51, 24.9, 24.799999, 24.709999, 24.48, 25.15,
25.549999, 25.59, 25.42, 25.110001, 25.370001, 25.49, 25.32,
25.17, 24.950001, 24.459999, 24.48, 23.98, 24.030001, 23.950001,
23.66, 24.01, 24.280001, 24.299999, 24.4, 24.57, 24.16, 24.559999,
24.15, 24.440001, 24.35, 24.860001, 24.969999, 24.889999, 23.700001,
23.34, 23.440001, 23.120001, 22.860001, 22.5, 22.57, 22.440001,
21.9, 21.959999, 21.75, 21.85, 21.549999, 21.469999, 21.620001,
21.700001, 21.969999, 22.1, 22.1, 21.82, 22, 22.08, 21.860001,
21.92, 21.99, 22.049999, 22.01, 22.049999, 22.5, 22.790001, 22.719999,
22.76, 22.67, 22.34), ADBE = c(30.844999, 30.030001, 29.865,
29.370001, 29.389999, 29.41, 29.059999, 29.49, 29.110001, 29.115,
29.190001, 28.940001, 29.035, 28.535, 27.695, 27.790001, 28.004999,
28.084999, 27.74, 28.450001, 28.950001, 31.145, 31.709999, 31.995001,
31.76, 31.85, 31.295, 31.34, 31.85, 31.735001, 32.455002, 32.299999,
31.535, 31.415001, 30.754999, 30.875, 30.695, 30.715, 30.875,
31.17, 31.174999, 31.174999, 31.885, 32.535, 32.474998, 32.255001,
32.654999, 32.209999, 32.669998, 32.27, 31.594999, 31.945, 33.904999,
33.349998, 33.18, 33.134998, 33.27, 33.555, 33.110001, 33.865002,
33.584999, 33.380001, 33.290001, 33.424999, 34.049999, 34.195,
33.630001, 33.400002, 33.450001, 32.535, 31.74, 30.33, 27.385,
29.049999, 28.625, 29.77, 30.145, 30.02, 29.559999, 29.225, 29.235001,
29.735001, 28.575001, 28.645, 28.775, 28.459999, 28.85, 29.334999,
28.76, 28.965, 28.889999, 29.049999, 29.955, 29.889999, 30.549999,
31.059999, 31.115, 31.360001, 32.419998, 32.759998), ADI = c(36.389999,
35.400002, 35.560001, 35.5, 35.549999, 35.41, 35.080002, 35.560001,
35.099998, 35.639999, 36.07, 35.139999, 34.650002, 34.470001,
34.049999, 34.299999, 34.880001, 34.830002, 34.740002, 35.889999,
35.990002, 36.009998, 35.240002, 37.52, 37.52, 38.02, 37.18,
36.830002, 38.049999, 37.599998, 37.32, 37.130001, 36.700001,
36.299999, 36.5, 36.59, 37.32, 37.5, 36.720001, 38, 37.709999,
36.93, 37.119999, 37.049999, 36.950001, 36.919998, 37.849998,
37.130001, 37.209999, 36.57, 35.919998, 36.02, 35.830002, 35.709999,
35.830002, 36.23, 35.799999, 35.66, 35.119999, 36.330002, 36.139999,
35.709999, 35.599998, 35.310001, 35.41, 36.09, 35.669998, 35.34,
34.93, 34.099998, 33.650002, 32.84, 33.360001, 33.849998, 33.419998,
34.349998, 33.799999, 33.700001, 33.52, 33.360001, 33.52, 34.110001,
33.849998, 33.669998, 34.560001, 34.619999, 34.619999, 34.549999,
34.130001, 34.060001, 34.310001, 35.490002, 36.419998, 36.700001,
36.860001, 36.889999, 37.080002, 36.529999, 36.849998, 36.290001
)), row.names = c(NA, 100L), class = "data.frame")
We can use shift from data.table which can take a vector of values for n
library(data.table)
setDT(Data)
out <- Data[, shift(.SD, n = 1:50), .SDcols = -1]
names(out) <- paste0(rep(names(Data)[-1], each = 50), "_", 1:50, "days")
Data[, names(out) := out][]

Plotting 12 monthly time series data: builtin `graphics::plot()` gives 'cannot plot more than 10 series as "multiple"'

I want to plot 12 different monthly time series data over the year range 1984-2018. I want to get a graph like the following but graphics::plot() always gives me an error - what's the solution?
Code:
datats <- ts(data, start=c(1984,1), end=c(2018,12), frequency=12)
plot(datats, ylab="PPT_MM")
Error:
Error in plotts(x = x, y = y, plot.type = plot.type, xy.labels = xy.labels, :
cannot plot more than 10 series as "multiple"
Plot: image of plot
My data:
data<-structure(list(Year = 1984:2018, X1 = c(24.2, 5.3, 59, 31.7,
93.7, 133.2, 42.8, 29.3, 12, 256.5, 0, 28.5, 22.4, 3.8, 295.4,
16.1, 7, 244.8, 79.5, 31.6, 45.1, 12.2, 14, 61.4, 117.4, 74.2,
51, 9.1, 0, 50.4, 0, 13.3, 45.1, 20.7, 25.7), X2 = c(0, 110.5,
0, 0, 13.8, 4, 23.2, 13.3, 6.1, 84.9, 103.5, 83.3, 56.5, 0, 219.4,
2.2, 0, 0, 7.5, 17.2, 47.9, 19.2, 20.5, 44.8, 7.3, 26.3, 64.1,
71.8, 4.6, 0, 80, 16.8, 65.1, 26.2, 2.8), X3 = c(3.4, 78.7, 59.4,
23.3, 109.3, 51.1, 217.3, 43.5, 5, 60.9, 75.3, 150.1, 73.7, 46,
118, 121, 52.5, 113, 98.9, 115.2, 83.1, 101.7, 30, 20.5, 73,
3.2, 241.9, 209.8, 1.6, 113.1, 207.4, 39, 27.4, 15.2, 91.6),
X4 = c(51.4, 278.3, 192.4, 56.7, 203.7, 193.7, 251.5, 80.5,
192.9, 20.8, 82.4, 49.6, 96.4, 208.5, 123, 113.8, 68.5, 88.9,
120.4, 153.2, 121.5, 165.1, 117, 143.9, 129.3, 145.4, 107.9,
1, 286.4, 209.3, 44, 55.3, 82.4, 40.3, 83.4), X5 = c(0.6,
84.6, 72.7, 39.4, 23.6, 37, 64.9, 57.5, 32, 13.7, 29.8, 33.1,
42.8, 21.2, 162.6, 9.8, 15.6, 15.3, 126.6, 133.8, 59.8, 100.5,
70, 41.7, 4.5, 29.7, 120.9, 37.7, 112.5, 37.7, 14.8, 34.3,
23.2, 35.6, 22.7), X6 = c(0, 0, 5.7, 61.9, 10.1, 0, 5.1,
3.1, 1.1, 6.3, 8.2, 0.9, 19.3, 0.5, 38.7, 5, 6.2, 4.3, 1.4,
0, 0.7, 0.9, 2, 2.7, 0.3, 5.2, 1.7, 0, 36.9, 0.3, 9.7, 26.3,
5.7, 2.2, 2.7), X7 = c(7, 1.4, 0.4, 3.6, 0, 3.8, 0, 1.4,
6.8, 0.5, 3.3, 4.1, 2.2, 1.2, 15.4, 2.4, 0.3, 4.3, 0, 0,
0, 1, 1.9, 26.8, 1.3, 0, 2.7, 3.4, 0, 2.7, 13, 6.1, 4.8,
5, 3.5), X8 = c(6.4, 1.9, 0.3, 11.6, 3, 14.6, 3.4, 8.9, 0,
3.1, 9.9, 3.2, 2.2, 4.3, 2.9, 4.9, 1.8, 2.5, 0.2, 26.3, 0,
3.5, 4.7, 5.2, 0.2, 0, 1.3, 0.7, 11.8, 0.6, 32.4, 4.1, 3.8,
7.2, 2.8), X9 = c(15.7, 0.2, 0, 0, 15.4, 0.3, 0, 3.4, 0.7,
0.6, 4.3, 5.1, 0.7, 0, 1.8, 0, 2.3, 0, 8.8, 21.5, 1, 1, 3,
4.3, 9.1, 1.2, 0.6, 5.9, 0, 2.5, 13.6, 3, 3.4, 6.8, 2.22),
X10 = c(154.4, 56, 2.6, 0.3, 33.5, 96.9, 48.8, 46.5, 31,
26, 110.9, 103.7, 0, 83.2, 3.3, 20.6, 41, 7.3, 21.2, 31.8,
47.6, 10.2, 14.5, 18.3, 23.9, 41.3, 32.1, 50.2, 22.3, 64,
25.4, 17.2, 7.4, 23.6, 87.6), X11 = c(211.2, 75.1, 180.8,
93.5, 120.8, 106, 208.5, 119.9, 141.2, 150.8, 406.3, 46,
187.7, 270.3, 113.9, 257, 189.8, 169, 144.3, 121.1, 161.3,
125, 117.2, 127.9, 122.8, 34.4, 116, 180.3, 119.7, 1024.7,
104.8, 104.5, 51.5, 38.2, 206.8), X12 = c(341.4, 121, 127.2,
12, 180.2, 129.5, 110.2, 156.7, 186.2, 67.3, 143.7, 87.6,
1.5, 177.3, 15.8, 108.6, 98.8, 43.6, 182.4, 24.1, 89.5, 100.5,
95, 82.4, 44.9, 127.1, 59.6, 28.2, 73.2, 919.5, 0, 122.9,
51.4, 17.9, 249.6)), class = "data.frame", row.names = c(NA,
-35L))
Function documentation (https://rdrr.io/r/stats/plot.ts.html) gives us some hints...
Apparently it is not possible to plot more than 10 charts on the same panel. Try for example:
datats <- ts(data[,-1], start=c(1984,1), end=c(2018,12), frequency=12)
plot(datats[,c(1:10)], ylab="PPT_MM")
It works! Then to use this method 10 looks like to be a limit.
You can use alternatively some ggplot:
library(reshape2)
library(dplyr)
library(ggplot2)
melt(data, id.vars = "Year") %>%
ggplot(aes(x = Year, y = value , group = 1)) +
geom_line() + geom_point() +
facet_wrap(. ~ variable)

R: Plot varimax rotated factor analysis

I want to analyze my data as here with factor analysis and PCA.
It works so far, but what I did figure out is the following.
How can I perform a varimax rotation and visualize the rotated matrix in the correlation circle?
res.pca <- prcomp(decathlon2.active, scale = TRUE)
my.var <- varimax(res.pca$rotation)
res.pca is a prcomp object, my.var is a list, therefore I cannot use it for the plots as described in the article.
Any ideas?
Edit (output of dput(decathlon2.active)):
> data(decathlon2)
> decathlon2.active <- decathlon2[1:23, 1:10]
> dput(decathlon2.active)
structure(list(X100m = c(11.04, 10.76, 11.02, 11.34, 11.13, 10.83,
11.64, 11.37, 11.33, 11.33, 11.36, 10.85, 10.44, 10.5, 10.89,
10.62, 10.91, 10.97, 10.69, 10.98, 10.95, 10.9, 11.14), Long.jump = c(7.58,
7.4, 7.23, 7.09, 7.3, 7.31, 6.81, 7.56, 6.97, 7.27, 6.8, 7.84,
7.96, 7.81, 7.47, 7.74, 7.14, 7.19, 7.48, 7.49, 7.31, 7.3, 6.99
), Shot.put = c(14.83, 14.26, 14.25, 15.19, 13.48, 13.76, 14.57,
14.41, 14.09, 12.68, 13.46, 16.36, 15.23, 15.93, 15.73, 14.48,
15.31, 14.65, 14.8, 14.01, 15.1, 14.77, 14.91), High.jump = c(2.07,
1.86, 1.92, 2.1, 2.01, 2.13, 1.95, 1.86, 1.95, 1.98, 1.86, 2.12,
2.06, 2.09, 2.15, 1.97, 2.12, 2.03, 2.12, 1.94, 2.06, 1.88, 1.94
), X400m = c(49.81, 49.37, 48.93, 50.42, 48.62, 49.91, 50.14,
51.1, 49.48, 49.2, 51.16, 48.36, 49.19, 46.81, 48.97, 47.97,
49.4, 48.73, 49.13, 49.76, 50.79, 50.3, 49.41), X110m.hurdle = c(14.69,
14.05, 14.99, 15.31, 14.17, 14.38, 14.93, 15.06, 14.48, 15.29,
15.67, 14.05, 14.13, 13.97, 14.56, 14.01, 14.95, 14.25, 14.17,
14.25, 14.21, 14.34, 14.37), Discus = c(43.75, 50.72, 40.87,
46.26, 45.67, 44.41, 47.6, 44.99, 42.1, 37.92, 40.49, 48.72,
50.11, 51.65, 48.34, 43.73, 45.62, 44.72, 44.75, 42.43, 44.6,
44.41, 44.83), Pole.vault = c(5.02, 4.92, 5.32, 4.72, 4.42, 4.42,
4.92, 4.82, 4.72, 4.62, 5.02, 5, 4.9, 4.6, 4.4, 4.9, 4.7, 4.8,
4.4, 5.1, 5, 5, 4.6), Javeline = c(63.19, 60.15, 62.77, 63.44,
55.37, 56.37, 52.33, 57.19, 55.4, 57.44, 54.68, 70.52, 69.71,
55.54, 58.46, 55.39, 63.45, 57.76, 55.27, 56.32, 53.45, 60.89,
64.55), X1500m = c(291.7, 301.5, 280.1, 276.4, 268, 285.1, 262.1,
285.1, 282, 266.6, 291.7, 280.01, 282, 278.11, 265.42, 278.05,
269.54, 264.35, 276.31, 273.56, 287.63, 278.82, 267.09)), .Names = c("X100m",
"Long.jump", "Shot.put", "High.jump", "X400m", "X110m.hurdle",
"Discus", "Pole.vault", "Javeline", "X1500m"), row.names = c("SEBRLE",
"CLAY", "BERNARD", "YURKOV", "ZSIVOCZKY", "McMULLEN", "MARTINEAU",
"HERNU", "BARRAS", "NOOL", "BOURGUIGNON", "Sebrle", "Clay", "Karpov",
"Macey", "Warners", "Zsivoczky", "Hernu", "Bernard", "Schwarzl",
"Pogorelov", "Schoenbeck", "Barras"), class = "data.frame")

How to use ggplot2 to plot results from 'segmented' package?

I followed these steps to plot the results of a piecewise linear regression with one breakpoint which I have done by segmented package:
lin.mod <- lm(ChH~CL)
segmented.mod <- segmented(lin.mod, seg.Z=~CL)
data1 <- data.frame(x = CL, y = ChH)
data2 <- data.frame(x = CL, y = broken.line(segmented.mod)$fit)
ggplot(data1, aes(x = CL, y = ChH)) +
geom_point() +
geom_line(data = data2, color = 'blue')
and I get this plot which does not show two lines with a breakpoint!!!
How should I change my codes to get the correct plot?
This is my dataset:
(ChH has 11 missing data)
CL <- c(9.26, 9.38, 9.41, 9.44, 9.52, 9.58, 9.74, 9.91, 10.03, 10.22,
10.23, 10.4, 10.92, 11.15, 11.38, 11.77, 11.79, 12, 12.45, 12.5,
12.54, 12.79, 12.98, 13.04, 13.04, 13.54, 14.26, 14.33, 14.4,
14.56, 14.77, 14.83, 15.14, 15.19, 15.21, 15.46, 15.61, 15.62,
15.82, 15.87, 16.02, 16.04, 16.05, 16.07, 16.26, 16.32, 16.33,
16.41, 16.53, 16.57, 16.63, 16.64, 16.68, 16.76, 16.87, 17.13,
17.2, 17.37, 17.47, 17.49, 17.68, 17.72, 18.04, 18.1, 18.14,
18.16, 18.18, 18.18, 18.18, 18.22, 18.42, 18.55, 18.63, 18.72,
18.75, 18.77, 18.84, 19, 19.03, 19.3, 19.34, 19.35, 19.36, 19.46,
19.58, 19.61, 19.64, 19.7, 19.73, 19.76, 19.85, 19.85, 19.89,
19.93, 19.97, 20.1, 20.13, 20.16, 20.16, 20.22, 20.26, 20.29,
20.31, 20.31, 20.37, 20.43, 20.46, 20.47, 20.61, 20.64, 20.65,
20.66, 20.78, 20.85, 20.85, 20.88, 20.9, 20.98, 21, 21.02, 21.23,
21.26, 21.29, 21.33, 21.39, 21.4, 21.41, 21.45, 21.5, 21.5, 21.58,
21.6, 21.76, 21.85, 21.9, 22.1, 22.12, 22.14, 22.17, 22.2, 22.21,
22.23, 22.24, 22.3, 22.4, 22.42, 22.43, 22.46, 22.47, 22.48,
22.5, 22.68, 22.7, 22.7, 22.75, 22.8, 22.85, 22.89, 22.89, 22.92,
22.93, 22.94, 22.99, 23.19, 23.3, 23.33, 23.42, 23.51, 23.53,
23.67, 23.7, 23.7, 23.72, 23.72, 23.76, 23.77, 23.78, 23.91,
24.05, 24.05, 24.06, 24.08, 24.11, 24.16, 24.17, 24.2, 24.21,
24.3, 24.38, 24.38, 24.43, 24.49, 24.62, 24.89, 24.89, 24.91,
24.92, 24.95, 24.95, 25.07, 25.1, 25.11, 25.13, 25.13, 25.16,
25.28, 25.3, 25.32, 25.42, 25.43, 25.47, 25.6, 25.71, 25.87,
25.92, 25.94, 25.96, 26.14, 26.18, 26.22, 26.32, 26.33, 26.36,
26.43, 26.6, 26.69, 26.73, 26.73, 26.82, 26.83, 26.86, 27, 27,
27.08, 27.09, 27.1, 27.14, 27.23, 27.24, 27.27, 27.3, 27.55,
27.56, 27.81, 27.9, 27.94, 27.94, 27.98, 28.03, 28.03, 28.17,
28.18, 28.2, 28.49, 28.55, 28.7, 28.76, 28.88, 29.07, 29.13,
29.23, 29.43, 29.63, 29.71, 29.75, 29.97, 30.8, 30.87, 31.27,
31.28, 31.33, 31.45, 31.61, 31.64, 31.68, 32.11, 32.91, 33, 33.6,
34.04, 35.04, 36.05, 36.85)
And:
ChH <- c(2.76, 3.03, 2.86, 2.86, 2.99, 3, 2.96, 3.17, 3.12, 3.27, 3.21,
3.08, 3.53, 3.6, 8.7, 3.75, 3.87, 4.17, 4.38, 4.23, 4.04, 4.24,
4.36, 4.2, 8.78, 4.17, 5.02, 5.22, 5.06, 4.9, NA, 5.3, 5.16,
5.51, 4.25, 5.3, 5.25, 5.65, 5.52, 5.57, 5.5, 5.48, 6.14, 4.65,
5.75, 5.41, 5.42, 5.73, 5.63, 5.85, 6.09, 6.05, 5.88, 5.97, 6.64,
5.18, 6.51, 6.38, 6.27, 6.09, 6.62, 6.3, 4.2, 7.13, NA, 5.85,
6.83, 6.75, 6.94, 6.73, 6.23, 6.79, 6.7, 6.87, NA, 6.7, 6.52,
NA, 7.17, 7.06, 7.01, 7.33, 7.04, 6.94, 7.35, 7.01, 7.54, 7.8,
7.75, 7.86, 7.58, 7.09, 7.42, 7.52, 6.69, NA, 7.69, 7.57, 7.34,
7.52, 8.18, 7.51, 7.8, 7.77, 8.07, 7.92, 6.7, 7.43, 7.58, 8.09,
7.7, 7.81, 8.11, 7.83, 7.48, 7.81, 8.27, 8.32, 7.86, 8.1, 8.63,
7.8, 5.42, 8.36, 8.08, NA, 7.78, 8.27, 8.44, 6.62, 8.01, 8.5,
7.86, 9.1, 8.15, 8.69, 8.6, 8.49, 7.98, 8.76, 8.34, 8.75, 7.97,
9.08, 8.29, NA, 8.92, 8.71, 8.94, 8.44, 9, 8.63, 9.15, 8.93,
9.37, 8.77, 9.21, 9.07, 9.1, 8.89, 7.43, 8.34, 8.64, 8.5, 9.59,
7.59, 9.08, 9.4, 9.07, 8.83, 9.46, 9.3, 9.24, 9.44, 9, 9.43,
9.17, 7.68, 9.56, 9.27, 9.33, 6.8, 9.98, 9.81, 9.59, 9.49, 9.55,
9.39, 10.04, 9.5, 9.93, 9.3, 9.49, 8.45, 7.77, 7.84, 9.88, 9.35,
10.09, 10.22, 10.75, 10.75, 8.04, 8.07, 10.14, 9.94, 10.44, 10.25,
9.49, 10.6, 8.41, 9.57, 11.25, NA, 11.61, 6.72, 10.63, 11.12,
10.55, 10.7, 10.18, 10.94, 11.02, 10.66, 10.73, 8.65, 11.84,
NA, 11.25, 11.59, 10.96, 11.58, 11.43, 12.46, 10.46, 10.99, 11.94,
8.77, 11.58, 12.36, 11, 11.05, 11.86, 9.52, 12.48, 12.39, 12.64,
12.28, 12.12, 11.27, 10.86, 12.49, 12.13, 12.74, 9.64, 10.97,
12.41, 12.32, 13.86, 13.04, NA, 10.26, 13.24, 13.89, 12.77, 13.33,
13.37, 13.55, 14.01, 14.25, 14.75, 14.3, 13.87, 14.96, 14.32,
14.49, NA, 15.41, 15.47, 14.31, 17.7, 12.48, 16.46)
Edited to take into account OP's real data
Put everything inside the same data.frame:
library(segmented)
library(ggplot2)
lin.mod <- lm(ChH~CL)
segmented.mod <- segmented(lin.mod, seg.Z=~CL)
fit <- numeric(length(CL)) * NA
fit[complete.cases(rowSums(cbind(ChH, CL)))] <- broken.line(segmented.mod)$fit
data1 <- data.frame(CL = CL, ChH = ChH, fit = fit)
ggplot(data1, aes(x = CL, y = ChH)) +
geom_point() +
geom_line(aes(x = CL, y = fit), color = 'blue')

Resources