Mercurial > repos > iuc > snpfreqplot

comparison helperFunctions.R @ 1:e362b3143cde draft

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
"planemo upload for repository https://github.com/galaxyproject/tools-iuc/tree/master/tools/snpfreqplot/ commit 1bde09fccd1a5412240ebd5c1f34a45ad73cebe2"
author iuc
date Thu, 10 Dec 2020 13:41:29 +0000
parents 1062d6ad6503
children dc51db22310c
comparison
equal deleted inserted replaced
0:1062d6ad6503 1:e362b3143cde
36 diff.colnames <- c(diff.colnames, 36 diff.colnames <- c(diff.colnames,
37 names(test1[!(test1 %in% test2)])) 37 names(test1[!(test1 %in% test2)]))
38 } 38 }
39 } 39 }
40 } 40 }
41 uni_select <- c("POS", "ALT", diff.colnames) 41 group_select <- c("POS", "REF", "ALT", diff.colnames)
42 return(lines[, uni_select] %>% unite(uni_select, sep = " ")) # nolint 42 return(lines[, group_select] %>% unite(group_select, sep = " ")) # nolint
43 } 43 }
44 44
45 split_table_and_process <- function(tab) { 45 split_table_and_process <- function(tab) {
46 #' Split TAB into groups sharing the same POS and ALT 46 #' Split TAB into groups sharing the same POS and ALT
47 #' and create distinguishing labels. 47 #' and create distinguishing labels.
49 #' Calls the above ``difference_in_group`` for each 49 #' Calls the above ``difference_in_group`` for each
50 #' discovered group. 50 #' discovered group.
51 #' 51 #'
52 #' This function is necessary because tidyr is difficult 52 #' This function is necessary because tidyr is difficult
53 #' to write custom group binding functions. 53 #' to write custom group binding functions.
54 posalts <- tab %>% group_by(POS, ALT) %>% select(POS, ALT) # nolint 54 group_ind <- tab %>% group_by(POS, REF, ALT) %>% select(POS, REF, ALT) # nolint
55 nlines <- nrow(tab) 55 nlines <- nrow(tab)
56 groups <- list() 56 groups <- list()
57 groups[[1]] <- c(1, 1) 57 groups[[1]] <- c(1, 1)
58 last_pa <- paste(posalts[1, ]) 58 last_pa <- paste(group_ind[1, ])
59 for (r in 2:nlines) { 59 for (r in 2:nlines) {
60 curr_pa <- paste(posalts[r, ]) 60 curr_pa <- paste(group_ind[r, ])
61 posalt_diff_between_lines <- !all(last_pa == curr_pa) 61 group_ind_diff_between_lines <- !all(last_pa == curr_pa)
62 if (posalt_diff_between_lines) { 62 if (group_ind_diff_between_lines) {
63 ## end of current group, start of new 63 ## end of current group, start of new
64 groups[[length(groups)]][2] <- r - 1 ## change prev end 64 groups[[length(groups)]][2] <- r - 1 ## change prev end
65 groups[[length(groups) + 1]] <- c(r, r) ## set (start, end) 65 groups[[length(groups) + 1]] <- c(r, r) ## set (start, end)
66 } else if (r == nlines) { 66 } else if (r == nlines) {
67 ## i.e. if the very last line shares 67 ## i.e. if the very last line shares
68 ## the same POS ALT as the one before, 68 ## the same POS REF ALT as the one before,
69 ## close current group. 69 ## close current group.
70 groups[[length(groups)]][2] <- r 70 groups[[length(groups)]][2] <- r
71 } 71 }
72 last_pa <- curr_pa 72 last_pa <- curr_pa
73 } 73 }