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
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
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][]
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)
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")
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')