Mercurial > repos > petr-novak > dante_ltr

comparison detect_putative_ltr.R @ 12:ff01d4263391 draft

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
"planemo upload commit 414119ad7c44562d2e956b765e97ca113bc35b2b-dirty"
author petr-novak
date Thu, 21 Jul 2022 08:23:15 +0000
parents
children 559940c04c44
comparison
equal deleted inserted replaced
11:54bd36973253 12:ff01d4263391
1 #!/usr/bin/env Rscript
2 initial_options <- commandArgs(trailingOnly = FALSE)
3 file_arg_name <- "--file="
4 script_name <- normalizePath(sub(file_arg_name, "", initial_options[grep(file_arg_name, initial_options)]))
5 script_dir <- dirname(script_name)
6 library(optparse)
7
8 parser <- OptionParser()
9 option_list <- list(
10 make_option(c("-g", "--gff3"), action = "store", type = "character",
11 help = "gff3 with dante results", default = NULL),
12 make_option(c("-s", "--reference_sequence"), action = "store", type = "character",
13 help = "reference sequence as fasta", default = NULL),
14 make_option(c("-o", "--output"), action = "store", type = "character",
15 help = "output file path and prefix", default = NULL),
16 make_option(c("-c", "--cpu"), type = "integer", default = 5,
17 help = "Number of cpu to use [default %default]", metavar = "number"),
18 make_option(c("-M", "--max_missing_domains"), type = "integer", default = 0,
19 help = "Maximum number of missing domains is retrotransposon [default %default]",
20 metavar = "number"),
21 make_option(c("-L", "--min_relative_length"), type = "numeric", default = 0.6,
22 help = "Minimum relative length of protein domain to be considered for retrostransposon detection [default %default]",
23 metavar = "number")
24
25 )
26 description <- paste(strwrap(""))
27
28 epilogue <- ""
29 parser <- OptionParser(option_list = option_list, epilogue = epilogue, description = description,
30 usage = "usage: %prog COMMAND [OPTIONS]")
31 opt <- parse_args(parser, args = commandArgs(TRUE))
32
33
34 # load packages
35 suppressPackageStartupMessages({
36 library(rtracklayer)
37 library(Biostrings)
38 library(BSgenome)
39 library(parallel)
40 })
41
42
43 # CONFIGURATION
44 OFFSET <- 15000
45 # load configuration files and functions:
46 lineage_file <- paste0(script_dir, "/databases/lineage_domain_order.csv")
47 FDM_file <- paste0(script_dir, "/databases/feature_distances_model.RDS")
48 trna_db <- paste0(script_dir, "/databases/tRNAscan-SE_ALL_spliced-no_plus-old-tRNAs_UC_unique-3ends.fasta")
49 ltr_utils_r <- paste0(script_dir, "/R/ltr_utils.R")
50 if (file.exists(lineage_file) & file.exists(trna_db)) {
51 lineage_info <- read.table(lineage_file, sep = "\t", header = TRUE, as.is = TRUE)
52 FDM <- readRDS(FDM_file)
53 source(ltr_utils_r)
54 }else {
55 # this destination work is installed using conda
56 lineage_file <- paste0(script_dir, "/../share/dante_ltr/databases/lineage_domain_order.csv")
57 FDM_file <- paste0(script_dir, "/../share/dante_ltr/databases/feature_distances_model.RDS")
58 trna_db <- paste0(script_dir, "/../share/dante_ltr/databases/tRNAscan-SE_ALL_spliced-no_plus-old-tRNAs_UC_unique-3ends.fasta")
59 ltr_utils_r <- paste0(script_dir, "/../share/dante_ltr/R/ltr_utils.R")
60 if (file.exists(lineage_file) & file.exists((trna_db))) {
61 lineage_info <- read.table(lineage_file, sep = "\t", header = TRUE, as.is = TRUE)
62 source(ltr_utils_r)
63 FDM <- readRDS(FDM_file)
64 }else(
65 stop("configuration files not found")
66 )
67 }
68
69
70 # for testing
71 if (FALSE) {
72 g <- rtracklayer::import("/mnt/raid/454_data/cuscuta/Ceuropea_assembly_v4/0_final_asm_hifiasm+longstitch/repeat_annotation/DANTE_on_CEUR_filtered_short_names.gff3")
73 s <- readDNAStringSet("/mnt/raid/454_data/cuscuta/Ceuropea_assembly_v4/0_final_asm_hifiasm+longstitch/asm.bp.p.ctg_scaffolds.short_names.fa")
74 lineage_info <- read.table("/mnt/raid/users/petr/workspace/ltr_finder_test/lineage_domain_order.csv", sep = "\t", header = TRUE, as.is = TRUE)
75
76 g <- rtracklayer::import("/mnt/raid/users/petr/workspace/dante_ltr/test_data/sample_DANTE_unfiltered.gff3")
77 g <- rtracklayer::import("/mnt/raid/users/petr/workspace/ltr_finder_test/test_data/DANTE_filtered_part.gff3")
78 s <- readDNAStringSet("/mnt/raid/users/petr/workspace/ltr_finder_test/test_data/Rbp_part.fa")
79
80 # oriza
81 g <- rtracklayer::import("/mnt/raid/users/petr/workspace/dante_ltr/test_data/big_test_data/DANTE_full_oryza.gff3")
82 s <- readDNAStringSet("/mnt/raid/users/petr/workspace/dante_ltr/test_data/big_test_data/o_sativa_msu7.0.fasta")
83
84 g <- rtracklayer::import("/mnt/raid/users/petr/workspace/dante_ltr/test_data
85 /DANTE_Vfaba_chr5.gff3")
86 s <- readDNAStringSet("/mnt/ceph/454_data/Vicia_faba_assembly/assembly/ver_210910
87 /fasta_parts/211010_Vfaba_chr5.fasta")
88
89 g <- rtracklayer::import("/mnt/raid/users/petr/workspace/dante_ltr/test_data/big_test_data//Cocoa_theobroma_DANTE_filtered.gff3")
90 s <- readDNAStringSet("/mnt/raid/users/petr/workspace/dante_ltr/test_data/big_test_data/Cocoa_theobroma_chr1.fasta.gz")
91 # test on bigger data:
92
93 g <- rtracklayer::import("/mnt/raid/users/petr/workspace/dante_ltr/test_data/tmp/DANTE_unfiltered/1.gff3")
94 s <- readDNAStringSet("/mnt/raid/users/petr/workspace/dante_ltr/test_data/tmp/fasta_parts/1.fasta")
95
96 source("R/ltr_utils.R")
97 ## feature distance model
98 FDM <- readRDS("./databases/feature_distances_model.RDS")
99 g <- rtracklayer::import("./test_data/sample_DANTE.gff3")
100 s <- readDNAStringSet("./test_data/sample_genome.fasta")
101 outfile <- "/mnt/raid/users/petr/workspace/ltr_finder_test/te_with_domains_2.gff3"
102 lineage_info <- read.table("databases/lineage_domain_order.csv", sep = "\t", header =
103 TRUE, as.is = TRUE)
104 trna_db <- "./databases/tRNAscan-SE_ALL_spliced-no_plus-old-tRNAs_UC_unique-3ends.fasta"
105 opt <- list(min_relative_length=0.6, cpu = 8)
106
107 }
108
109 # MAIN #############################################################
110
111 # load data:
112
113 cat("reading gff...")
114 g <- rtracklayer::import(opt$gff3, format = 'gff3') # DANTE gff3
115 cat("done\n")
116 cat("reading fasta...")
117 s <- readDNAStringSet(opt$reference_sequence) # genome assembly
118 cat("done\n")
119 outfile <- opt$output
120 # clean sequence names:
121 names(s) <- gsub(" .+", "", names(s))
122 lineage_domain <- lineage_info$Domains.order
123 lineage_domain_span <- lineage_info$domain_span
124 lineage_ltr_mean_length <- lineage_info$ltr_length
125 lineage_offset5prime <- lineage_info$offset5prime
126 lineage_offset3prime <- lineage_info$offset3prime
127 ln <- gsub("ss/I", "ss_I", gsub("_", "/", gsub("/", "|", lineage_info$Lineage)))
128 names(lineage_offset3prime) <- ln
129 names(lineage_offset5prime) <- ln
130 names(lineage_domain) <- ln
131 names(lineage_domain_span) <- ln
132 names(lineage_ltr_mean_length) <- ln
133 lineage_domains_sequence <- unlist(mapply(function(d,l) {
134 paste(strsplit(d, " ")[[1]], ":", l, sep = "")
135 }, d = lineage_domain, l = names(lineage_domain)))
136
137 # filter g gff3
138 g <- dante_filtering(g, Relative_Length = opt$min_relative_length) # default
139
140 seqlengths(g) <- seqlengths(s)[names(seqlengths(g))]
141 g <- add_coordinates_of_closest_neighbor(g)
142
143 # add info about domain order:
144 g$domain_order <- as.numeric(factor(paste(g$Name, g$Final_Classification, sep = ":"), levels = lineage_domains_sequence))
145 # set NA to 0 in g$domain_order ( some domains are not fromm ClassI elements
146 g$domain_order[is.na(g$domain_order)] <- 0
147
148 # NOTE - some operation is faster of GrangesList but some on list of data.frames
149 # this is primary clusteing
150 cls <- get_domain_clusters(g)
151 gcl <- split(as.data.frame(g), cls)
152 # gcl_as_GRL <- split(g, cls) # delete?
153
154 cls_alt <- get_domain_clusters_alt(g, FDM)
155 g$Cluster <- as.numeric(factor(cls_alt))
156
157 gcl_alt <- split(as.data.frame(g), cls_alt)
158
159 TE_partial <- GRanges(seqnames = sapply(gcl_alt, function(x) x$seqnames[1]),
160 Name = sapply(gcl_alt, function(x) x$Final_Classification[1]),
161 Final_Classification = sapply(gcl_alt, function(x) x$Final_Classification[1]),
162 ID = sapply(gcl_alt, function(x) paste0("TE_partial_", sprintf("%08d", x$Cluster[1]))),
163 strand = sapply(gcl_alt, function(x) x$strand[1]),
164 Ndomains = sapply(gcl_alt, function(x) nrow(x)),
165 type = "transposable_element",
166 source = "dante_ltr",
167 Rank="D",
168 IRanges(start = sapply(gcl_alt, function(x) min(x$start)),
169 end = sapply(gcl_alt, function(x) max(x$end)))
170 )
171 g$Ndomains_in_cluster <- count_occurences_for_each_element(g$Cluster)
172 g$Parent <- paste0("TE_partial_", sprintf("%08d", g$Cluster))
173 g$Rank <- "D"
174
175 # keep only partial TE with more than one domain
176 TE_partial_with_more_than_one_domain <- TE_partial[TE_partial$Ndomains > 1]
177 g_with_more_than_one_domain <- g[as.vector(g$Ndomains_in_cluster > 1)]
178
179 # first filtering - remove TEs with low number of domains
180 gcl_clean <- clean_domain_clusters(gcl, lineage_domain_span, min_domains = 5 - opt$max_missing_domains)
181
182 # glc annotation
183 gcl_clean_lineage <- sapply(gcl_clean, function(x) x$Final_Classification[1])
184 gcl_clean_domains <- sapply(gcl_clean, function(x) ifelse(x$strand[1] == "-",
185 paste(rev(x$Name), collapse = " "),
186 paste(x$Name, collapse = " "))
187 )
188
189 # compare detected domains with domains in lineages from REXdb database
190 dd <- mapply(domain_distance,
191 d_query = gcl_clean_domains,
192 d_reference = lineage_domain[gcl_clean_lineage])
193
194 # get lineages which has correct number and order of domains
195 # gcl_clean2 <- gcl_clean[gcl_clean_domains == lineage_domain[gcl_clean_lineage]]
196 gcl_clean2 <- gcl_clean[dd <= opt$max_missing_domains]
197
198 gcl_clean_with_domains <- gcl_clean2[check_ranges(gcl_clean2, s)]
199 gr <- get_ranges(gcl_clean_with_domains)
200
201
202 cat('Number of analyzed regions:\n')
203 cat('Total number of domain clusters : ', length(gcl), '\n')
204 cat('Number of clean clusters : ', length(gcl_clean), '\n')
205 cat('Number of clusters with complete domain set : ', length(gcl_clean_with_domains), '\n')
206
207
208 te_strand <- sapply(gcl_clean_with_domains, function(x)x$strand[1])
209 te_lineage <- sapply(gcl_clean_with_domains, function(x)x$Final_Classification[1])
210
211 max_left_offset <- ifelse(te_strand == "+", lineage_offset5prime[te_lineage], lineage_offset3prime[te_lineage])
212 max_right_offset <- ifelse(te_strand == "-", lineage_offset5prime[te_lineage], lineage_offset3prime[te_lineage])
213
214 grL <- get_ranges_left(gcl_clean_with_domains, max_left_offset)
215 grR <- get_ranges_right(gcl_clean_with_domains, max_right_offset)
216
217 s_left <- getSeq(s, grL)
218 s_right <- getSeq(s, grR)
219
220 expected_ltr_length <- lineage_ltr_mean_length[sapply(gcl_clean_with_domains, function (x)x$Final_Classification[1])]
221 # for statistics
222 RT <- g[g$Name == "RT" & substring(g$Final_Classification, 1, 11) == "Class_I|LTR"]
223 # cleanup
224 #rm(g)
225 rm(gcl)
226 rm(gcl_clean)
227 rm(gcl_clean2)
228
229 names(te_strand) <- paste(seqnames(gr), start(gr), end(gr), sep = "_")
230 names(s_left) <- paste(seqnames(grL), start(grL), end(grL), sep = "_")
231 names(s_right) <- paste(seqnames(grR), start(grR), end(grR), sep = "_")
232 cat('Identification of LTRs...')
233 TE <- mclapply(seq_along(gr), function(x)get_TE(s_left[x],
234 s_right[x],
235 gcl_clean_with_domains[[x]],
236 gr[x],
237 grL[x],
238 grR[x],
239 expected_ltr_length[x]),
240 mc.set.seed = TRUE, mc.cores = opt$cpu, mc.preschedule = FALSE
241 )
242
243 cat('done.\n')
244
245 good_TE <- TE[!sapply(TE, is.null)]
246 cat('Number of putative TE with identified LTR :', length(good_TE), '\n')
247
248 # TODO - extent TE region to cover also TSD
249 ID <- paste0('TE_', sprintf("%08d", seq(good_TE)))
250 gff3_list <- mcmapply(get_te_gff3, g = good_TE, ID = ID, mc.cores = opt$cpu)
251
252 cat('Identification of PBS ...')
253 gff3_list2 <- mclapply(gff3_list, FUN = add_pbs, s = s, trna_db = trna_db, mc.set.seed = TRUE, mc.cores = opt$cpu, mc.preschedule = FALSE)
254 cat('done\n')
255 gff3_out <- do.call(c, gff3_list2)
256
257 # define new source
258 src <- as.character(gff3_out$source)
259 src[is.na(src)] <- "dante_ltr"
260 gff3_out$source <- src
261 gff3_out$Rank <- get_te_rank(gff3_out)
262
263 # add partial TEs but first remove all ovelaping
264 TE_partial_parent_part <- TE_partial_with_more_than_one_domain[TE_partial_with_more_than_one_domain %outside% gff3_out]
265 TE_partial_domain_part <- g[g$Parent %in% TE_partial_parent_part$ID]
266
267 gff3_out <- sort(c(gff3_out, TE_partial_domain_part, TE_partial_parent_part), by = ~ seqnames * start)
268 # modify ID and Parent - add seqname - this will ensure it is unique is done on chunk level
269 gff3_out$ID[!is.na(gff3_out$ID)] <- paste0(gff3_out$ID[!is.na(gff3_out$ID)], "_", seqnames(gff3_out)[!is.na(gff3_out$ID)])
270 gff3_out$Parent[!is.na(gff3_out$Parent)] <- paste0(gff3_out$Parent[!is.na(gff3_out$Parent)], "_", seqnames(gff3_out)[!is.na(gff3_out$Parent)])
271
272 export(gff3_out, con = paste0(outfile, ".gff3"), format = 'gff3')
273
274 all_tbl <- get_te_statistics(gff3_out, RT)
275 all_tbl <- cbind(Classification = rownames(all_tbl), all_tbl)
276 write.table(all_tbl, file = paste0(outfile, "_statistics.csv"), sep = "\t", quote = FALSE, row.names = FALSE)
277 # export fasta files:
278 s_te <- get_te_sequences(gff3_out, s)
279 for (i in seq_along(s_te)) {
280 outname <- paste0(outfile, "_", names(s_te)[i], ".fasta")
281 writeXStringSet(s_te[[i]], filepath = outname)
282 }
283