DB5 Wavelet Decomposition of Accelerometer Data
Randall Thompson
4/4/2021
Recreating “Bilateral step length estimation using a single inertial measurement unit attached to the pelvis”[1] using the “Human Activity Recognition with Smartphones”[2] data.
- https://jneuroengrehab.biomedcentral.com/articles/10.1186/1743-0003-9-9
- https://www.kaggle.com/uciml/human-activity-recognition-with-smartphones
Specifically this section from [1]:
Method
Wavelet Decomposition Instructions
The X and Y accelerometer signals were decomposed using a “Stationary wavelet decomposition”. A Daubechies level 5 (“db5”) mother wavelet was chosen given its similarity to the IMU signals in the proximity of HS. The original signals were then decomposed in an approximation curve plus ten levels of detail. Thresholds were applied to the first three detail levels and the other detail levels were discarded. Thresholds for these levels were 1/5, 1/4 and 1/3 of its magnitude for the first, second and third level, respectively. The signals were reconstructed using only the first three levels of detail after thresholds were applied. An interval of interest for the accelerometer signals was defined as the interval of time during which the reconstructed signals differed from zero.
Gait Cycle Feature Identification
Based on the preliminary visual investigation, the right HS (rHS) was detected as the instant of time in the middle between the maximum of the Y accelerometer signal and the first minimum of the accelerometer signal along the X accelerometer signal in the corresponding intervals of interest. The identification of the left HS (lHS) required the identification of both right and left toe off instances (rTO, lTO). The lTO was detected as the instant of time in the middle between the first maximum of the Y accelerometer signal after the rHS and the second minimum of the X accelerometer signal in the corresponding intervals of interest. The rTO was found as the time of the minimum negative peak value between two consecutive lTO and rHS. The lHS was found as the first local maximum of the Z accelerometer signal before the rTO.
Problem?
The study [1] uses a frequency of 100hz but the data [2] uses a frequency of 50/hz. The window size for the study is 256 so I’m assuming I would have to use a window size of 128 for the data.
Questions
Am I applying the methodology correctly? Is my assumption in how to correct for the different frequencies correct?
Data Load
Load data and filter out non-walking activities.
library(tidyverse)
raw <- read_csv("Cleaned_Raw")
acc <- raw %>%
dplyr::filter(sensor == "acc", exp.x == 1) %>%
dplyr::select(x, y, z, sensor, exp.x, Index) %>%
arrange(Index)
gyro <- raw %>%
dplyr::filter(sensor == "gyro", exp.x == 1) %>%
dplyr::select(x, y, z, sensor, exp.x, Index) %>%
arrange(Index)
names(gyro) <- c("gx", "gy", "gz", "sensor", "exp.x1", "Index")
signals <- cbind(acc[,1:3],gyro[,c(1:3, 6)])
head(signals)## x y z gx gy gz Index
## 1 1.4208334 -0.34027778 -0.1250000 -0.2758057 1.6426166 -0.08216137 7496
## 2 1.0027778 -0.20416667 -0.1083333 -0.6759224 0.6704246 -0.08338311 7497
## 3 0.6833333 -0.06111112 -0.1083333 -1.1334605 -0.3915646 0.11881329 7498
## 4 0.7333334 -0.08333334 -0.1208333 -1.2907583 -0.7635816 0.10567969 7499
## 5 0.9569445 -0.26388890 -0.1375000 -1.2049317 -0.7596110 0.03451389 7500
## 6 1.0500000 -0.40277780 -0.1444445 -0.8530733 -0.6325510 -0.08704830 7501Wavelet Decomposition
DB5 Sationary Wavelet Decomposition using wavethresh package. With a window size of 2^7, there are 7 levels of detail. The first level is the original signal so the first three levels of detail we take are 6, 5, and 4. This is where we apply the thresholds of 1/5, 1/4, and 1/3.
library(wavethresh)
ywd <- wd(signals$y[200:327], filter.number=5, family="DaubExPhase", type="station")
ywdT1 <- threshold(ywd, policy="manual", value=.2,
levels=6, #by.level = TRUE,
verbose=TRUE)
ywdT2 <- threshold(ywd, policy="manual", value=.25,
levels=5, #by.level = TRUE,
verbose=TRUE)
ywdT3 <- threshold(ywd, policy="manual", value=1/3,
levels=4, #by.level = TRUE,
verbose=TRUE)
spec1 <- accessD(ywdT1, level = 6)
spec2 <- accessD(ywdT2, level = 5)
spec3 <- accessD(ywdT3, level = 4)
test <- as.data.frame(cbind(spec1, spec2, spec3, spec1+spec2+spec3, signals$y[1200:1327], signals$Index[1200:1327]))
head(test)plot(ywd)
## [1] 1.088341 1.088341 1.088341 1.088341 1.088341 1.088341 1.088341plot(spec1+spec2+spec3, type="l")
ggplot(test, aes(V6)) +
geom_line(aes(y = spec1, color = "x")) +
geom_line(aes(y = spec2, color = "y")) +
geom_line(aes(y = spec3, color = "z")) +
geom_line(aes(y = V5, color = "a")) +
geom_line(aes(y = V4, color = "w")) +
labs(x = "Time", y = "Signal")
library(wavethresh)
xwd <- wd(signals$x[200:327], filter.number=5, family="DaubExPhase", type="station")
xwdT1 <- threshold(xwd, policy="manual", value=.2,
levels=6, #by.level = TRUE,
verbose=TRUE)
xwdT2 <- threshold(xwd, policy="manual", value=.25,
levels=5, #by.level = TRUE,
verbose=TRUE)
xwdT3 <- threshold(xwd, policy="manual", value=1/3,
levels=4, #by.level = TRUE,
verbose=TRUE)
spec1 <- accessD(xwdT1, level = 6)
spec2 <- accessD(xwdT2, level = 5)
spec3 <- accessD(xwdT3, level = 4)
test <- as.data.frame(cbind(spec1, spec2, spec3, spec1+spec2+spec3, signals$x[1200:1327], signals$Index[1200:1327]))plot(xwd)
## [1] 1.568444 1.568444 1.568444 1.568444 1.568444 1.568444 1.568444plot(spec1+spec2+spec3, type="l")
ggplot(test, aes(V6)) +
geom_line(aes(y = spec1, color = "x")) +
geom_line(aes(y = spec2, color = "y")) +
geom_line(aes(y = spec3, color = "z")) +
geom_line(aes(y = V5, color = "a")) +
#geom_line(aes(y = V4, color = "w")) +
labs(x = "Time", y = "Signal")
#plot(getpacket(ywd, level = 2, index = 1))Create Function
stepwaves <- function(chunk) {
xwd <- wd(chunk$x, filter.number=5, family="DaubExPhase", type="station")
xwdT1 <- threshold(xwd, policy="manual", value=.2,
levels=6, #by.level = TRUE,
verbose=TRUE)
xwdT2 <- threshold(xwd, policy="manual", value=.25,
levels=5, #by.level = TRUE,
verbose=TRUE)
xwdT3 <- threshold(xwd, policy="manual", value=1/3,
levels=4, #by.level = TRUE,
verbose=TRUE)
spec1x <- accessD(xwdT1, level = 6)
spec2x <- accessD(xwdT2, level = 5)
spec3x <- accessD(xwdT3, level = 4)
ywd <- wd(chunk$y, filter.number=5, family="DaubExPhase", type="station")
ywdT1 <- threshold(ywd, policy="manual", value=.2,
levels=6, #by.level = TRUE,
verbose=TRUE)
ywdT2 <- threshold(ywd, policy="manual", value=.25,
levels=5, #by.level = TRUE,
verbose=TRUE)
ywdT3 <- threshold(ywd, policy="manual", value=1/3,
levels=4, #by.level = TRUE,
verbose=TRUE)
spec1y <- accessD(ywdT1, level = 6)
spec2y <- accessD(ywdT2, level = 5)
spec3y <- accessD(ywdT3, level = 4)
xdec <- spec1x+spec2x+spec3x
ydec <- spec1y+spec2y+spec3y
x <- chunk$x
y <- chunk$y
z <- chunk$z
user <- chunk$user
exp <- chunk$exp
index <- chunk$Index
allwaves <- as.data.frame(cbind(spec1x, spec2x, spec3x, xdec, spec1y, spec2y, spec3y, ydec, x, y, z, user, exp, index))
return(allwaves)
}Add data for all walking experiments
acc <- raw %>%
dplyr::filter(sensor == "acc") %>%
dplyr::select(x, y, z, sensor, exp.x, user.x, Index) %>%
arrange(Index)
gyro <- raw %>%
dplyr::filter(sensor == "gyro") %>%
dplyr::select(x, y, z, sensor, exp.x, user.x, Index) %>%
arrange(Index)
names(gyro) <- c("gx", "gy", "gz", "sensor", "exp", "user", "Index")
signals <- cbind(acc[,1:3],gyro[,c(1:3, 5:7)])Window every 128
#test <- signals %>% dplyr::filter(exp == 1)
#tmp <- split(test,(seq(nrow(test))-1) %/% 128)
#big <- lapply(tmp[1:(length(tmp)-1)], stepwaves)
signals$exp1 <- signals$exp
test <- signals %>% group_by(exp1) %>% group_map(split)
bar <- list()
for (i in test){
foo = i[[1]]
big = split(foo, (seq(nrow(foo))-1) %/% 128)
bash = lapply(big[1:(length(big)-1)], stepwaves)
bar <- append(bar, bash)
}
df <- do.call(rbind.data.frame, bar)
head(df)Results for Wavelet Decomposition
Let’s put them together.
It looks nothing like the diagram in the original study but it looks close for the data here. https://jneuroengrehab.biomedcentral.com/articles/10.1186/1743-0003-9-9/figures/2
ggplot(df[200:327,], aes(index)) +
geom_line(aes(y = xdec, color = "xd")) +
geom_line(aes(y = ydec, color = "yd")) +
geom_line(aes(y = x, color = "x")) +
geom_line(aes(y = y, color = "y")) +
#geom_point(aes(y = rhs-1, color = "rsh")) +
#geom_line(aes(y = V4, color = "w")) +
labs(x = "Time", y = "Signal")
Gait Cycle Feature Creation
Tagging local minima and maxima within the windows of interest.
df <- df %>%
mutate(xwin = if_else(xdec != 0, 1, 0)) %>%
mutate(ywin = if_else(ydec != 0, 1, 0)) %>%
mutate(rownum = row_number())
library(data.table)
xwinlist <- list()
ywinlist <- list()
xwinlist <- split(seq_along(df$xwin[1:188784])[df$xwin != 0], rleid(df$xwin[1:188784])[df$xwin != 0])
ywinlist <- split(seq_along(df$ywin[1:188784])[df$ywin != 0], rleid(df$ywin[1:188784])[df$ywin != 0])
xlocalmax <- which(diff(sign(diff(df$x)))==-2)+1 #max
xlocalmax <- as.data.frame(xlocalmax) %>% mutate(xmax = 1)
names(xlocalmax) <- c("rownum", "xmax")
xlocalmin <- which(diff(sign(diff(df$x)))==+2)+1 #min
xlocalmin <- as.data.frame(xlocalmin) %>% mutate(xmin = 1)
names(xlocalmin) <- c("rownum", "xmin")
ylocalmax <- which(diff(sign(diff(df$y)))==-2)+1 #max
ylocalmax <- as.data.frame(ylocalmax) %>% mutate(ymax = 1)
names(ylocalmax) <- c("rownum", "ymax")
ylocalmin <- which(diff(sign(diff(df$y)))==+2)+1 #min
ylocalmin <- as.data.frame(ylocalmin) %>% mutate(ymin = 1)
names(ylocalmin) <- c("rownum", "ymin")
zlocalmax <- which(diff(sign(diff(df$z)))==-2)+1 #max
zlocalmax <- as.data.frame(zlocalmax) %>% mutate(zmax = 1)
names(zlocalmax) <- c("rownum", "zmax")
df <- df %>%
left_join(xlocalmax, by = "rownum") %>%
left_join(xlocalmin, by = "rownum") %>%
left_join(ylocalmax, by = "rownum") %>%
left_join(ylocalmin, by = "rownum") %>%
left_join(zlocalmax, by = "rownum")
df <- df %>%
mutate(rlidx = rleid(xwin==0)) %>%
mutate(rlidy = rleid(ywin==0))
head(df)## spec1x spec2x spec3x xdec spec1y spec2y spec3y
## 1 0.1353014 -0.30450842 0 -0.16920704 0 0.07651245 0.00000000
## 2 -0.0100473 -0.26462043 0 -0.27466773 0 0.01334185 -0.03472984
## 3 0.0000000 0.00000000 0 0.00000000 0 0.00000000 -0.11342998
## 4 0.0000000 0.14942648 0 0.14942648 0 -0.03043552 -0.03941623
## 5 0.0000000 0.07618343 0 0.07618343 0 0.00000000 0.00000000
## 6 0.0000000 0.00000000 0 0.00000000 0 0.00000000 0.00000000
## ydec x y z user exp index xwin ywin rownum
## 1 0.07651245 1.4208334 -0.34027778 -0.1250000 1 1 7496 1 1 1
## 2 -0.02138799 1.0027778 -0.20416667 -0.1083333 1 1 7497 1 1 2
## 3 -0.11342998 0.6833333 -0.06111112 -0.1083333 1 1 7498 0 1 3
## 4 -0.06985175 0.7333334 -0.08333334 -0.1208333 1 1 7499 1 1 4
## 5 0.00000000 0.9569445 -0.26388890 -0.1375000 1 1 7500 1 0 5
## 6 0.00000000 1.0500000 -0.40277780 -0.1444445 1 1 7501 0 0 6
## xmax xmin ymax ymin zmax rlidx rlidy
## 1 NA NA NA NA NA 1 1
## 2 NA NA NA NA NA 1 1
## 3 NA 1 1 NA NA 2 1
## 4 NA NA NA NA NA 3 1
## 5 NA NA NA NA NA 3 2
## 6 1 NA NA NA NA 4 2Right Heel Strike
RHS - halfway between max y and first x min
ymax_in_win <- df %>% dplyr::filter(ywin==1,ymax==1) %>%
#distinct(rlidy, .keep_all = TRUE) %>% #only keeps first ymax
dplyr::select(rownum) %>%
mutate(var = "y")
xmin_in_win <- df %>% dplyr::filter(xwin==1,xmin==1) %>%
distinct(rlidx, .keep_all = TRUE) %>% #only keeps first xmin
dplyr::select(rownum) %>%
mutate(var = "x")
rhs <- rbind(ymax_in_win, xmin_in_win) %>% arrange(rownum)
x <- data.frame()
#for(i in 1:nrow(rhs)){
# a <- if_else(rhs$var[i] == "y" & rhs$var[i+1] == "x",
# round((rhs$rownum[i] + rhs$rownum[i+1])/2), 0)
# x <- append(x,a)
#}
for(i in 1:nrow(rhs)){
a <- if_else(rhs$var[i] == "y" & rhs$var[i+1] == "x" | rhs$var[i-1] == "x",
round((rhs$rownum[i] +
if_else(abs(rhs$rownum[i] - rhs$rownum[i+1]) >
abs(rhs$rownum[i] - rhs$rownum[i-1]),
rhs$rownum[i-1],
rhs$rownum[i+1]
))/2), 0)
x <- append(x,a)
}
x <- x %>% unlist() %>% as.data.frame() %>% mutate(j = 1)
names(x) <- c("rownum", "rhs")
x <- x %>% dplyr::filter(rownum != 0) %>% distinct()
df <- df %>%
left_join(x, by = "rownum")
head(df)## spec1x spec2x spec3x xdec spec1y spec2y spec3y
## 1 0.1353014 -0.30450842 0 -0.16920704 0 0.07651245 0.00000000
## 2 -0.0100473 -0.26462043 0 -0.27466773 0 0.01334185 -0.03472984
## 3 0.0000000 0.00000000 0 0.00000000 0 0.00000000 -0.11342998
## 4 0.0000000 0.14942648 0 0.14942648 0 -0.03043552 -0.03941623
## 5 0.0000000 0.07618343 0 0.07618343 0 0.00000000 0.00000000
## 6 0.0000000 0.00000000 0 0.00000000 0 0.00000000 0.00000000
## ydec x y z user exp index xwin ywin rownum
## 1 0.07651245 1.4208334 -0.34027778 -0.1250000 1 1 7496 1 1 1
## 2 -0.02138799 1.0027778 -0.20416667 -0.1083333 1 1 7497 1 1 2
## 3 -0.11342998 0.6833333 -0.06111112 -0.1083333 1 1 7498 0 1 3
## 4 -0.06985175 0.7333334 -0.08333334 -0.1208333 1 1 7499 1 1 4
## 5 0.00000000 0.9569445 -0.26388890 -0.1375000 1 1 7500 1 0 5
## 6 0.00000000 1.0500000 -0.40277780 -0.1444445 1 1 7501 0 0 6
## xmax xmin ymax ymin zmax rlidx rlidy rhs
## 1 NA NA NA NA NA 1 1 NA
## 2 NA NA NA NA NA 1 1 NA
## 3 NA 1 1 NA NA 2 1 NA
## 4 NA NA NA NA NA 3 1 NA
## 5 NA NA NA NA NA 3 2 NA
## 6 1 NA NA NA NA 4 2 NAThere should only be 2 red dots in this graph, not 8, close to the moment of the large, steep decline in x.
ggplot(df[200:327,], aes(index)) +
#geom_line(aes(y = xdec, color = "xd")) +
#geom_line(aes(y = ydec, color = "yd")) +
geom_line(aes(y = x, color = "x")) +
geom_line(aes(y = y, color = "y")) +
geom_point(aes(y = rhs-1, color = "rhs")) +
#geom_line(aes(y = V4, color = "w")) +
labs(x = "Time", y = "Signal")
Left Toe Off
LTO - halfway between first max y after RHS and second x min
ymax <- df %>% dplyr::filter(ymax==1) %>%
dplyr::select(rownum) %>%
mutate(var = "y")
rhs <- df %>% dplyr::filter(rhs==1) %>%
dplyr::select(rownum) %>%
mutate(var = "rhs")
ymax_after_rhs <- rbind(ymax, rhs) %>% arrange(rownum)
x <- data.frame()
for(i in 1:nrow(ymax_after_rhs)){
a <- if_else(ymax_after_rhs$var[i] == "rhs" & ymax_after_rhs$var[i+1] == "y" ,
ymax_after_rhs$rownum[i+1], 0)
x <- append(x,a)
}
x <- x %>% unlist() %>% as.data.frame() %>% mutate(j = "ymax_after_rhs")
names(x) <- c("rownum", "var")
ymax_after_rhs <- x %>% dplyr::filter(rownum != 0) %>% distinct()
xmin2 <- df %>% dplyr::filter(xwin==1,xmin==1) %>%
arrange(desc(rownum)) %>%
distinct(rlidx, .keep_all = TRUE) %>% #only keeps first xmin
arrange(rownum) %>%
dplyr::select(rownum) %>%
mutate(var = "x2")
lto <- rbind(ymax_after_rhs, xmin2) %>% arrange(rownum)
x <- data.frame()
for(i in 1:nrow(lto)){
a <- if_else(lto$var[i] == "ymax_after_rhs" & lto$var[i+1] == "x2" | lto$var[i-1] == "x2",
round((lto$rownum[i] +
if_else(abs(lto$rownum[i] - lto$rownum[i+1]) >
abs(lto$rownum[i] - lto$rownum[i-1]),
lto$rownum[i-1],
lto$rownum[i+1]
))/2), 0)
x <- append(x,a)
}
x <- x %>% unlist() %>% as.data.frame() %>% mutate(j = 1)
names(x) <- c("rownum", "lto")
x <- x %>% dplyr::filter(rownum != 0) %>% distinct()
df <- df %>%
left_join(x, by = "rownum")Right Toe Off
RTO - y min between LTO to next RHS
lto <- df %>% dplyr::filter(lto==1) %>%
dplyr::select(rownum) %>%
mutate(var = "lto")
rhs <- df %>% dplyr::filter(rhs==1) %>%
dplyr::select(rownum) %>%
mutate(var = "rhs")
rto <- rbind(lto, rhs) %>%
arrange(var) %>%
distinct(rownum, .keep_all = TRUE) %>% #keep lto
arrange(rownum)
x <- data.frame()
y <- data.frame()
a <- data.frame()
b <- data.frame()for(i in 1:nrow(rto)){
if(rto$var[i] == "lto" & rto$var[i+1] == "rhs"){
a <- rto$rownum[i]
b <- rto$rownum[i+1]
}
x <- append(x,a)
y <- append(y,b)
}x <- data.frame()
y <- data.frame()
for(i in 1:nrow(rto)){
if(rto$var[i] == "lto" & rto$var[i+1] == "rhs"){
a <- rto$rownum[i]
b <- rto$rownum[i+1]
}
x <- append(x,a)
y <- append(y,b)
}
x <- x %>% unlist() %>% as.data.frame()
names(x) <- "seq1"
x <- x %>% distinct()
y <- y %>% unlist() %>% as.data.frame()
names(y) <- "seq2"
y <- y %>% distinct()
find_ymin <- cbind(x,y)
seqs <- mapply(FUN = function(a, b) {
seq(from = a, to = b, by = 1)
}, a = find_ymin$seq1, b = find_ymin$seq2)
find_ymin <- data.frame(lapply(seqs, "length<-", max(lengths(seqs))))
find_ymin <- t(find_ymin)
test <- c(find_ymin) %>% na.omit() %>% as.data.frame()
names(test) <- "x"
test <- test %>%
arrange(x)
x <- test$x
y <- sort(x)
g <- cumsum(c(1, abs(y[-length(y)] - y[-1]) > 1))
test <- cbind(g, y) %>% as.data.frame()
names(test) <- c("seqs", "rownum")
findy <- df %>%
dplyr::select(rownum, y) %>%
left_join(test, by = "rownum") %>%
na.omit()
rto <- data.frame()
rto <- findy %>%
group_by(seqs) %>%
slice(which.min(y)) %>%
ungroup() %>%
dplyr::select(rownum) %>%
mutate(rto = 1)
df <- df %>%
left_join(rto, by = "rownum")Left Heel Strike
LHS - first max z before RTO
zmax <- df %>% dplyr::filter(zmax==1) %>%
dplyr::select(rownum) %>%
mutate(var = "zmax")
rto <- df %>% dplyr::filter(rto==1) %>%
dplyr::select(rownum) %>%
mutate(var = "rto")
lhs <- rbind(zmax, rto) %>%
arrange(var) %>%
distinct(rownum, .keep_all = TRUE) %>%
arrange(rownum)
x <- data.frame()
for(i in 1:nrow(lhs)){
a <- if_else(lhs$var[i] == "rto" & lhs$var[i-1] == "zmax",
lhs$rownum[i-1],0)
#return(a)
x <- append(x,a)
}
x <- x %>% unlist() %>% as.data.frame() %>% mutate(j = 1)
names(x) <- c("rownum", "lhs")
x <- x %>% dplyr::filter(rownum != 0) %>% distinct(, .keep_all = TRUE)
df <- df %>%
left_join(x, by = "rownum")
head(df)## spec1x spec2x spec3x xdec spec1y spec2y spec3y
## 1 0.1353014 -0.30450842 0 -0.16920704 0 0.07651245 0.00000000
## 2 -0.0100473 -0.26462043 0 -0.27466773 0 0.01334185 -0.03472984
## 3 0.0000000 0.00000000 0 0.00000000 0 0.00000000 -0.11342998
## 4 0.0000000 0.14942648 0 0.14942648 0 -0.03043552 -0.03941623
## 5 0.0000000 0.07618343 0 0.07618343 0 0.00000000 0.00000000
## 6 0.0000000 0.00000000 0 0.00000000 0 0.00000000 0.00000000
## ydec x y z user exp index xwin ywin rownum
## 1 0.07651245 1.4208334 -0.34027778 -0.1250000 1 1 7496 1 1 1
## 2 -0.02138799 1.0027778 -0.20416667 -0.1083333 1 1 7497 1 1 2
## 3 -0.11342998 0.6833333 -0.06111112 -0.1083333 1 1 7498 0 1 3
## 4 -0.06985175 0.7333334 -0.08333334 -0.1208333 1 1 7499 1 1 4
## 5 0.00000000 0.9569445 -0.26388890 -0.1375000 1 1 7500 1 0 5
## 6 0.00000000 1.0500000 -0.40277780 -0.1444445 1 1 7501 0 0 6
## xmax xmin ymax ymin zmax rlidx rlidy rhs lto rto lhs
## 1 NA NA NA NA NA 1 1 NA NA NA NA
## 2 NA NA NA NA NA 1 1 NA NA NA NA
## 3 NA 1 1 NA NA 2 1 NA NA NA NA
## 4 NA NA NA NA NA 3 1 NA NA NA NA
## 5 NA NA NA NA NA 3 2 NA NA NA NA
## 6 1 NA NA NA NA 4 2 NA NA NA NA#write.csv(df, "step_output_v1")Gait Cycle Feature Results
This is 2 and a half gait cycles, there should be 10 dots.
ggplot(df[200:327,], aes(rownum)) +
#geom_line(aes(y = xdec, color = "xd")) +
#geom_line(aes(y = ydec, color = "yd")) +
geom_line(aes(y = x, color = "x")) +
geom_line(aes(y = y, color = "y")) +
geom_point(aes(y = rhs-1, color = "rsh")) +
geom_point(aes(y = lhs-1, color = "lsh")) +
geom_point(aes(y = rto-1, color = "rto")) +
geom_point(aes(y = lto-1, color = "lto")) +
#geom_line(aes(y = V4, color = "w")) +
labs(x = "Time", y = "Signal")## Warning: Removed 120 rows containing missing values (geom_point).## Warning: Removed 123 rows containing missing values (geom_point).
## Warning: Removed 123 rows containing missing values (geom_point).## Warning: Removed 122 rows containing missing values (geom_point).
New gait cycle rules
Preping data for picking gait cycle features in order.
Pros: maintaining gait cycle feature order will help filter extra features.
Con: missing features could result in a missed gait cycle.
gob <- df %>% dplyr::filter(rhs == 1 | lhs == 1 | rto == 1 | lto == 1) %>%
dplyr::select(rownum, rhs, lto, lhs, rto)
gob <- gob %>%
mutate(ID = seq(1,nrow(gob),1))
data1 <- gob %>% pivot_longer(2:5) %>% na.omit() %>% as.data.frame()
data1 <- data1 %>%
mutate(ID1 = seq(1,nrow(data1),1))
names(data1) <- c("rownum", "ID","x", "other", "ID1")
#data1 <- data1 %>% mutate(ID = seq(1,nrow(data1),1))
list1 <- c("rhs", "lto", "lhs", "rto")
bim <- 0
doe <- 0Match does not return list in order. Must break out match into each individual gait feature.
repeat{
j<-length(data1$x)
i <- tail(doe, n=1)
foo <- match("rhs", data1$x[i:j])
doe <- foo+i
cu <- data1$ID1[doe]
bim <- append(bim, cu)
i <- tail(doe, n=1)
foo <- match("lto", data1$x[i:j])
doe <- foo+i
cu <- data1$ID1[doe]
bim <- append(bim, cu)
i <- tail(doe, n=1)
foo <- match("lhs", data1$x[i:j])
doe <- foo+i
cu <- data1$ID1[doe]
bim <- append(bim, cu)
i <- tail(doe, n=1)
foo <- match("rto", data1$x[i:j])
doe <- foo+i
cu <- data1$ID1[doe]
bim <- append(bim, cu)
if(tail(bim, n=1) > 15924) {
break
}
}
trun <- c(1,2,4,5,6,7,9,10,11,12,16,17,21)
trun1 <- c(1,2,5,6,7,8,11,12,13,14,15,16,17,19,20,22,26,29,33 )
gait <- bim[2:11489]-1
gait[1] <- 1
rownum <- as.data.frame(gait)
names(rownum) <- "ID1"
gait <- rownum %>% mutate(gait1 = "gait") #%>% mutate(step = rep_len(c("rhs", "lto", "lhs", "rto"), length(rownum)))
test <- data1 %>% left_join(gait, by = "ID1") %>% filter(gait1 == "gait") %>% pivot_wider(names_from = x, values_from = other)
test <- test %>% pivot_longer(cols = c("rhs", "lto", "lhs", "rto")) %>% filter(value == 1)
test1 <- test %>% dplyr::select(rownum, gait1, name)
df <- df %>% left_join(test1, by = "rownum")
head(test1)## # A tibble: 6 x 3
## rownum gait1 name
## <dbl> <chr> <chr>
## 1 65 gait rhs
## 2 69 gait lto
## 3 83 gait lhs
## 4 88 gait rto
## 5 94 gait rhs
## 6 98 gait ltohead(df)## spec1x spec2x spec3x xdec spec1y spec2y spec3y
## 1 0.1353014 -0.30450842 0 -0.16920704 0 0.07651245 0.00000000
## 2 -0.0100473 -0.26462043 0 -0.27466773 0 0.01334185 -0.03472984
## 3 0.0000000 0.00000000 0 0.00000000 0 0.00000000 -0.11342998
## 4 0.0000000 0.14942648 0 0.14942648 0 -0.03043552 -0.03941623
## 5 0.0000000 0.07618343 0 0.07618343 0 0.00000000 0.00000000
## 6 0.0000000 0.00000000 0 0.00000000 0 0.00000000 0.00000000
## ydec x y z user exp index xwin ywin rownum
## 1 0.07651245 1.4208334 -0.34027778 -0.1250000 1 1 7496 1 1 1
## 2 -0.02138799 1.0027778 -0.20416667 -0.1083333 1 1 7497 1 1 2
## 3 -0.11342998 0.6833333 -0.06111112 -0.1083333 1 1 7498 0 1 3
## 4 -0.06985175 0.7333334 -0.08333334 -0.1208333 1 1 7499 1 1 4
## 5 0.00000000 0.9569445 -0.26388890 -0.1375000 1 1 7500 1 0 5
## 6 0.00000000 1.0500000 -0.40277780 -0.1444445 1 1 7501 0 0 6
## xmax xmin ymax ymin zmax rlidx rlidy rhs lto rto lhs gait1 name
## 1 NA NA NA NA NA 1 1 NA NA NA NA <NA> <NA>
## 2 NA NA NA NA NA 1 1 NA NA NA NA <NA> <NA>
## 3 NA 1 1 NA NA 2 1 NA NA NA NA <NA> <NA>
## 4 NA NA NA NA NA 3 1 NA NA NA NA <NA> <NA>
## 5 NA NA NA NA NA 3 2 NA NA NA NA <NA> <NA>
## 6 1 NA NA NA NA 4 2 NA NA NA NA <NA> <NA>Results after new gait cycle rules
After filtering for the proper order of the gait cycle, we still result in inaccurate gait cycle markers.
foo <- df %>% dplyr::filter(gait1 == "gait")
foo <- left_join(df, foo, by = "rownum")
head(foo)## spec1x.x spec2x.x spec3x.x xdec.x spec1y.x spec2y.x spec3y.x
## 1 0.1353014 -0.30450842 0 -0.16920704 0 0.07651245 0.00000000
## 2 -0.0100473 -0.26462043 0 -0.27466773 0 0.01334185 -0.03472984
## 3 0.0000000 0.00000000 0 0.00000000 0 0.00000000 -0.11342998
## 4 0.0000000 0.14942648 0 0.14942648 0 -0.03043552 -0.03941623
## 5 0.0000000 0.07618343 0 0.07618343 0 0.00000000 0.00000000
## 6 0.0000000 0.00000000 0 0.00000000 0 0.00000000 0.00000000
## ydec.x x.x y.x z.x user.x exp.x index.x xwin.x
## 1 0.07651245 1.4208334 -0.34027778 -0.1250000 1 1 7496 1
## 2 -0.02138799 1.0027778 -0.20416667 -0.1083333 1 1 7497 1
## 3 -0.11342998 0.6833333 -0.06111112 -0.1083333 1 1 7498 0
## 4 -0.06985175 0.7333334 -0.08333334 -0.1208333 1 1 7499 1
## 5 0.00000000 0.9569445 -0.26388890 -0.1375000 1 1 7500 1
## 6 0.00000000 1.0500000 -0.40277780 -0.1444445 1 1 7501 0
## ywin.x rownum xmax.x xmin.x ymax.x ymin.x zmax.x rlidx.x rlidy.x rhs.x lto.x
## 1 1 1 NA NA NA NA NA 1 1 NA NA
## 2 1 2 NA NA NA NA NA 1 1 NA NA
## 3 1 3 NA 1 1 NA NA 2 1 NA NA
## 4 1 4 NA NA NA NA NA 3 1 NA NA
## 5 0 5 NA NA NA NA NA 3 2 NA NA
## 6 0 6 1 NA NA NA NA 4 2 NA NA
## rto.x lhs.x gait1.x name.x spec1x.y spec2x.y spec3x.y xdec.y spec1y.y
## 1 NA NA <NA> <NA> NA NA NA NA NA
## 2 NA NA <NA> <NA> NA NA NA NA NA
## 3 NA NA <NA> <NA> NA NA NA NA NA
## 4 NA NA <NA> <NA> NA NA NA NA NA
## 5 NA NA <NA> <NA> NA NA NA NA NA
## 6 NA NA <NA> <NA> NA NA NA NA NA
## spec2y.y spec3y.y ydec.y x.y y.y z.y user.y exp.y index.y xwin.y ywin.y
## 1 NA NA NA NA NA NA NA NA NA NA NA
## 2 NA NA NA NA NA NA NA NA NA NA NA
## 3 NA NA NA NA NA NA NA NA NA NA NA
## 4 NA NA NA NA NA NA NA NA NA NA NA
## 5 NA NA NA NA NA NA NA NA NA NA NA
## 6 NA NA NA NA NA NA NA NA NA NA NA
## xmax.y xmin.y ymax.y ymin.y zmax.y rlidx.y rlidy.y rhs.y lto.y rto.y lhs.y
## 1 NA NA NA NA NA NA NA NA NA NA NA
## 2 NA NA NA NA NA NA NA NA NA NA NA
## 3 NA NA NA NA NA NA NA NA NA NA NA
## 4 NA NA NA NA NA NA NA NA NA NA NA
## 5 NA NA NA NA NA NA NA NA NA NA NA
## 6 NA NA NA NA NA NA NA NA NA NA NA
## gait1.y name.y
## 1 <NA> <NA>
## 2 <NA> <NA>
## 3 <NA> <NA>
## 4 <NA> <NA>
## 5 <NA> <NA>
## 6 <NA> <NA>foo[200:327,] %>%
ggplot(aes(rownum)) +
#geom_line(aes(y = xdec, color = "xd")) +
#geom_line(aes(y = ydec, color = "yd")) +
geom_line(aes(y = x.x, color = "x")) +
geom_line(aes(y = y.x, color = "y")) +
geom_point(aes(y = rhs.y-1, color = "rsh")) +
geom_point(aes(y = lhs.y-1, color = "lsh")) +
geom_point(aes(y = rto.y-1, color = "rto")) +
geom_point(aes(y = lto.y-1, color = "lto")) +
#geom_line(aes(y = V4, color = "w")) +
labs(x = "Time", y = "Signal")