Skip to content

Commit

Permalink
style: whitespace, use seq_len instead of 1:n syntax
Browse files Browse the repository at this point in the history
  • Loading branch information
@ethanbass
ethanbass committed Aug 18, 2024
1 parent f033502 commit dd63a63
Show file tree
Hide file tree
Showing 4 changed files with 72 additions and 58 deletions.
112 changes: 62 additions & 50 deletions R/VPdtw.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -140,8 +140,8 @@
#'
#' @export VPdtw

VPdtw <- function(reference, query, penalty=0, maxshift=50,
Reference.type=c("random", "median", "mean", "trimmed")) {
VPdtw <- function(reference, query, penalty = 0, maxshift = 50,
Reference.type = c("random", "median", "mean", "trimmed")) {

## We assume Sakoe Chiba DTW to allow for faster computation times
if(!is.numeric(maxshift))
Expand All @@ -163,7 +163,7 @@ VPdtw <- function(reference, query, penalty=0, maxshift=50,
## the value of type as specified by the user.

type <- match.arg(Reference.type, c("random", "median", "mean", "trimmed"))
ss <- sample(1:ncol(query), 1)
ss <- sample(seq_len(ncol(query)), 1)
reference <- switch(type,
random = query[,ss],
median = apply(query, 1, median, na.rm = TRUE),
Expand Down Expand Up @@ -221,12 +221,12 @@ VPdtw <- function(reference, query, penalty=0, maxshift=50,
if(is.vector(reference) & is.vector(query) & is.vector(penalty)) {
information <- "Reference is supplied by the user.\n"
information <- paste(information, "Query vector is of length ",
length(query), ".\n", sep="")
length(query), ".\n", sep = "")

information <- paste(information,
"Single Penalty vector supplied by user.\n", sep="")
"Single Penalty vector supplied by user.\n", sep = "")
information <- paste(information, "Max allowed shift is ",
maxshift, ".\n", sep="")
maxshift, ".\n", sep = "")
reference <- na.omit(reference)

if(length(penalty) == 1)
Expand Down Expand Up @@ -296,7 +296,8 @@ VPdtw <- function(reference, query, penalty=0, maxshift=50,
## result is now a list of length ncol(penalty) each part is a matrix

xlim <- NULL
for(ii in 1:length(result)) xlim <- c(xlim, range(result[[ii]][,1]))
for(ii in seq_len(length(result)))
xlim <- c(xlim, range(result[[ii]][,1]))
xlim <- range(xlim)

xVals <- seq(xlim[1], xlim[2], by = 1)
Expand All @@ -316,18 +317,18 @@ VPdtw <- function(reference, query, penalty=0, maxshift=50,
output$penalty <- penalty

output$warpedQuery <- matrix(NA, length(xVals), ncol(query))
colnames(output$warpedQuery) <- paste("warped query", 1:ncol(query))
colnames(output$warpedQuery) <- paste("warped query", seq_len(ncol(query)))

output$shift <- matrix(NA, length(xVals), ncol(query))
colnames(output$shift) <- paste("shift", 1:ncol(query))
colnames(output$shift) <- paste("shift", seq_len(ncol(query)))

for(ii in 1:ncol(query)) {
colName <- paste("warped query",ii)
str <- which(xVals == result[[ii]][1, 1])
for(ii in seq_len(ncol(query))) {
colName <- paste("warped query", ii)
str <- which(xVals == result[[ii]][1,1])
end <- which(xVals == result[[ii]][nrow(result[[ii]]), 1])
output$warpedQuery[seq(str, end, by = 1), colName] <- result[[ii]][, 3]
output$warpedQuery[seq(str, end, by = 1), colName] <- result[[ii]][,3]
colName <- paste("shift",ii)
output$shift[seq(str, end, by = 1), colName] <- result[[ii]][, 4]
output$shift[seq(str, end, by = 1), colName] <- result[[ii]][,4]
}

class(output) <- "VPdtw"
Expand All @@ -337,8 +338,8 @@ VPdtw <- function(reference, query, penalty=0, maxshift=50,
cost2 <- function(x,ii) {
ret <- c(sum(abs(x$warpedQuery[,ii] - x$reference),
na.rm = TRUE) +
sum(x$penalty[x$xVals[which(diff(x$shift[,ii])==1)+1]],
na.rm=TRUE) +
sum(x$penalty[x$xVals[which(diff(x$shift[,ii]) == 1) + 1]],
na.rm = TRUE) +
2*sum(x$penalty[x$xVals[which(diff(x$shift[,ii]) == -1) + 1]],
na.rm = TRUE),
sum(!is.na(x$warpedQuery[,ii] * x$reference), na.rm = TRUE),
Expand All @@ -347,20 +348,24 @@ VPdtw <- function(reference, query, penalty=0, maxshift=50,
sum(diff(x$shift[,ii]) == 1, na.rm = TRUE),
sum(diff(x$shift[,ii]) == -1, na.rm = TRUE))
names(ret) <- c("Cost", "Overlap", "Max Obs Shift", "# Diag Moves",
"# Expanded","# Dropped")
"# Expanded", "# Dropped")
ret
}

output$summary <- NULL
for(ii in 1:ncol(output$warpedQuery)) output$summary <- rbind(output$summary,cost2(output,ii))
rownames(output$summary) <- paste("Query #",1:ncol(output$warpedQuery),":",sep="")
for(ii in seq_len(ncol(output$warpedQuery))){
output$summary <- rbind(output$summary, cost2(output,ii))
}
rownames(output$summary) <- paste("Query #",
seq_len(ncol(output$warpedQuery)),
":", sep = "")
output$information <- information

return(invisible(output))
}

## For doing alignment for many different penalties
DoAlignmentP <- function(penalty,query,reference,maxshift) {
DoAlignmentP <- function(penalty, query, reference, maxshift) {
## Drop NAs
reference <- na.omit(reference)
query <- na.omit(query)
Expand All @@ -372,16 +377,17 @@ VPdtw <- function(reference, query, penalty=0, maxshift=50,
}

## Scenario 3: vector query and penalty matrix
if(is.vector(query) & is.matrix(penalty)) {
if(is.vector(query) & is.matrix(penalty)){

information <- paste(information, "Query vector of length ",
length(query), ".\n", sep="")
length(query), ".\n", sep = "")

information <- paste(information,"Penalty matrix made up of ",
ncol(penalty)," penalties supplied by user.\n",sep="")
information <- paste(information, "Penalty matrix made up of ",
ncol(penalty), " penalties supplied by user.\n",
sep = "")

information <- paste(information,"Max allowed shift is ", maxshift,
".\n", sep="")
information <- paste(information, "Max allowed shift is ", maxshift,
".\n", sep = "")
reference <- na.omit(reference)
## Align query to reference using each of the penalties separately
penaltyL <- as.list(as.data.frame(penalty)) ## to ensure I get a list in the next round, can't apply to matrix
Expand All @@ -390,61 +396,67 @@ VPdtw <- function(reference, query, penalty=0, maxshift=50,
## result is now a list of length ncol(penalty) each part is a matrix

xlim <- NULL
for(ii in 1:length(result)) xlim <- c(xlim,range(result[[ii]][,1]))
for(ii in seq_len(length(result)))
xlim <- c(xlim, range(result[[ii]][,1]))
xlim <- range(xlim)

xVals <- seq(xlim[1], xlim[2], by=1)

output <- vector("list", 6)
names(output) <- c("xVals","reference","query","penalty","warpedQuery","shift")
names(output) <- c("xVals", "reference", "query",
"penalty", "warpedQuery", "shift")

output$xVals <- xVals

str <- which(xVals==1)
end <- which(xVals==length(reference))
output$reference <- rep(NA,length(xVals))
output$reference[seq(str,end,by=1)] <- reference
str <- which(xVals == 1)
end <- which(xVals == length(reference))
output$reference <- rep(NA, length(xVals))
output$reference[seq(str, end, by = 1)] <- reference

output$query <- query
output$penalty <- penalty

output$warpedQuery <- matrix(NA,length(xVals),ncol(penalty))
colnames(output$warpedQuery) <- paste("warped query penalty",1:ncol(penalty))
output$warpedQuery <- matrix(NA, length(xVals), ncol(penalty))
colnames(output$warpedQuery) <- paste("warped query penalty", seq_len(ncol(penalty)))

output$shift <- matrix(NA,length(xVals),ncol(penalty))
colnames(output$shift) <- paste("shift penalty",1:ncol(penalty))
output$shift <- matrix(NA, length(xVals), ncol(penalty))
colnames(output$shift) <- paste("shift penalty", seq_len(ncol(penalty)))

for(ii in 1:ncol(penalty)) {
colName <- paste("warped query penalty",ii)
for(ii in seq_len(ncol(penalty))) {
colName <- paste("warped query penalty", ii)
str <- which(xVals == result[[ii]][1,1])
end <- which(xVals == result[[ii]][nrow(result[[ii]]),1])
end <- which(xVals == result[[ii]][nrow(result[[ii]]), 1])
output$warpedQuery[seq(str, end, by=1), colName] <- result[[ii]][,3]
colName <- paste("shift penalty", ii)
output$shift[seq(str, end, by=1), colName] <- result[[ii]][,4]
output$shift[seq(str, end, by = 1), colName] <- result[[ii]][,4]
}
class(output) <- "VPdtw"

## Summary Statistics for each query separately

cost3 <- function(x,ii) {
ret <- c(sum(abs(x$warpedQuery[,ii] - x$reference), na.rm=TRUE) +
ret <- c(sum(abs(x$warpedQuery[,ii] - x$reference), na.rm = TRUE) +
sum(x$penalty[,ii][x$xVals[which(diff(x$shift[,ii]) == 1) + 1]],
na.rm=TRUE) +
na.rm = TRUE) +
2*sum(x$penalty[,ii][x$xVals[which(diff(x$shift[,ii]) == -1) + 1]],
na.rm=TRUE),
sum(!is.na(x$warpedQuery[,ii] * x$reference), na.rm=TRUE),
max(abs(x$shift[,ii]), na.rm=TRUE),
sum(diff(x$shift[,ii]) == 0, na.rm=TRUE)+1,
sum(diff(x$shift[,ii]) == 1, na.rm=TRUE),
sum(diff(x$shift[,ii]) == -1, na.rm=TRUE))
na.rm = TRUE),
sum(!is.na(x$warpedQuery[,ii] * x$reference), na.rm = TRUE),
max(abs(x$shift[,ii]), na.rm = TRUE),
sum(diff(x$shift[,ii]) == 0, na.rm = TRUE) + 1,
sum(diff(x$shift[,ii]) == 1, na.rm = TRUE),
sum(diff(x$shift[,ii]) == -1, na.rm = TRUE))
names(ret) <- c("Cost", "Overlap", "Max Obs Shift",
"# Diag Moves", "# Expanded","# Dropped")
ret
}

output$summary <- NULL
for(ii in 1:ncol(output$warpedQuery)) output$summary <- rbind(output$summary,cost3(output,ii))
rownames(output$summary) <- paste("Penalty #", 1:ncol(output$warpedQuery), ":", sep="")
for(ii in seq_len(ncol(output$warpedQuery))){
output$summary <- rbind(output$summary, cost3(output, ii))
}
rownames(output$summary) <- paste("Penalty #",
seq_len(ncol(output$warpedQuery)), ":",
sep = "")
output$information <- information

return(invisible(output))
Expand Down
2 changes: 1 addition & 1 deletion R/dilation.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -43,7 +43,7 @@
#'
#' @export dilation

dilation <- function(y,span){
dilation <- function(y, span){
y <- na.omit(y)
nmes <- names(y)
res <- .C("dilation",
Expand Down
10 changes: 6 additions & 4 deletions R/plot.VPdtw.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -90,7 +90,8 @@ plot.VPdtw <- function(x, type = c("All", "Before", "After",
plot(xlim, ylim, type = "n", xlab = "Index", ylab = "Intensity",
main = "Query and Reference after Alignment")
lines(x$xVals, x$reference, lwd = 2, col = 1)
matplot(x$xVals, x$warpedQuery, type = "l", lty = 1, add = TRUE, col = 2:(ncols+1))
matplot(x$xVals, x$warpedQuery, type = "l", lty = 1, add = TRUE,
col = (seq_len(ncols)+1))
legend("topright", legend = c("Reference",
paste("penalty #", seq_len(ncols),
sep = "")),
Expand All @@ -104,13 +105,14 @@ plot.VPdtw <- function(x, type = c("All", "Before", "After",
ncols <- ncol(x$shift)

matplot(x$xVals, x$shift, type="l", lty=1, xlab = "Index", ylab = "Shift",
main = "Shifts required for Alignment", col = 2:(ncols+1), xlim = xlim)
main = "Shifts required for Alignment", col = seq_len(ncols)+1,
xlim = xlim)
if (is.matrix(x$penalty))
legend("topleft", legend = paste("penalty #", seq_len(ncols), sep = ""),
col=2:(ncols+1), lty = rep(1, ncols))
col = seq_len(ncols)+1, lty = rep(1, ncols))
if (is.matrix(x$query))
legend("topleft", legend = paste("query #", seq_len(ncols), sep = ""),
col=2:(ncols+1), lty = rep(1, ncols))
col = seq_len(ncols)+1, lty = rep(1, ncols))
abline(h = 0, lty = 2, col = grey(0.75))
}
if(is.vector(x$shift)) {
Expand Down
6 changes: 3 additions & 3 deletions R/signalMatchABand.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -42,9 +42,9 @@ signalMatchABand <- function(reference, query,
maxp <- max(path, na.rm = TRUE)

xIndices <- path
xVals <- 1:length(path)
xVals <- seq_len(length(path))
if (minp > 1) {
xIndices <- c(1:(minp - 1), xIndices)
xIndices <- c(seq_len(minp - 1), xIndices)
xVals <- c(seq(to = 0, len = minp - 1, by = 1), xVals)
}
if(maxp < length(query)) {
Expand All @@ -54,7 +54,7 @@ signalMatchABand <- function(reference, query,
}

if (FALSE) {
plot(reference, type="l", lwd=2, xlim = c(1-maxshift, nr + maxshift))
plot(reference, type = "l", lwd = 2, xlim = c(1 - maxshift, nr + maxshift))
lines(which(!is.na(path)), query[na.omit(path)], col = 2)
lines(xVals, query[xIndices], col = 3, lty = 2)
}
Expand Down

0 comments on commit dd63a63

Please sign in to comment.