Created
November 28, 2024 18:08
-
-
Save chenpanliao/d371f1c4ef4e3addcd72e1fe81a93d0a to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| library(tidyverse) | |
| ID_sprint <- | |
| tibble(ID_start = c(179, 248, 367, 475), | |
| ID_end = c(231, 308, 419, 741)) %>% | |
| mutate(clipID = 1:nrow(.)) | |
| ID_turn <- | |
| tibble(ID_turn_start = c(188, 293, 294, 295, 296, 297, 298, 299, 415)) %>% | |
| mutate(ID_turn_end = ID_turn_start + 2) | |
| # ID_turn_start ID_turn_end | |
| # <dbl> <dbl> | |
| # 1 188 190 | |
| # 2 293 295 | |
| # 3 294 296 | |
| # 4 295 297 | |
| # 5 296 298 | |
| # 6 297 299 | |
| # 7 298 300 | |
| # 8 299 301 | |
| # 9 415 417 | |
| # ID_turn 有重疊部份要整合 | |
| foo <- ID_turn %>% select(ID_turn_start, ID_turn_end) | |
| for (i in 2:nrow(foo)) { | |
| if(!(foo[i, ] %>% is.na %>% any)) | |
| if(!is.na(foo[i, 1]) & | |
| (foo[i, 1] <= (foo[1:i-1, 2] %>% max(na.rm = T))) | |
| ) { | |
| # foo[i-1, 2] <- foo[1:i, 2] %>% max(na.rm = T) | |
| foo[i, 1] <- foo[i-1, 1] | |
| foo[i, 2] <- foo[1:i, 2] %>% max(na.rm = T) | |
| } | |
| } | |
| ID_turn_clean <- | |
| foo %>% group_by(ID_turn_start) %>% summarise(ID_turn_end = max(ID_turn_end)) %>% | |
| mutate(clipID = NA_integer_) | |
| for(i in ID_turn_clean %>% nrow %>% seq_len) { | |
| ID_turn_clean$clipID[i] = | |
| which(ID_sprint$ID_start <= ID_turn_clean$ID_turn_start[i] & ID_sprint$ID_end >= ID_turn_clean$ID_turn_end[i]) | |
| } | |
| # 接一起 | |
| ID_join <- | |
| left_join(ID_sprint, ID_turn_clean) %>% | |
| arrange(ID_start, clipID, ID_turn_start, ID_turn_end) | |
| # ID_start ID_end clipID ID_turn_start ID_turn_end | |
| # <dbl> <dbl> <int> <dbl> <dbl> | |
| # 1 179 231 1 188 190 | |
| # 2 248 308 2 293 301 | |
| # 3 367 419 3 415 417 | |
| # 4 475 741 4 NA NA | |
| # 逐列處理 | |
| split(ID_join, f = gl(nrow(ID_join), 1)) %>% | |
| lapply(function(x){ | |
| res <- tibble(res1 = NA_integer_ %>% rep(2), res2 = NA_integer_ %>% rep(2), clipID = x$clipID) | |
| if (!is.na(x$ID_turn_start) & !is.na(x$ID_turn_start)) { | |
| # 需要切 | |
| if(x$ID_start < x$ID_turn_start) { | |
| res[1, "res1"] <- x$ID_start | |
| res[1, "res2"] <- x$ID_turn_start - 1 | |
| } | |
| if (x$ID_end > x$ID_turn_end) { | |
| res[2, "res1"] <- x$ID_turn_end + 1 | |
| res[2, "res2"] <- x$ID_end | |
| } | |
| } else { | |
| # 不需要切 | |
| res[1, "res1"] <- x$ID_start | |
| res[1, "res2"] <- x$ID_end | |
| } | |
| res | |
| }) %>% | |
| do.call("rbind", .) %>% | |
| na.omit %>% | |
| left_join(ID_join) | |
| # res1 res2 clipID ID_start ID_end ID_turn_start ID_turn_end | |
| # <int> <int> <int> <dbl> <dbl> <dbl> <dbl> | |
| # 1 179 187 1 179 231 188 190 | |
| # 2 191 231 1 179 231 188 190 | |
| # 3 248 292 2 248 308 293 301 | |
| # 4 302 308 2 248 308 293 301 | |
| # 5 367 414 3 367 419 415 417 | |
| # 6 418 419 3 367 419 415 417 | |
| # 7 475 741 4 475 741 NA NA | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment