Skip to content

Commit

Permalink
fixing bug in channels and adding functionalities to plot multiple sa…
Browse files Browse the repository at this point in the history
…mples in alfred
  • Loading branch information
davidebolo1993 committed Jul 24, 2023
1 parent 002357d commit 5615ab1
Show file tree
Hide file tree
Showing 8 changed files with 80 additions and 52 deletions.
2 changes: 1 addition & 1 deletion .Rproj.user/F43DE67C/pcs/files-pane.pper
Original file line number Diff line number Diff line change
Expand Up @@ -5,5 +5,5 @@
"ascending": true
}
],
"path": "~/NanoR"
"path": "~/NanoR/R"
}
2 changes: 1 addition & 1 deletion .Rproj.user/F43DE67C/pcs/source-pane.pper
Original file line number Diff line number Diff line change
@@ -1,3 +1,3 @@
{
"activeTab": 2
"activeTab": 1
}
12 changes: 6 additions & 6 deletions .Rproj.user/F43DE67C/pcs/windowlayoutstate.pper
Original file line number Diff line number Diff line change
@@ -1,14 +1,14 @@
{
"left": {
"splitterpos": 425,
"splitterpos": 445,
"topwindowstate": "NORMAL",
"panelheight": 1089,
"windowheight": 1127
"panelheight": 1146,
"windowheight": 1184
},
"right": {
"splitterpos": 676,
"splitterpos": 710,
"topwindowstate": "NORMAL",
"panelheight": 1089,
"windowheight": 1127
"panelheight": 1146,
"windowheight": 1184
}
}
2 changes: 1 addition & 1 deletion .Rproj.user/F43DE67C/persistent-state
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
build-last-errors="[]"
build-last-errors-base-dir="~/NanoR/"
build-last-outputs="[{\"type\":0,\"output\":\"==> devtools::document(roclets = c('rd', 'collate', 'namespace'))\\n\\n\"},{\"type\":1,\"output\":\"\\u001B[36mℹ\\u001B[39m Updating \\u001B[34m\\u001B[34mNanoR\\u001B[34m\\u001B[39m documentation\\n\"},{\"type\":1,\"output\":\"\\u001B[36mℹ\\u001B[39m Loading \\u001B[34m\\u001B[34mNanoR\\u001B[34m\\u001B[39m\\n\"},{\"type\":2,\"output\":\"Warning: package ‘plotly’ was built under R version 4.1.1\\n\"},{\"type\":2,\"output\":\"Warning: package ‘ggplot2’ was built under R version 4.1.1\\nWarning: package ‘scales’ was built under R version 4.1.1\\nWarning: package ‘data.table’ was built under R version 4.1.1\\nWarning: package ‘dplyr’ was built under R version 4.1.1\\nWarning: package ‘tidyr’ was built under R version 4.1.1\\n\"},{\"type\":2,\"output\":\"Warning: \\u001B[1m\\u001B[22mSkipping \\u001B]8;;file:///Users/davide.bolognini/NanoR/NAMESPACE\\u0007\\u001B[34mNAMESPACE\\u001B[39m\\u001B]8;;\\u0007\\n\\u001B[31m✖\\u001B[39m It already exists and was not generated by roxygen2.\\n\"},{\"type\":1,\"output\":\"Documentation completed\\n\\n\"},{\"type\":0,\"output\":\"==> R CMD INSTALL --preclean --no-multiarch --with-keep.source NanoR\\n\\n\"},{\"type\":1,\"output\":\"* installing to library ‘/Users/davide.bolognini/Library/R/arm64/4.1/library’\\n\"},{\"type\":1,\"output\":\"* installing *source* package ‘NanoR’ ...\\n\"},{\"type\":1,\"output\":\"\"},{\"type\":1,\"output\":\"** using staged installation\\n\"},{\"type\":1,\"output\":\"\"},{\"type\":1,\"output\":\"** R\\n\"},{\"type\":1,\"output\":\"** data\\n\"},{\"type\":1,\"output\":\"\"},{\"type\":1,\"output\":\"*** moving datasets to lazyload DB\\n\"},{\"type\":1,\"output\":\"\"},{\"type\":1,\"output\":\"** inst\\n\"},{\"type\":1,\"output\":\"** byte-compile and prepare package for lazy loading\\n\"},{\"type\":1,\"output\":\"\"},{\"type\":1,\"output\":\"Warning messages:\\n\"},{\"type\":1,\"output\":\"1: package ‘plotly’ was built under R version 4.1.1 \\n\"},{\"type\":1,\"output\":\"2: package ‘ggplot2’ was built under R version 4.1.1 \\n\"},{\"type\":1,\"output\":\"3: package ‘scales’ was built under R version 4.1.1 \\n\"},{\"type\":1,\"output\":\"4: package ‘data.table’ was built under R version 4.1.1 \\n\"},{\"type\":1,\"output\":\"5: package ‘dplyr’ was built under R version 4.1.1 \\n\"},{\"type\":1,\"output\":\"6: package ‘tidyr’ was built under R version 4.1.1 \\n\"},{\"type\":1,\"output\":\"\"},{\"type\":1,\"output\":\"** help\\n\"},{\"type\":1,\"output\":\"\"},{\"type\":1,\"output\":\"*** installing help indices\\n\"},{\"type\":1,\"output\":\"\"},{\"type\":1,\"output\":\"** building package indices\\n\"},{\"type\":1,\"output\":\"\"},{\"type\":1,\"output\":\"** testing if installed package can be loaded from temporary location\\n\"},{\"type\":1,\"output\":\"\"},{\"type\":2,\"output\":\"Warning: package ‘plotly’ was built under R version 4.1.1\\n\"},{\"type\":2,\"output\":\"Warning: package ‘ggplot2’ was built under R version 4.1.1\\n\"},{\"type\":2,\"output\":\"Warning: package ‘scales’ was built under R version 4.1.1\\n\"},{\"type\":2,\"output\":\"Warning: package ‘data.table’ was built under R version 4.1.1\\n\"},{\"type\":2,\"output\":\"Warning: package ‘dplyr’ was built under R version 4.1.1\\n\"},{\"type\":2,\"output\":\"Warning: package ‘tidyr’ was built under R version 4.1.1\\n\"},{\"type\":1,\"output\":\"\"},{\"type\":1,\"output\":\"** testing if installed package can be loaded from final location\\n\"},{\"type\":1,\"output\":\"\"},{\"type\":2,\"output\":\"Warning: package ‘plotly’ was built under R version 4.1.1\\n\"},{\"type\":2,\"output\":\"Warning: package ‘ggplot2’ was built under R version 4.1.1\\n\"},{\"type\":2,\"output\":\"Warning: package ‘scales’ was built under R version 4.1.1\\n\"},{\"type\":2,\"output\":\"Warning: package ‘data.table’ was built under R version 4.1.1\\n\"},{\"type\":2,\"output\":\"Warning: package ‘dplyr’ was built under R version 4.1.1\\n\"},{\"type\":2,\"output\":\"Warning: package ‘tidyr’ was built under R version 4.1.1\\n\"},{\"type\":1,\"output\":\"\"},{\"type\":1,\"output\":\"** testing if installed package keeps a record of temporary installation path\\n\"},{\"type\":1,\"output\":\"* DONE (NanoR)\\n\"},{\"type\":1,\"output\":\"\"}]"
build-last-outputs="[{\"type\":0,\"output\":\"==> devtools::document(roclets = c('rd', 'collate', 'namespace'))\\n\\n\"},{\"type\":1,\"output\":\"\\u001B[36mℹ\\u001B[39m Updating \\u001B[34m\\u001B[34mNanoR\\u001B[34m\\u001B[39m documentation\\n\"},{\"type\":1,\"output\":\"\\u001B[36mℹ\\u001B[39m Loading \\u001B[34m\\u001B[34mNanoR\\u001B[34m\\u001B[39m\\n\"},{\"type\":2,\"output\":\"Warning: package ‘plotly’ was built under R version 4.1.1\\nWarning: package ‘ggplot2’ was built under R version 4.1.1\\nWarning: package ‘scales’ was built under R version 4.1.1\\nWarning: package ‘data.table’ was built under R version 4.1.1\\nWarning: package ‘dplyr’ was built under R version 4.1.1\\n\"},{\"type\":2,\"output\":\"Warning: package ‘tidyr’ was built under R version 4.1.1\\n\"},{\"type\":2,\"output\":\"Warning: \\u001B[1m\\u001B[22mSkipping \\u001B]8;;file:///Users/davide.bolognini/NanoR/NAMESPACE\\u0007\\u001B[34mNAMESPACE\\u001B[39m\\u001B]8;;\\u0007\\n\\u001B[31m✖\\u001B[39m It already exists and was not generated by roxygen2.\\n\"},{\"type\":1,\"output\":\"Documentation completed\\n\\n\"},{\"type\":0,\"output\":\"==> R CMD INSTALL --preclean --no-multiarch --with-keep.source NanoR\\n\\n\"},{\"type\":1,\"output\":\"* installing to library ‘/Users/davide.bolognini/Library/R/arm64/4.1/library’\\n\"},{\"type\":1,\"output\":\"* installing *source* package ‘NanoR’ ...\\n\"},{\"type\":1,\"output\":\"\"},{\"type\":1,\"output\":\"** using staged installation\\n\"},{\"type\":1,\"output\":\"** R\\n\"},{\"type\":1,\"output\":\"** data\\n\"},{\"type\":1,\"output\":\"\"},{\"type\":1,\"output\":\"*** moving datasets to lazyload DB\\n\"},{\"type\":1,\"output\":\"\"},{\"type\":1,\"output\":\"** inst\\n\"},{\"type\":1,\"output\":\"** byte-compile and prepare package for lazy loading\\n\"},{\"type\":1,\"output\":\"\"},{\"type\":1,\"output\":\"Warning messages:\\n\"},{\"type\":1,\"output\":\"1: package ‘plotly’ was built under R version 4.1.1 \\n\"},{\"type\":1,\"output\":\"2: package ‘ggplot2’ was built under R version 4.1.1 \\n\"},{\"type\":1,\"output\":\"3: package ‘scales’ was built under R version 4.1.1 \\n\"},{\"type\":1,\"output\":\"4: package ‘data.table’ was built under R version 4.1.1 \\n\"},{\"type\":1,\"output\":\"5: package ‘dplyr’ was built under R version 4.1.1 \\n\"},{\"type\":1,\"output\":\"6: package ‘tidyr’ was built under R version 4.1.1 \\n\"},{\"type\":1,\"output\":\"\"},{\"type\":1,\"output\":\"** help\\n\"},{\"type\":1,\"output\":\"\"},{\"type\":1,\"output\":\"*** installing help indices\\n\"},{\"type\":1,\"output\":\"** building package indices\\n\"},{\"type\":1,\"output\":\"\"},{\"type\":1,\"output\":\"** testing if installed package can be loaded from temporary location\\n\"},{\"type\":1,\"output\":\"\"},{\"type\":2,\"output\":\"Warning: package ‘plotly’ was built under R version 4.1.1\\n\"},{\"type\":2,\"output\":\"Warning: package ‘ggplot2’ was built under R version 4.1.1\\n\"},{\"type\":2,\"output\":\"Warning: package ‘scales’ was built under R version 4.1.1\\n\"},{\"type\":2,\"output\":\"Warning: package ‘data.table’ was built under R version 4.1.1\\n\"},{\"type\":2,\"output\":\"Warning: package ‘dplyr’ was built under R version 4.1.1\\n\"},{\"type\":2,\"output\":\"Warning: package ‘tidyr’ was built under R version 4.1.1\\n\"},{\"type\":1,\"output\":\"\"},{\"type\":1,\"output\":\"** testing if installed package can be loaded from final location\\n\"},{\"type\":1,\"output\":\"\"},{\"type\":2,\"output\":\"Warning: package ‘plotly’ was built under R version 4.1.1\\n\"},{\"type\":2,\"output\":\"Warning: package ‘ggplot2’ was built under R version 4.1.1\\n\"},{\"type\":2,\"output\":\"Warning: package ‘scales’ was built under R version 4.1.1\\n\"},{\"type\":2,\"output\":\"Warning: package ‘data.table’ was built under R version 4.1.1\\n\"},{\"type\":2,\"output\":\"Warning: package ‘dplyr’ was built under R version 4.1.1\\n\"},{\"type\":2,\"output\":\"Warning: package ‘tidyr’ was built under R version 4.1.1\\n\"},{\"type\":1,\"output\":\"\"},{\"type\":1,\"output\":\"** testing if installed package keeps a record of temporary installation path\\n\"},{\"type\":1,\"output\":\"* DONE (NanoR)\\n\"},{\"type\":1,\"output\":\"\"}]"
compile_pdf_state="{\"tab_visible\":false,\"running\":false,\"target_file\":\"\",\"output\":\"\",\"errors\":[]}"
files.monitored-path=""
find-in-files-state="{\"handle\":\"\",\"input\":\"\",\"path\":\"\",\"regex\":false,\"ignoreCase\":false,\"results\":{\"file\":[],\"line\":[],\"lineValue\":[],\"matchOn\":[],\"matchOff\":[],\"replaceMatchOn\":[],\"replaceMatchOff\":[]},\"running\":false,\"replace\":false,\"preview\":false,\"gitFlag\":false,\"replacePattern\":\"\"}"
Expand Down
2 changes: 2 additions & 0 deletions .Rproj.user/F43DE67C/sources/prop/INDEX
Original file line number Diff line number Diff line change
@@ -1,5 +1,7 @@
~%2FNanoR%2FDESCRIPTION="300FBE73"
~%2FNanoR%2FR%2Falfredstats.R="051BA4F2"
~%2FNanoR%2FR%2Fcompare.R="DDB686B2"
~%2FNanoR%2FR%2Fheatmap.R="EC1BCDCE"
~%2FNanoR%2FR%2Fmuxscan.R="68F33D03"
~%2FNanoR%2FREADME.md="668CEBF6"
~%2FNanoR%2Fman%2Fcompare.Rd="35EB6A46"
1 change: 1 addition & 0 deletions .Rproj.user/shared/notebooks/paths
Original file line number Diff line number Diff line change
@@ -1 +1,2 @@
/Users/davide.bolognini/NanoR/DESCRIPTION="3D0E67B2"
/Users/davide.bolognini/NanoR/R/heatmap.R="0847926F"
71 changes: 48 additions & 23 deletions R/alfredstats.R
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
#' @title alfredstats
#' @description generate an interactive HTML report with statistics from alfred qc (zgrep "^ME <qc.tsv.gz> | cut -f 2- | datamash transpose)
#' @param qcdata path to alfred qc.tsv.gz
#' @param qcdata path to alfred qc.tsv.gz
#' @param out path to HTML report
#' @return HTML file
#' @examples
Expand All @@ -27,7 +27,7 @@ alfredstats<-function(qcdata,out) {
"ErrorRate")

error_df<- df[which(df$Sample %in% keep),]
error_df[match(keep, error_df$Sample),]
error_df<-error_df[match(keep, error_df$Sample),]

error_df<-transpose(error_df)
names(error_df) <- as.character(unlist(error_df[1,]))
Expand All @@ -37,15 +37,15 @@ alfredstats<-function(qcdata,out) {
colnames(error_df)<-c(colnames(error_df)[c(1:length(colnames(error_df))-1)], c("#TotalErrors"))
cols<-colnames(error_df)
error_df<-transpose(error_df)
error_df$V2<-error_df$V1
error_df$V1<-cols
colnames(error_df)<-colnames(df)[c(2:ncol(df))]
error_df$V0<-cols

#counts
error_counts_df<-error_df[grepl("#", error_df$V1),]
error_counts_df$V1<-factor(error_counts_df$V1, levels=as.character(error_counts_df$V1))
error_counts_df<-error_df[grepl("#", error_df$V0),]
error_counts_df$V0<-factor(error_counts_df$V0, levels=as.character(error_counts_df$V0))
#rates
error_rates_df<-error_df[!grepl("#", error_df$V1),]
error_rates_df$V1<-factor(error_rates_df$V1, levels=as.character(error_rates_df$V1))
error_rates_df<-error_df[!grepl("#", error_df$V0),]
error_rates_df$V0<-factor(error_rates_df$V0, levels=as.character(error_rates_df$V0))


#aligned reads
Expand All @@ -56,18 +56,19 @@ alfredstats<-function(qcdata,out) {
"#MappedReverse", "MappedReverseFraction",
"#SecondaryAlignments", "SecondaryAlignmentFraction",
"#SupplementaryAlignments", "SupplementaryAlignmentFraction",
"#SplicedAlignments", "SplicedAlignmentFraction"
"#SplicedAlignments", "SplicedAlignmentFraction"
)

alignment_df<-df[which(df$Sample %in% keep),]
colnames(alignment_df)<-c("V1", "V2")
colnames(alignment_df)[1]<-c("V0")
alignment_df<-alignment_df %>% dplyr::relocate(V0, .after = last_col())

#counts
alignment_counts_df<-alignment_df[grepl("#", alignment_df$V1),]
alignment_counts_df$V1<-factor(alignment_counts_df$V1, levels=as.character(alignment_counts_df$V1))
alignment_counts_df<-alignment_df[grepl("#", alignment_df$V0),]
alignment_counts_df$V0<-factor(alignment_counts_df$V0, levels=as.character(alignment_counts_df$V0))
#rates
alignment_rates_df<-alignment_df[!grepl("#", alignment_df$V1),]
alignment_rates_df$V1<-factor(alignment_rates_df$V1, levels=as.character(alignment_rates_df$V1))
alignment_rates_df<-alignment_df[!grepl("#", alignment_df$V0),]
alignment_rates_df$V0<-factor(alignment_rates_df$V0, levels=as.character(alignment_rates_df$V0))

f <- list(
size = 10,
Expand All @@ -82,24 +83,48 @@ alfredstats<-function(qcdata,out) {
buttons = list(
list(label = "counts",
method = "restyle",
args = list("visible", list(TRUE,FALSE))),
args = list("visible", sapply(rep(c(TRUE,FALSE),each=(ncol(error_counts_df)-1)),list))),
list(label = "rates",
method = "restyle",
args = list("visible", list(FALSE,TRUE)))
args = list("visible", sapply(rep(c(FALSE,TRUE),each=(ncol(error_counts_df)-1)),list)))
)
)

message("[",Sys.time(),"]"," plotting")

p1<-plot_ly() %>% add_trace(x=error_counts_df$V1,y=as.numeric(error_counts_df$V2),type="bar", color = I("darkblue"), name = "#bp", visible=TRUE) %>%
add_trace(x=error_rates_df$V1,y=as.numeric(error_rates_df$V2),type="bar", color = I("darkred"), name = ":bp", visible=FALSE) %>%
layout(showlegend=FALSE,updatemenus = list(chart_type))
p1<-plot_ly()

p2<-plot_ly() %>% add_trace(x=alignment_counts_df$V1,y=as.numeric(alignment_counts_df$V2),type="bar", color = I("darkblue"), name = "#reads", visible=TRUE) %>%
add_trace(x=alignment_rates_df$V1,y=as.numeric(alignment_rates_df$V2),type="bar", color = I("darkred"), name = ":reads", visible=FALSE) %>%
layout(showlegend=FALSE,updatemenus = list(chart_type), title="Alfred statistics")
for (n in c(1:(ncol(error_counts_df)-1))) {

p1<-p1 %>% add_trace(x=error_counts_df$V0, y=as.numeric(unlist(error_counts_df[,..n])), name = colnames(error_counts_df[,..n]), legendgroup= colnames(error_counts_df[,..n]),type="bar", visible=TRUE)

}

for (n in c(1:(ncol(error_rates_df)-1))) {

p1<-p1 %>% add_trace(x=error_rates_df$V0, y=as.numeric(unlist(error_rates_df[,..n])), name = colnames(error_rates_df[,..n]), legendgroup= colnames(error_rates_df[,..n]), type="bar", visible=FALSE)

}

p1<-p1%>%layout(showlegend=FALSE,updatemenus = list(chart_type), barmode = 'group')


p2<-plot_ly()

for (n in c(1:(ncol(alignment_counts_df)-1))) {

p2<-p2 %>% add_trace(x=alignment_counts_df$V0, y=as.numeric(unlist(alignment_counts_df[,..n])), name = colnames(alignment_counts_df[,..n]), legendgroup= colnames(alignment_counts_df[,..n]), type="bar", visible=TRUE)

}

for (n in c(1:(ncol(alignment_rates_df)-1))) {

p2<-p2 %>% add_trace(x=alignment_rates_df$V0, y=as.numeric(unlist(alignment_rates_df[,..n])), name = colnames(alignment_rates_df[,..n]), legendgroup= colnames(alignment_rates_df[,..n]), type="bar", visible=FALSE)

}

p2<-p2%>%layout(showlegend=TRUE,updatemenus = list(chart_type), barmode = 'group')


fig<- subplot(p1,p2,nrows = 2,titleX=TRUE, titleY=TRUE,margin=.05)

message("[",Sys.time(),"]"," storing plot to file")
Expand Down
40 changes: 20 additions & 20 deletions R/heatmap.R
Original file line number Diff line number Diff line change
Expand Up @@ -22,16 +22,16 @@ heatmap<-function(summary,time=1,platform="minion",out) {
getPromethIONChannelMap <- function() {

chunk <- function(i) {

m <- matrix(seq_len(250), ncol=10, byrow=TRUE)
m + i

}

layout <- do.call(cbind, lapply(seq(from=0, to=2750, by=250), chunk))
channelMap <- as.data.frame(cbind(channel = as.vector(t(layout)), which(layout == as.vector(layout), arr.ind = TRUE)))
return(channelMap)

}


Expand All @@ -41,30 +41,30 @@ heatmap<-function(summary,time=1,platform="minion",out) {
#layout <- layout[rev(seq(10)), ]
#channelMap <- as.data.frame(cbind(channel = as.vector(t(layout)), which(layout == as.vector(layout), arr.ind = TRUE)))
#return(channelMap)

#}


getMinIONChannelMap <- function() {

# build the map for R9.4.1 flowcell, as a long-form dataframe
blockCalc <- function(i) {

m <- matrix(seq(i, i + 63, by = 1), ncol = 8, byrow = TRUE)
cbind(m[seq(5, 8, by = 1), ], m[seq(4), rev(seq(8))])

}

layout <- do.call(rbind, lapply(c(1, 449, 385, 321, 257, 193, 129, 65), blockCalc))

# transpose the layout for cleaner presentation ...
#layout <- t(layout)
channelMap <- as.data.frame(cbind(channel = as.vector(t(layout)), which( layout == as.vector(layout), arr.ind = TRUE)))
return(channelMap)

}


summary<-normalizePath(file.path(summary))
out<-file.path(out)

Expand Down Expand Up @@ -113,23 +113,23 @@ heatmap<-function(summary,time=1,platform="minion",out) {

channels_activity_overtime<-channels_activity_overtime_pass<-matrix(0,ncol=n_channels, nrow=length(bins)-1)
channels_activity<-channels_activity_pass<-rep(0,n_channels)

for (i in c(1:n_channels)) {

subtab<-tab[channel==i]
channels_activity[i]<-sum(subtab$sequence_length_template)
channels_activity_pass[i]<-sum(subtab[passes_filtering == TRUE]$sequence_length_template)

for (l in c(1:(length(bins)-1))) {

from<-bins[l]
to<-bins[l+1]
subsubtab<-subtab[template_unix > from & template_unix <= to]
channels_activity_overtime[l,i]<-sum(subsubtab$sequence_length_template)
channels_activity_overtime_pass[l,i]<-sum(subsubtab[passes_filtering == TRUE]$sequence_length_template)

}

}

channels_activity_labels<-matrix("0",nrow=max(layout$row),ncol=max(layout$col))
Expand All @@ -141,8 +141,8 @@ heatmap<-function(summary,time=1,platform="minion",out) {
c<-layout$col[m]
label<-layout$channel[m]
channels_activity_labels[r,c]<-as.character(label)
channels_activity_map[r,c]<-channels_activity[m]
channels_activity_map_pass[r,c]<-channels_activity_pass[m]
channels_activity_map[r,c]<-channels_activity[label]
channels_activity_map_pass[r,c]<-channels_activity_pass[label]

}

Expand Down Expand Up @@ -183,7 +183,7 @@ heatmap<-function(summary,time=1,platform="minion",out) {
showlegend=TRUE,updatemenus = list(chart_type), title="#bp per channel (over time and space)")

fig<- subplot(p1,p2,nrows = 2,titleX=TRUE, titleY=TRUE,margin=.05)

message("[",Sys.time(),"]"," storing plot to file")

htmlwidgets::saveWidget(fig, out)
Expand Down

0 comments on commit 5615ab1

Please sign in to comment.