How can I draw 2 types of line segments in the same 1 format?

Question

Here is the original code I have:

df<-structure(list(Bloc = c(1, 1, 2, 2, 1, 1, 2, 2, 1, 1, 2, 2, 1, 
1, 2, 2), Pos_heliaphen = c("Z16", "Z17", "Z30", "Z31", "Z16", 
"Z17", "Z30", "Z31", "Z16", "Z17", "Z30", "Z31", "Z16", "Z17", 
"Z30", "Z31"), traitement = c("WS", "WW", "WS", "WW", "WS", "WW", 
"WS", "WW", "WS", "WW", "WS", "WW", "WS", "WW", "WS", "WW"), 
    Variete = c("Blancas", "Blancas", "Blancas", "Blancas", "Blancas", 
    "Blancas", "Blancas", "Blancas", "Blancas", "Blancas", "Blancas", 
    "Blancas", "Blancas", "Blancas", "Blancas", "Blancas"), Date_obs = c("07/06/2021", 
    "07/06/2021", "07/06/2021", "07/06/2021", "09/06/2021", "09/06/2021", 
    "09/06/2021", "09/06/2021", "11/06/2021", "11/06/2021", "11/06/2021", 
    "11/06/2021", "14/06/2021", "14/06/2021", "14/06/2021", "14/06/2021"
    ), FTSW_av_arros = c(0.828736740597878, 0.726528918269943, 
    0.818773549999622, 0.764350730084015, 0.779363548698168, 
    0.756173479975099, 0.790079362082896, 0.768785785352195, 
    0.605014464802314, 0.702813268905819, 0.626975557082556, 
    0.70669501159767, 0.335004821600771, 0.593128390596745, 0.392891392498735, 
    0.591383574624979), FTSW_apres_arros = c(0.899710703953713, 
    0.899949604245101, 0.907876554583141, 0.900359091641547, 
    0.779363548698168, 0.899949604245101, 0.790079362082896, 
    0.900359091641547, 0.605014464802314, 0.901431832330359, 
    0.626975557082556, 0.898880739885487, 0.335004821600771, 
    0.899949604245101, 0.392891392498735, 0.904794146909727)), class = c("tbl_df", 
"tbl", "data.frame"), row.names = c(NA, -16L))

Here is the code I have:

library(ggplot2)
library(dplyr)
library(readxl)
library(scales)
library(tidyverse)
library(lubridate)

lims <- as.POSIXct(strptime(c("2021-06-06","2021-06-15"), format = "%Y-%m-%d")) 

#Blancas
Blancas<-subset(df,Pos_heliaphen %in% c("Z16","Z17","Z30","Z31"))

labels <- Blancas %>% 
  select(Bloc, Pos_heliaphen) %>% 
  distinct(Bloc, Pos_heliaphen) %>% 
  group_by(Bloc) %>% 
  summarise(Pos_heliaphen = paste(Pos_heliaphen, collapse = "-")) %>% 
  tibble::deframe()

  Blancas %>%
  mutate(Date_obs = as.POSIXct(lubridate::dmy(Date_obs))) %>%
  tidyr::pivot_longer(starts_with("FTSW")) %>%
  mutate(Date_obs = if_else(name == "FTSW_apres_arros", 
                            Date_obs + 43200, Date_obs)) %>%
  filter(!is.na(value)) %>%
  ggplot(aes(Date_obs, value, colour = factor(Bloc), shape = traitement, 
             linetype = traitement, group = interaction(Bloc, traitement))) +
  geom_point() +
  geom_line()+
  scale_color_discrete(labels = labels, guide = guide_legend(order = 1)) +
  scale_x_datetime(limits = lims,date_labels = "%d/%m/%Y", date_breaks = "day") +
  labs(y = expression(paste("FTSW"))) +
  theme(legend.position = "right", 
        axis.text.x = element_text(angle = 90, hjust = 1))+
  labs(title = "Blancas",
       y = expression(paste("FTSW"))) +
  theme(legend.position = "right", axis.text.x = element_text(angle = 90, hjust = 1), axis.title.x=element_blank())+
  guides(colour = guide_legend(order = 1,nrow = 8),shape=guide_legend(nrow = 2),linetype=guide_legend(nrow = 2))

Here is the figure I got:

Now I want to remove these points circled in red and make all lines more smooth. I tried change the geom_line to geom_smooth, but the final figure is really strange.

Any suggestions are welcome!

score 0 · Answer 1 · answered Aug 10 '23 at 19:50

I am afraid I do not find any connection between your topic title and the question you stated. In case you meant you would like to remove the time point that have same observation:

Blancas %>%
  mutate(Date_obs = as.POSIXct(lubridate::dmy(Date_obs))) %>%
  # adding the following lines
  rowwise() %>%
  mutate(FTSW_av_arros = ifelse(FTSW_apres_arros == FTSW_av_arros, NA, FTSW_av_arros)) %>% # keep the second time point
  # mutate(FTSW_apres_arros = ifelse(FTSW_apres_arros == FTSW_av_arros, NA, FTSW_apres_arros)) %>% # keep the first time point
  #
  tidyr::pivot_longer(starts_with("FTSW")) %>%
  mutate(Date_obs = if_else(name == "FTSW_apres_arros", 
                            Date_obs + 43200, Date_obs)) %>%
  filter(!is.na(value)) %>%
  ggplot(aes(Date_obs, value, colour = factor(Bloc), shape = traitement, 
             linetype = traitement, group = interaction(Bloc, traitement))) +
  geom_point() +
  geom_line()+
  scale_color_discrete(labels = labels, guide = guide_legend(order = 1)) +
  scale_x_datetime(limits = lims,date_labels = "%d/%m/%Y", date_breaks = "day") +
  labs(y = expression(paste("FTSW"))) +
  theme(legend.position = "right", 
        axis.text.x = element_text(angle = 90, hjust = 1))+
  labs(title = "Blancas",
       y = expression(paste("FTSW"))) +
  theme(legend.position = "right", axis.text.x = element_text(angle = 90, hjust = 1), axis.title.x=element_blank())+
  guides(colour = guide_legend(order = 1,nrow = 8),shape=guide_legend(nrow = 2),linetype=guide_legend(nrow = 2))

In case you also want to place the point in the middle of the two time points:

Blancas %>%
  mutate(Date_obs = as.POSIXct(lubridate::dmy(Date_obs))) %>%
  # adding the following lines
  rowwise() %>%
  mutate(FTSW_apres_arros = ifelse(FTSW_apres_arros == FTSW_av_arros, NA, FTSW_apres_arros)) %>% # keep the first time point
  mutate(Date_obs = if_else(is.na(FTSW_av_arros) | is.na(FTSW_apres_arros), Date_obs + 21600, Date_obs)) %>%
  #
  tidyr::pivot_longer(starts_with("FTSW")) %>%
  mutate(Date_obs = if_else(name == "FTSW_apres_arros", 
                            Date_obs + 43200, Date_obs)) %>%
  filter(!is.na(value)) %>%
  ggplot(aes(Date_obs, value, colour = factor(Bloc), shape = traitement, 
             linetype = traitement, group = interaction(Bloc, traitement))) +
  geom_point() +
  geom_line()+
  scale_color_discrete(labels = labels, guide = guide_legend(order = 1)) +
  scale_x_datetime(limits = lims,date_labels = "%d/%m/%Y", date_breaks = "day") +
  labs(y = expression(paste("FTSW"))) +
  theme(legend.position = "right", 
        axis.text.x = element_text(angle = 90, hjust = 1))+
  labs(title = "Blancas",
       y = expression(paste("FTSW"))) +
  theme(legend.position = "right", axis.text.x = element_text(angle = 90, hjust = 1), axis.title.x=element_blank())+
  guides(colour = guide_legend(order = 1,nrow = 8),shape=guide_legend(nrow = 2),linetype=guide_legend(nrow = 2))

How can I draw 2 types of line segments in the same 1 format?

1 Answers1