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.
Clean Data
library(tidyverse)## -- Attaching packages --------------------------------------- tidyverse 1.3.0 --## v ggplot2 3.3.3 v purrr 0.3.4
## v tibble 3.1.1 v dplyr 1.0.5
## v tidyr 1.1.3 v stringr 1.4.0
## v readr 1.4.0 v forcats 0.5.1## Warning: package 'tibble' was built under R version 4.0.5## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()setwd("~/CUNY/HAPT Data Set")LOAD Prepped Data
#load features names to be used as column names and activity names for y file data
test_names <- read_lines("features.txt")
activity_name <- read_delim("activity_labels.txt", delim = " ", col_names = c("id", "activity"))##
## -- Column specification --------------------------------------------------------
## cols(
## id = col_double(),
## activity = col_character()
## )## Warning: 11 parsing failures.
## row col expected actual file
## 1 -- 2 columns 3 columns 'activity_labels.txt'
## 2 -- 2 columns 3 columns 'activity_labels.txt'
## 4 -- 2 columns 3 columns 'activity_labels.txt'
## 5 -- 2 columns 3 columns 'activity_labels.txt'
## 6 -- 2 columns 3 columns 'activity_labels.txt'
## ... ... ......... ......... .....................
## See problems(...) for more details.#load training data, activity id, and subject id
trainx<-read_delim("Train/X_train.txt", delim = " ", col_names = c(test_names))## Warning: Duplicated column names deduplicated: 'tBodyAcc-ropy-1 ' => 'tBodyAcc-
## ropy-1 _1' [24], 'tBodyAcc-ropy-1 ' => 'tBodyAcc-ropy-1 _2' [25], 'tGravityAcc-
## ropy-1 ' => 'tGravityAcc-ropy-1 _1' [64], 'tGravityAcc-ropy-1 ' => 'tGravityAcc-
## ropy-1 _2' [65], 'tBodyAccJerk-ropy-1 ' => 'tBodyAccJerk-ropy-1 _1' [104],
## 'tBodyAccJerk-ropy-1 ' => 'tBodyAccJerk-ropy-1 _2' [105], 'tBodyGyro-
## ropy-1 ' => 'tBodyGyro-ropy-1 _1' [144], 'tBodyGyro-ropy-1 ' => 'tBodyGyro-
## ropy-1 _2' [145], 'tBodyGyroJerk-ropy-1 ' => 'tBodyGyroJerk-ropy-1 _1' [184],
## 'tBodyGyroJerk-ropy-1 ' => 'tBodyGyroJerk-ropy-1 _2' [185], 'fBodyAcc-ropy-1 '
## => 'fBodyAcc-ropy-1 _1' [289], 'fBodyAcc-ropy-1 ' => 'fBodyAcc-ropy-1 _2' [290],
## 'fBodyAcc-Skewness-1 ' => 'fBodyAcc-Skewness-1 _1' [299], 'fBodyAcc-Kurtosis-1
## ' => 'fBodyAcc-Kurtosis-1 _1' [300], 'fBodyAcc-Skewness-1 ' => 'fBodyAcc-
## Skewness-1 _2' [301], 'fBodyAcc-Kurtosis-1 ' => 'fBodyAcc-Kurtosis-1 _2' [302],
## 'fBodyAccJerk-ropy-1 ' => 'fBodyAccJerk-ropy-1 _1' [368], 'fBodyAccJerk-ropy-1 '
## => 'fBodyAccJerk-ropy-1 _2' [369], 'fBodyAccJerk-Skewness-1 ' => 'fBodyAccJerk-
## Skewness-1 _1' [378], 'fBodyAccJerk-Kurtosis-1 ' => 'fBodyAccJerk-Kurtosis-1
## _1' [379], 'fBodyAccJerk-Skewness-1 ' => 'fBodyAccJerk-Skewness-1 _2' [380],
## 'fBodyAccJerk-Kurtosis-1 ' => 'fBodyAccJerk-Kurtosis-1 _2' [381], 'fBodyGyro-
## ropy-1 ' => 'fBodyGyro-ropy-1 _1' [447], 'fBodyGyro-ropy-1 ' => 'fBodyGyro-
## ropy-1 _2' [448], 'fBodyGyro-Skewness-1 ' => 'fBodyGyro-Skewness-1 _1' [457],
## 'fBodyGyro-Kurtosis-1 ' => 'fBodyGyro-Kurtosis-1 _1' [458], 'fBodyGyro-
## Skewness-1 ' => 'fBodyGyro-Skewness-1 _2' [459], 'fBodyGyro-Kurtosis-1 ' =>
## 'fBodyGyro-Kurtosis-1 _2' [460]##
## -- Column specification --------------------------------------------------------
## cols(
## .default = col_double()
## )
## i Use `spec()` for the full column specifications.trainy <- read_delim("Train/y_train.txt", delim = " ", col_names = c("id"))##
## -- Column specification --------------------------------------------------------
## cols(
## id = col_double()
## )trainid <- read_lines("Train/subject_id_train.txt")
testx<-read_delim("Test/X_test.txt", delim = " ", col_names = c(test_names))## Warning: Duplicated column names deduplicated: 'tBodyAcc-ropy-1 ' => 'tBodyAcc-
## ropy-1 _1' [24], 'tBodyAcc-ropy-1 ' => 'tBodyAcc-ropy-1 _2' [25], 'tGravityAcc-
## ropy-1 ' => 'tGravityAcc-ropy-1 _1' [64], 'tGravityAcc-ropy-1 ' => 'tGravityAcc-
## ropy-1 _2' [65], 'tBodyAccJerk-ropy-1 ' => 'tBodyAccJerk-ropy-1 _1' [104],
## 'tBodyAccJerk-ropy-1 ' => 'tBodyAccJerk-ropy-1 _2' [105], 'tBodyGyro-
## ropy-1 ' => 'tBodyGyro-ropy-1 _1' [144], 'tBodyGyro-ropy-1 ' => 'tBodyGyro-
## ropy-1 _2' [145], 'tBodyGyroJerk-ropy-1 ' => 'tBodyGyroJerk-ropy-1 _1' [184],
## 'tBodyGyroJerk-ropy-1 ' => 'tBodyGyroJerk-ropy-1 _2' [185], 'fBodyAcc-ropy-1 '
## => 'fBodyAcc-ropy-1 _1' [289], 'fBodyAcc-ropy-1 ' => 'fBodyAcc-ropy-1 _2' [290],
## 'fBodyAcc-Skewness-1 ' => 'fBodyAcc-Skewness-1 _1' [299], 'fBodyAcc-Kurtosis-1
## ' => 'fBodyAcc-Kurtosis-1 _1' [300], 'fBodyAcc-Skewness-1 ' => 'fBodyAcc-
## Skewness-1 _2' [301], 'fBodyAcc-Kurtosis-1 ' => 'fBodyAcc-Kurtosis-1 _2' [302],
## 'fBodyAccJerk-ropy-1 ' => 'fBodyAccJerk-ropy-1 _1' [368], 'fBodyAccJerk-ropy-1 '
## => 'fBodyAccJerk-ropy-1 _2' [369], 'fBodyAccJerk-Skewness-1 ' => 'fBodyAccJerk-
## Skewness-1 _1' [378], 'fBodyAccJerk-Kurtosis-1 ' => 'fBodyAccJerk-Kurtosis-1
## _1' [379], 'fBodyAccJerk-Skewness-1 ' => 'fBodyAccJerk-Skewness-1 _2' [380],
## 'fBodyAccJerk-Kurtosis-1 ' => 'fBodyAccJerk-Kurtosis-1 _2' [381], 'fBodyGyro-
## ropy-1 ' => 'fBodyGyro-ropy-1 _1' [447], 'fBodyGyro-ropy-1 ' => 'fBodyGyro-
## ropy-1 _2' [448], 'fBodyGyro-Skewness-1 ' => 'fBodyGyro-Skewness-1 _1' [457],
## 'fBodyGyro-Kurtosis-1 ' => 'fBodyGyro-Kurtosis-1 _1' [458], 'fBodyGyro-
## Skewness-1 ' => 'fBodyGyro-Skewness-1 _2' [459], 'fBodyGyro-Kurtosis-1 ' =>
## 'fBodyGyro-Kurtosis-1 _2' [460]##
## -- Column specification --------------------------------------------------------
## cols(
## .default = col_double()
## )
## i Use `spec()` for the full column specifications.testy <- read_delim("Test/y_test.txt", delim = " ", col_names = c("id"))##
## -- Column specification --------------------------------------------------------
## cols(
## id = col_double()
## )testid <- read_lines("Test/subject_id_test.txt")
#join activity name to id
trainy <- left_join(trainy, activity_name, by = "id")
testy <- left_join(testy, activity_name, by = "id")
#add columns
trainx$activity <- trainy$activity
trainx$id <- trainid
trainx$data <- "train"
testx$activity <- testy$activity
testx$id <- testid
testx$data <- "test"
full <- rbind(trainx, testx)filenames <- list.files("~/CUNY/HAPT Data Set/RawData", full.names=TRUE)
ldf <- lapply(filenames[1:122], read_file)
foo <- str_split(ldf, "\n", )
test <- data.frame(do.call(rbind, foo))## Warning in (function (..., deparse.level = 1) : number of columns of result is
## not a multiple of vector length (arg 1)testt <- as.data.frame(t(test))
names(testt) <- filenames[1:122]
testp <- pivot_longer(testt, cols = 1:122)
testp$name <- str_replace(testp$name, "C:/Users/Randy/Documents/CUNY/HAPT Data Set/RawData/", "")
testp$name <- str_replace(testp$name, ".txt", "")
testw <- cbind(str_split(testp$name, "_", simplify = TRUE), testp)
testww <- cbind(str_split(testp$value, " ", simplify = TRUE), testw)
names(testww) <- c("x", "y", "z", "sensor", "exp", "user", "name", "value")
#testww <- pivot_wider(testww, sensor)
testww$Index <- ave( 1:nrow(testww), factor(testww$exp), factor(testww$user), factor(testww$sensor), FUN=seq_along )
testww$exp <- str_replace(testww$exp, "exp0", "")
testww$exp <- str_replace(testww$exp, "exp", "")
testww$user <- str_replace(testww$user, "user0", "")
testww$user <- str_replace(testww$user, "user", "")
testww$con <- paste(testww$exp, testww$user, testww$Index, sep = "_")labels <- read_delim("C:/Users/Randy/Documents/CUNY/HAPT Data Set/RawData/labels.txt", " ", col_names = c("exp", "user", "activity", "a", "b"))##
## -- Column specification --------------------------------------------------------
## cols(
## exp = col_double(),
## user = col_double(),
## activity = col_double(),
## a = col_double(),
## b = col_double()
## )seqs <- mapply(FUN = function(a, b) {
seq(from = a, to = b, by = 1)
}, a = labels$a, b = labels$b)
df<-data.frame(lapply(seqs, "length<-", max(lengths(seqs))))
df <-t(df)
df <- cbind(labels, df)
df <- pivot_longer(df, 6:2037)
df$con <- paste(df$exp, df$user, df$value, sep = "_")something <- left_join(testww, df, by = "con")
label_names <- read_delim("C:/Users/Randy/Documents/CUNY/HAPT Data Set/activity_labels.txt", " ", col_names = c("activity", "label"))##
## -- Column specification --------------------------------------------------------
## cols(
## activity = col_double(),
## label = col_character()
## )## Warning: 11 parsing failures.
## row col expected actual file
## 1 -- 2 columns 3 columns 'C:/Users/Randy/Documents/CUNY/HAPT Data Set/activity_labels.txt'
## 2 -- 2 columns 3 columns 'C:/Users/Randy/Documents/CUNY/HAPT Data Set/activity_labels.txt'
## 4 -- 2 columns 3 columns 'C:/Users/Randy/Documents/CUNY/HAPT Data Set/activity_labels.txt'
## 5 -- 2 columns 3 columns 'C:/Users/Randy/Documents/CUNY/HAPT Data Set/activity_labels.txt'
## 6 -- 2 columns 3 columns 'C:/Users/Randy/Documents/CUNY/HAPT Data Set/activity_labels.txt'
## ... ... ......... ......... .................................................................
## See problems(...) for more details.something <- left_join(something, label_names, by = "activity")
something$exp.x <- as.numeric(something$exp.x)
rawAF <- something %>%
filter(label == "WALKING") %>%
arrange(exp.x)
rawAF %>%
count(exp.x)## exp.x n
## 1 1 6708
## 2 2 6994
## 3 3 4282
## 4 4 4010
## 5 5 4434
## 6 6 3806
## 7 7 4372
## 8 8 4014
## 9 9 4310
## 10 10 3642
## 11 11 4160
## 12 12 3872
## 13 13 4144
## 14 14 3888
## 15 15 3628
## 16 16 3376
## 17 17 3684
## 18 18 3636
## 19 19 3774
## 20 21 3646
## 21 22 4244
## 22 23 4202
## 23 24 3886
## 24 25 3384
## 25 26 4130
## 26 27 3874
## 27 28 4306
## 28 29 4072
## 29 30 3906
## 30 31 3782
## 31 32 3704
## 32 33 3592
## 33 34 4504
## 34 35 4134
## 35 36 4034
## 36 37 3920
## 37 38 3870
## 38 39 3566
## 39 40 3790
## 40 41 3416
## 41 42 3868
## 42 43 3636
## 43 44 3264
## 44 45 3310
## 45 46 4184
## 46 47 4148
## 47 48 3956
## 48 49 4230
## 49 50 4982
## 50 51 5218
## 51 52 3928
## 52 53 4346
## 53 54 3972
## 54 55 4072
## 55 56 4130
## 56 57 3688
## 57 58 3710
## 58 59 3808
## 59 60 4644
## 60 61 4392#now known as cleaned_rawData Load
Load data and create table to work with.
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
explist <- c(1,3,5,7,9,11,13,15,17,19,22,24,26,28,30,32,34,36,38,40,42,44,46,48,50,52,54,56,58,60)
acc <- raw %>%
dplyr::filter(sensor == "acc") %>% #, exp.x %in% explist) %>%
dplyr::select(x, y, z, sensor, exp.x, user.x, Index) %>%
arrange(Index)
gyro <- raw %>%
dplyr::filter(sensor == "gyro") %>% #, exp.x %in% explist ) %>%
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[10000:10207,], 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")
Finding gait cycle range with Autocorrelation
detach("package:wavethresh")
library(tidyverse)
#gait <- read_csv("step_output_v1")slim <- df %>% dplyr::select(x,y,z,exp)
slim <- slim %>%
mutate(mag = sqrt(((x-1)^2)+(y^2)+(z^2)))library(fpp2)## Warning: package 'fpp2' was built under R version 4.0.5## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo## -- Attaching packages ---------------------------------------------- fpp2 2.4 --## v forecast 8.14 v expsmooth 2.3
## v fma 2.4## Warning: package 'forecast' was built under R version 4.0.5## Warning: package 'fma' was built under R version 4.0.5## Warning: package 'expsmooth' was built under R version 4.0.5## #turns out only 1 experiment per subject was using lateral pelvic sensor location.
explist <- c(1,3,5,7,9,11,13,15,17,19,22,24,26,28,30,32,34,36,38,40,42,44,46,48,50,52,54,56,58,60)
y <- data.frame()
for(i in explist){
mag1 <- slim %>%
filter(exp == i) %>% #group_by(exp) %>%
dplyr::select(mag)
acftest <- forecast::ggAcf(mag1, lag=100)
x <- acftest$data[40:70,] %>% filter(Freq == max(Freq))
x <- as.data.frame(x)
x$exp <- i
y <- rbind(y, x)
#print(ggAcf(mag1, lag=100))
#print(autoplot(ts(mag1[200:400,])))
}
acflist <- y
detach("package:fpp2")acftest <- forecast::ggAcf(mag1, lag=100)
max(acftest$data$Freq[40:70])## [1] 0.7901076acftest$data[40:70,] %>% filter(Freq == max(Freq))## Var2 Var3 Freq lag
## 1 mag mag 0.7901076 62Gait 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 2ggplot(df[10000:10207,], 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")
Right Heel Strike
RHS - halfway between max y and first x min
acflist## Var2 Var3 Freq lag exp
## 1 mag mag 0.6231667 55 1
## 2 mag mag 0.6157629 57 3
## 3 mag mag 0.5402958 61 5
## 4 mag mag 0.6139289 52 7
## 5 mag mag 0.4920101 59 9
## 6 mag mag 0.6114783 57 11
## 7 mag mag 0.5820849 56 13
## 8 mag mag 0.7126567 55 15
## 9 mag mag 0.4714725 52 17
## 10 mag mag 0.7301755 56 19
## 11 mag mag 0.6759565 60 22
## 12 mag mag 0.6936834 58 24
## 13 mag mag 0.5939962 54 26
## 14 mag mag 0.6238475 62 28
## 15 mag mag 0.7215232 58 30
## 16 mag mag 0.6875469 56 32
## 17 mag mag 0.6826632 62 34
## 18 mag mag 0.7369380 55 36
## 19 mag mag 0.6467269 52 38
## 20 mag mag 0.5916666 56 40
## 21 mag mag 0.7443458 53 42
## 22 mag mag 0.6973920 51 44
## 23 mag mag 0.4902211 59 46
## 24 mag mag 0.5958135 61 48
## 25 mag mag 0.5276549 63 50
## 26 mag mag 0.5361400 57 52
## 27 mag mag 0.7500505 55 54
## 28 mag mag 0.6392366 58 56
## 29 mag mag 0.7777401 57 58
## 30 mag mag 0.7901076 62 60c <- data.frame()
a <- data.frame()
for(i in 1:30){
t1 <- df %>% dplyr::filter(exp == acflist$exp[i]) %>% dplyr::select(y, index, rownum, ydec, spec2y)
t2 <- t1 %>% filter(rownum %in% rownum[1:200]) %>% dplyr::filter(spec2y != 0) %>% filter(y == min(y))
a <- t2$rownum
b <- max(t1$rownum)
t3 <- df %>% dplyr::filter(exp == acflist$exp[i]) %>%
dplyr::filter(ydec != 0) %>%
dplyr::select(y, index, rownum)
repeat{
if(
count(t3 %>%
dplyr::filter(rownum %in%
(tail(a, 1)+acflist$lag[i]-10):(tail(a,1)+acflist$lag[i]+10)
)
) == 0
){
t4 <- t1 %>% dplyr::filter(rownum %in% (tail(a, 1)+acflist$lag[i]-10):(tail(a,1)+acflist$lag[i]+10)) %>% filter(y == max(y)) %>% tail(1)
} else {
t4 <- t3 %>% dplyr::filter(rownum %in% (tail(a, 1)+acflist$lag[i]-10):(tail(a,1)+acflist$lag[i]+10)) %>% filter(y == max(y)) %>% tail(1)
}
a <- append(a, t4$rownum)
if (tail(a, 1) > (b-acflist$lag[i])) {
break
}
}
c <- append(c, a)
}Don’t use
c <- c %>% unlist() %>% as.data.frame() %>% mutate(j = 1)
names(c) <- c("rownum", "rhs")
c <- c %>% dplyr::filter(rownum != 0) %>% distinct()
df <- df %>%
left_join(c, by = "rownum")Old RHS
The two red dots on this graph correctly identify right foot heel strike.
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)-1)){
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)-1)){
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 = "rhs")) +
geom_point(aes(y = lhs-1, color = "lhs")) +
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 126 rows containing missing values (geom_point).## Warning: Removed 125 rows containing missing values (geom_point).
## Warning: Removed 125 rows containing missing values (geom_point).
## Warning: Removed 125 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) > 6470) { #7560) { #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 66 gait rhs
## 2 69 gait lto
## 3 110 gait lhs
## 4 114 gait rto
## 5 117 gait rhs
## 6 121 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.
expAll <- df %>% dplyr::filter(gait1 == "gait")
expAll <- left_join(df, expAll, by = "rownum")
head(expAll)## 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>expAll[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 = "rhs")) +
geom_point(aes(y = lhs.y-1, color = "lhs")) +
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")
Gait Cycle Analysis
#gait <- read_csv("step_output_v1")
gait <- expAllcycle <- gait %>% filter(name.x == "rhs") %>%
mutate(diff = rownum - lag(rownum, default = first(rownum))) %>%
dplyr::select(diff, exp.x)
step <- gait %>% filter(name.x == "rhs" | name.x == "lhs") %>%
mutate(diff = rownum - lag(rownum, default = first(rownum))) %>%
dplyr::select(diff, exp.x)
lstep <- gait %>% filter(name.x == "lto" | name.x == "lhs") %>%
mutate(diff = rownum - lag(rownum, default = first(rownum))) %>%
dplyr::select(diff, exp.x, name.x) %>%
filter(row_number() %% 2 != 0)
lswing <- gait %>% filter(name.x == "lto" | name.x == "lhs") %>%
mutate(diff = rownum - lag(rownum, default = first(rownum))) %>%
dplyr::select(diff, exp.x, name.x, rownum) %>%
filter(row_number() %% 2 != 1)
rstep <- gait %>% filter(name.x == "rto" | name.x == "rhs") %>%
mutate(diff = rownum - lag(rownum, default = first(rownum))) %>%
dplyr::select(diff, exp.x, name.x) %>%
filter(row_number() %% 2 != 0)
rswing <- gait %>% filter(name.x == "rto" | name.x == "rhs") %>%
mutate(diff = rownum - lag(rownum, default = first(rownum))) %>%
dplyr::select(diff, exp.x, name.x, rownum) %>%
filter(row_number() %% 2 != 1)
gaitsetSkinny <- cbind(cycle[1:839,], lstep[1:839,1], lswing[1:839,1], rstep[1:839,1], rswing[1:839,1])
names(gaitsetSkinny) <- c("cycle", "exp", "lstep", "lswing", "rstep", "rswing")step %>%
ggplot(aes(group=exp.x, diff))+
geom_boxplot()
gaitsetSkinny %>% filter_all(all_vars(. > 10)) %>% filter_all(all_vars(. < 90)) %>%
count(exp) %>% filter(n < 10)## exp n
## 1 11 7
## 2 13 7
## 3 17 4
## 4 22 4
## 5 28 7
## 6 30 2
## 7 32 8
## 8 36 4
## 9 38 3
## 10 42 6
## 11 44 8
## 12 46 4
## 13 48 4
## 14 50 1
## 15 54 6
## 16 56 6
## 17 60 130, 48, 50, 60 are less than 10 obervations for > 90 17,30,38,46,60 are less than 10 obersations for < 10 11, 13, 17, 22, 28, 30, 32, 36, 38, 42, 44, 46, 48, 50, 54, 56, 60 are less than 10 where both
gaitfinal <- gaitsetSkinny %>%
filter(!exp %in% c(11, 13, 17, 22, 28, 30, 32, 36, 38, 42, 44, 46, 48, 50, 54, 56, 60)) %>%
filter_all(all_vars(. < 90)) %>%
filter(lswing < 50) %>%
filter(lstep < 50) %>%
filter(rswing < 50) %>%
filter(rstep < 50) %>%
filter_all(all_vars(. > 10)) %>%
mutate(stepdiff = rstep - lstep) %>%
mutate(swingdiff = rswing - lswing)
gaitfinal %>%
pivot_longer(c("cycle", "lstep", "lswing", "rstep", "rswing", "swingdiff", "stepdiff")) %>%
ggplot(aes(group=exp, value)) +
geom_boxplot() +
facet_wrap(vars(name))
the_summary <- gaitfinal %>% group_by(exp) %>% skimr::skim()summary2 <- the_summary %>% dplyr::select(skim_variable, exp, numeric.mean, numeric.sd) %>% pivot_wider(names_from = c(skim_variable), values_from = c(numeric.mean, numeric.sd))
summary2 %>%
dplyr::select(exp, numeric.mean_cycle, numeric.mean_swingdiff, numeric.mean_stepdiff) %>%
mutate(swingratio = numeric.mean_swingdiff/numeric.mean_cycle) %>%
mutate(stepratio = numeric.mean_stepdiff/numeric.mean_cycle)## # A tibble: 8 x 6
## exp numeric.mean_cyc~ numeric.mean_sw~ numeric.mean_st~ swingratio stepratio
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 15 55.4 15.5 -12.7 0.279 -0.230
## 2 19 56.4 12 -5.36 0.213 -0.0952
## 3 24 56.3 12.3 -6.33 0.219 -0.112
## 4 26 55.1 8.14 -3.71 0.148 -0.0674
## 5 34 65 13 -11.5 0.2 -0.177
## 6 40 57.3 -5.56 5 -0.0969 0.0872
## 7 52 58.8 -6.38 6 -0.109 0.102
## 8 58 57 -5.08 6.5 -0.0892 0.114