Skip to content

Commit

Permalink
Merge branch 'main' of https://github.com/Cristianetaniguti/Reads2MapApp
Browse files Browse the repository at this point in the history 
 into main
  • Loading branch information
@Cristianetaniguti
Cristianetaniguti committed Jan 7, 2024
2 parents 711c304 + c9bac7a commit 45fe044
Show file tree
Hide file tree
Showing 10 changed files with 504 additions and 389 deletions.
7 changes: 4 additions & 3 deletions DESCRIPTION
View file
Original file line number Diff line number Diff line change
Expand Up @@ -14,7 +14,6 @@ License: GPL-3
Encoding: UTF-8
LazyData: true
Roxygen: list(markdown = TRUE)
RoxygenNote: 7.2.3
Imports:
shiny,
shinydashboard,
Expand All @@ -39,6 +38,8 @@ Imports:
htmltools,
ggVennDiagram,
lubridate,
markdown
markdown,
ggrepel
URL: https://github.com/Cristianetaniguti/Reads2MapApp
BugReports: https://github.com/Cristianetaniguti/Reads2MapApp/issues
BugReports: https://github.com/Cristianetaniguti/Reads2MapApp/issues
RoxygenNote: 7.2.3
3 changes: 2 additions & 1 deletion Dockerfile
View file
Original file line number Diff line number Diff line change
Expand Up @@ -35,4 +35,5 @@ RUN Rscript -e 'remotes::install_github("mmollina/mappoly")'
RUN Rscript -e 'remotes::install_github("Cristianetaniguti/Reads2MapApp" )'

EXPOSE 80
CMD ["R", "-e", "options('shiny.port'=80,shiny.host='0.0.0.0');Reads2MapApp::run_app()"]
CMD ["R", "-e", "options('shiny.port'=80,shiny.host='0.0.0.0');Reads2MapApp::run_app()"]

1 change: 1 addition & 0 deletions NAMESPACE
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,6 +20,7 @@ import(tidyr)
import(vroom)
importFrom(config,get)
importFrom(ggpubr,ggarrange)
importFrom(ggrepel,geom_text_repel)
importFrom(golem,activate_js)
importFrom(golem,add_resource_path)
importFrom(golem,bundle_resources)
Expand Down
526 changes: 263 additions & 263 deletions R/app_ui.R
View file

Large diffs are not rendered by default.

12 changes: 8 additions & 4 deletions R/graphics_poly_emp.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -50,23 +50,27 @@ prepare_poly_datas_emp <- function(x = NULL, example_emp = NULL){

software <- "mappoly"
datas <- unlist(datas)
list_items <- c("dat", "mat2", "map")
list_items <- c("dat", "mat2", "maps", "summaries", "info")
result_list <- list()
for(j in 1:length(list_items)){
files <- datas[grep(list_items[j], datas)]
if(length(files) > 0){
temp_item <- list()
for(i in 1:length(files)){
if(grepl("map", files[i]) & !grepl("0", files[i])){
temp_item[[i]] <- list(readRDS(files[i]))
} else temp_item[[i]] <- readRDS(files[i])
temp_item[[i]] <- readRDS(files[i])
}
} else temp_item <- NULL
names(temp_item) <- sapply(strsplit(basename(files), "_"), function(x) paste0(x[1:3], collapse = "_"))
result_list[[j]] <- temp_item
}
names(result_list) <- list_items
result_list$software <- software
result_list1 <- result_list

for(i in 1:5){
idx <- which(sapply(result_list[[i]], is.list))
if(length(result_list[[i]]) > length(idx)) result_list[[i]][-idx] <- NULL
}

return(result_list)
}
Expand Down
219 changes: 149 additions & 70 deletions R/mod_dat_poly.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -28,28 +28,39 @@ mod_dat_poly_ui <- function(id){
)
), hr(),
column(width = 12,

box(title = "Dataset overview",
width = NULL, solidHeader = TRUE, collapsible = FALSE, status="primary",
div(downloadButton(ns("dats_down"), label = "Download PDF with all"),style="float:right"),
div(downloadButton(ns("dats_down"), label = "Download as PDF image"),style="float:right"),
actionButton(ns("go1"), "Update",icon("refresh", verify_fa = FALSE)),
plotOutput(ns("dat_out")),hr(),
plotOutput(ns("dat_out"))
),
column(width = 6,
box(title = "Recombination fraction heatmap",
width = NULL, solidHeader = TRUE, collapsible = FALSE, status="primary",
div(downloadButton(ns("rf_down"), label = "Download PDF with all"),style="float:right"),
plotOutput(ns("rf_out"), width = "600px", height = "600px"),hr(),
)
box(title = "Recombination fraction heatmap",
width = NULL, solidHeader = TRUE, collapsible = FALSE, status="primary",
div(downloadButton(ns("rf_down"), label = "Download as PDF image"),style="float:right"),
plotOutput(ns("rf_out"), width = "600px", height = "600px"),hr(),
),
column(width = 6,
box(title = "Genetic map",
width = NULL, solidHeader = TRUE, collapsible = FALSE, status="primary",
actionButton(ns("go2"), "Update",icon("refresh", verify_fa = FALSE)),
div(downloadButton(ns("map_down"), label = "Download PDF with all"),style="float:right"),
imageOutput(ns("map_out"), width = "100%", height = "100%"),
)
)
box(title = "Select markers",
width = NULL, solidHeader = TRUE, collapsible = FALSE, status="primary",
sliderInput(ns("interval"), label = "Select map size interval", min = 10, max = 200, value = c(90,120)), br(),
radioButtons(ns("prob"), label = h3("Radio buttons"),
choices = list("5% global error" = "error", "probabilities" = 2),
selected = "error"),
actionButton(ns("go2"), "Update",icon("refresh", verify_fa = FALSE)), br(),
textOutput(ns("selected")), br(),
div(downloadButton(ns("selected_down"),
label = "Download the list of selected markers IDs"),style="float:right")
),
box(title = "Build map",
width = NULL, solidHeader = TRUE, collapsible = FALSE, status="primary",
p("Building the map will take a while, make sure you selected your best pipeline and interval."), br(),
numericInput(ns("ncores"), label = "Set number of cores to be used for the analysis", value =1), br(),
actionButton(ns("go3"), "Update",icon("refresh", verify_fa = FALSE)),
plotOutput(ns("built_map"),height = "600px"), br(),
plotOutput(ns("rf_built_map"), width = "600px", height = "600px"),
div(downloadButton(ns("datas_down"),
label = "Download a list object with \n selected dataset (first list level)
\n and built map (second list level)"),style="float:right")
), hr()
)
)
)
Expand All @@ -65,7 +76,7 @@ mod_dat_poly_server <- function(input, output, session, datas_poly_emp){
ns <- session$ns

observe({
file_names <- strsplit(names(datas_poly_emp()[[3]]), "_")
file_names <- strsplit(names(datas_poly_emp()[[1]]), "_")
SNPCall_choice <- as.list(unique(sapply(file_names, "[[", 1)))
names(SNPCall_choice) <- unique(sapply(file_names, "[[", 1))

Expand Down Expand Up @@ -108,25 +119,27 @@ mod_dat_poly_server <- function(input, output, session, datas_poly_emp){
grepl(sapply(strsplit(input$ErrorProb, "0"), "[[",1), names(datas_poly_emp()$mat2)))

idx1 <- which(grepl(input$CountsFrom, names(datas_poly_emp()$dat)) &
grepl(input$SNPCall, names(datas_poly_emp()$dat)) &
grepl(sapply(strsplit(input$ErrorProb, "0"), "[[",1), names(datas_poly_emp()$dat)))
grepl(input$SNPCall, names(datas_poly_emp()$dat)) &
grepl(sapply(strsplit(input$ErrorProb, "0"), "[[",1), names(datas_poly_emp()$dat)))

idx2 <- which(grepl(input$CountsFrom, names(datas_poly_emp()$map)) &
grepl(input$SNPCall, names(datas_poly_emp()$map)) &
grepl(paste0(input$ErrorProb, "_"), names(datas_poly_emp()$map)))
idx2 <- which(grepl(input$CountsFrom, names(datas_poly_emp()$maps)) &
grepl(input$SNPCall, names(datas_poly_emp()$maps)) &
grepl(paste0(input$ErrorProb, "_"), names(datas_poly_emp()$maps)))


cat(paste("map:", names(datas_poly_emp()$map)[idx2], "\n"))
seq <- datas_poly_emp()$map[[idx2]][[1]]
cat(paste("map:", names(datas_poly_emp()$maps)[idx2], "\n"))
seq <- datas_poly_emp()$map[[idx2]]

cat(idx, "\n")
cat(paste("mat:", names(datas_poly_emp()$mat2)[idx], "\n"))
mat <- datas_poly_emp()$mat2[[idx]]

cat(paste("dat:", names(datas_poly_emp()$dat)[idx1], "\n"))
dat <- datas_poly_emp()$dat[[idx1]]

list(dat, mat, seq, input$ErrorProb)
dat <<- datas_poly_emp()$dat[[idx1]]

summary <- datas_poly_emp()$summaries[[which(names(datas_poly_emp()$summaries) %in% names(datas_poly_emp()$dat)[idx1])]]
info <- datas_poly_emp()$info[[which(names(datas_poly_emp()$info) %in% names(datas_poly_emp()$dat)[idx1])]]

list(dat, mat, seq, summary, info, input$ErrorProb)
})
})

Expand All @@ -135,37 +148,124 @@ mod_dat_poly_server <- function(input, output, session, datas_poly_emp){
})

output$rf_out <- renderPlot({
mappoly:::plot.mappoly.rf.matrix(button1()[[2]], ord = button1()[[3]]$info$mrk.names, type = "lod")
mappoly:::plot.mappoly.rf.matrix(button1()[[2]], ord = button1()[[3]]$info$mrk.names)
})

button2 <- eventReactive(input$go2, {
withProgress(message = 'Building draw', value = 0, {
withProgress(message = 'Building heatmap', value = 0, {
incProgress(0, detail = paste("Doing part", 1))
df <- button1()[[4]]
df$`Map length (cM)` <- as.numeric(button1()[[4]]$`Map length (cM)`)
summary_sub <- df %>% filter(map == paste0(input$prob, ".p1"))
idx.p1 <- which(summary_sub$`Map length (cM)` >= input$interval[1] &
summary_sub$`Map length (cM)` <= input$interval[2])

stop_bam(input$CountsFrom, input$ErrorProb)
summary_sub <- df %>% filter(map == paste0(input$prob, ".p2"))
idx.p2 <- which(summary_sub$`Map length (cM)` >= input$interval[1] &
summary_sub$`Map length (cM)` <= input$interval[2])

incProgress(0.5, detail = paste("Doing part", 2))
if(input$prob == "error"){
selec.p1 <- button1()[[3]]$map.err.p1[idx.p1]
selec.p1 <- unlist(sapply(selec.p1, function(x) x$info$mrk.names))
selec.p1 <- unique(selec.p1)

selec.p2 <- button1()[[3]]$map.err.p2[idx.p2]
selec.p2 <- unlist(sapply(selec.p2, function(x) x$info$mrk.names))
selec.p2 <- unique(selec.p2)
select.mks <- unique(c(selec.p1, selec.p2))

} else {
selec.p1 <- button1()[[3]]$map.prob.p1[idx.p1]
selec.p1 <- unlist(sapply(selec.p1, function(x) x$info$mrk.names))
selec.p1 <- unique(selec.p1)

selec.p2 <- button1()[[3]]$map.prob.p2[idx.p2]
selec.p2 <- unlist(sapply(selec.p2, function(x) x$info$mrk.names))
selec.p2 <- unique(selec.p2)
select.mks <- unique(selec.p1, selec.p2)
}

pos <- button1()[[1]]$genome.pos[match(select.mks, button1()[[1]]$mrk.names)]
select.mks <- select.mks[order(pos)]
select.mks
})
})

output$selected <- renderText({
paste0("Number of selected markers:",
length(button2()))
})

output$selected_down <- downloadHandler(
filename = function() {
tempfile(pattern = "file", tmpdir = tempdir(), fileext = ".csv")
},
# content is a function with argument file. content writes the plot to the device
content = function(file) {

datas_lst <- data.frame(selected_markers = button2())
white.csv(datas_lst, file = file)

}
)

build_map <- eventReactive(input$go3, {
withProgress(message = 'Building map', value = 0, {
incProgress(0, detail = paste("Doing part", 1))

idx <- which(grepl(input$CountsFrom, names(datas_poly_emp()$map)) &
grepl(input$SNPCall, names(datas_poly_emp()$map)) &
grepl(paste0(input$ErrorProb, "_"), names(datas_poly_emp()$map)))
dat <- button1()[[1]]
seq_dat <- make_seq_mappoly(dat, button2())

data <- datas_poly_emp()$map[[idx]][[1]]
tpt <- est_pairwise_rf(seq_dat, ncpus = input$ncores)
incProgress(0.3, detail = paste("Doing part", 2))

outfile <- tempfile(pattern="file", tmpdir = tempdir(), fileext = ".png")
list(data, outfile)
map <- est_rf_hmm_sequential(input.seq = seq_dat,
start.set = 5,
thres.twopt = 10,
thres.hmm = 10,
extend.tail = 30,
info.tail = TRUE,
twopt = tpt,
phase.number.limit = 10,
reestimate.single.ph.configuration = TRUE,
tol = 10e-2,
tol.final = 10e-4,
verbose = FALSE)
incProgress(0.8, detail = paste("Doing part", 4))

map <- filter_map_at_hmm_thres(map, thres.hmm = 0.0001)
map2 <- est_full_hmm_with_global_error(map, error = 0.05, tol = 10e-3)
map3 <- split_and_rephase(map2, gap.threshold = 20, size.rem.cluster = 3, twopt = tpt)
map.final <- est_full_hmm_with_global_error(map3, error = 0.05, tol = 10e-4)
map.final
})
})

output$map_out <- renderImage({

png(button2()[[2]])
mappoly:::plot.mappoly.map(button2()[[1]])
dev.off()

list(src = button2()[[2]],
contentType = 'image/png')
}, deleteFile = TRUE)
output$built_map <- renderPlot({
plot(build_map())
})

output$rf_built_map <- renderPlot({
mappoly:::plot.mappoly.rf.matrix(button1()[[2]], ord = build_map()$info$mrk.names)
})


## download all
output$datas_down <- downloadHandler(
filename = function() {
tempfile(pattern = "file", tmpdir = tempdir(), fileext = ".rds")
},
# content is a function with argument file. content writes the plot to the device
content = function(file) {

dat <- button1()[[1]]
datas_lst <- list(dat, build_map())
saveRDS(datas_lst, file = file)

}
)

## download all
output$dats_down <- downloadHandler(
filename = function() {
Expand Down Expand Up @@ -202,34 +302,13 @@ mod_dat_poly_server <- function(input, output, session, datas_poly_emp){
for(i in 1:length(datas_poly_emp()$mat2)){
idx <- match(names(datas_poly_emp()$mat2)[i], gsub("0.05", "", names(datas_poly_emp()$map)))[1]
mappoly:::plot.mappoly.rf.matrix(datas_poly_emp()$mat2[[i]],
ord = datas_poly_emp()$map[[idx]][[1]]$info$mrk.names, type = "lod")
ord = datas_poly_emp()$map[[idx]][[1]]$info$mrk.names)
mtext(text = names(datas_poly_emp()$mat2)[i], side = 1)
}
dev.off()
})
}
)


## download all onemap heatmaps
output$map_down <- downloadHandler(
filename = function() {
tempfile(pattern = "file", tmpdir = tempdir(), fileext = ".pdf")
},
# content is a function with argument file. content writes the plot to the device
content = function(file) {
withProgress(message = 'Building heatmap', value = 0, {
incProgress(0, detail = paste("Doing part", 1))

pdf(file = file, onefile = T)
for(i in 1:length(datas_poly_emp()$map)){
mappoly:::plot.mappoly.map(datas_poly_emp()$map[[i]][[1]])
mtext(text = names(datas_poly_emp()$map)[i], side = 3)
}
dev.off()
})
}
)
}

## To be copied in the UI
Expand Down
Loading

0 comments on commit 45fe044

Please sign in to comment.