# Segment sit to stand for a subject
find_sit_to_stand <- function(sub, t) {
ch_indx = 3 # az channel
ch_sub = sub[, ch_indx]
# apply trapezoidal integration
ch_sub_pos = as.vector(cumtrapz(t, ch_sub))
# find peaks
max_peaks = pracma::findpeaks(ch_sub_pos)
max_peak = t(max_peaks[2, ])
return(c(1, max_peak[1, 4]))
}
# Segment stand to sit for a subject
find_stand_to_sit <- function(sub, t) {
ch_indx = 3 # az channel
ch_sub = sub[, ch_indx]
# apply trapezoidal integration
ch_sub_pos = as.vector(cumtrapz(t, ch_sub))
# find valleys
min_peak = -pracma::findpeaks(-ch_sub_pos)
return(c(-min_peak[nrow(min_peak) - 1, 3], length(t)))
}
# Segment two turns for a subject
find_turns <- function(sub, t, smoothing_order) {
ch_indx = 4 # gx channels
ch_sub = sub[, ch_indx]
# apply trapezoidal integration
ch_sub_pos = as.vector(cumtrapz(t, ch_sub))
# smooth the integrated line to avoid unnecessary parts
# with confusing slopes
ch_sub_pos_filter = as.vector(ma(ch_sub_pos, order = smoothing_order))
ch_sub_pos_filter[is.na(ch_sub_pos_filter)] = 0
df_acc_pos_filter <- data.frame(t, ch_sub_pos_filter)
names(df_acc_pos_filter) <- c("t", titles[ch_indx])
# calculate slope between successive points
slope = c(0, diff(df_acc_pos_filter[, 2])/diff(df_acc_pos_filter[,
1]))
labels = rep(NA, length(t))
# find segments with slopes
labels[slope > 0.45] = TRUE
labels[slope < -0.45] = FALSE
constant <- data.frame(matrix(ncol = 2, nrow = length(t)))
colnames(constant) = c("slope", "label")
constant$slope = slope
constant$label = labels
lengths = rle(constant$label)
all_pos_slope_lengths = lengths$lengths * lengths$values
all_pos_slope_lengths = all_pos_slope_lengths[!is.na(all_pos_slope_lengths)]
all_neg_slope_lengths = lengths$lengths * !lengths$values
all_neg_slope_lengths = all_neg_slope_lengths[!is.na(all_neg_slope_lengths)]
min_turn_length = sampling_rate
two_pos_turns = NA
# check if two turns are in opposite directions
if ((length(all_pos_slope_lengths[all_pos_slope_lengths >
min_turn_length]) == 1) && (length(all_neg_slope_lengths[all_neg_slope_lengths >
min_turn_length]) == 1)) {
# turns are two largest segments with positive and
# negative slopes
turn1_slope_length = max(all_pos_slope_lengths)
turn2_slope_length = max(all_neg_slope_lengths)
max_pos_slope_length = turn1_slope_length
max_neg_slope_length = turn2_slope_length
} else {
# turns are in same directions
max_pos_slope_length = max(all_pos_slope_lengths)
second_max_pos_slope_length = max(all_pos_slope_lengths[all_pos_slope_lengths !=
max_pos_slope_length])
max_neg_slope_length = max(all_neg_slope_lengths)
second_max_neg_slope_length = max(all_neg_slope_lengths[all_neg_slope_lengths !=
max_neg_slope_length])
# check if two turns have negative slopes
if (max_neg_slope_length > min_turn_length && second_max_neg_slope_length >
min_turn_length) {
tried_pos <<- FALSE
two_pos_turns = FALSE
# turns are the largest two segments with
# negative slopes
turn1_slope_length = max_neg_slope_length
if (length(grep(turn1_slope_length, all_neg_slope_lengths)) ==
1) {
turn2_slope_length = second_max_neg_slope_length
} else {
turn2_slope_length = max_neg_slope_length
}
} else {
# two turns have positive slopes
tried_pos <<- TRUE
two_pos_turns = TRUE
# turns are the largest two segments with
# positive slopes
turn1_slope_length = max_pos_slope_length
if (length(grep(turn1_slope_length, all_pos_slope_lengths)) ==
1) {
turn2_slope_length = second_max_pos_slope_length
} else {
turn2_slope_length = max_pos_slope_length
}
}
}
# find the start and end of the two turns
if (is.na(two_pos_turns)) {
before_turn1_slope_lengths = sum(lengths$lengths[1:(grep(turn1_slope_length,
lengths$lengths)[1] - 1)])
} else if (two_pos_turns == TRUE) {
before_turn1_slope_lengths = sum(lengths$lengths[1:(grep(turn1_slope_length,
lengths$lengths * lengths$values)[1] - 1)])
} else {
before_turn1_slope_lengths = sum(lengths$lengths[1:(grep(turn1_slope_length,
lengths$lengths * !lengths$values)[1] - 1)])
}
if (turn2_slope_length != max_pos_slope_length) {
if (length(grep(turn2_slope_length, lengths$lengths)) ==
1) {
turn2_indx = grep(turn2_slope_length, lengths$lengths)[1]
} else {
if (is.na(two_pos_turns)) {
turn2_indx = grep(turn2_slope_length, lengths$lengths)[1]
before_turn2_slope_lengths = sum(lengths$lengths[1:(turn2_indx -
1)])
if (before_turn1_slope_lengths == before_turn2_slope_lengths) {
turn2_indx = grep(turn2_slope_length, lengths$lengths)[2]
}
} else if (two_pos_turns == TRUE) {
turn2_indx = grep(turn2_slope_length, lengths$lengths *
lengths$values)[1]
} else {
turn2_indx = grep(turn2_slope_length, lengths$lengths *
!lengths$values)[1]
}
}
before_turn2_slope_lengths = sum(lengths$lengths[1:(turn2_indx -
1)])
} else {
if (length(grep(turn2_slope_length, lengths$lengths)) ==
1)
turn2_indx = grep(turn2_slope_length, lengths$lengths)[1] else {
if (is.na(two_pos_turns)) {
turn2_indx = grep(turn2_slope_length, lengths$lengths)[1]
before_turn2_slope_lengths = sum(lengths$lengths[1:(turn2_indx -
1)])
if (before_turn1_slope_lengths == before_turn2_slope_lengths) {
turn2_indx = grep(turn2_slope_length, lengths$lengths)[2]
}
} else if (two_pos_turns == TRUE) {
turn2_indx = grep(turn2_slope_length, lengths$lengths *
lengths$values)[1]
} else {
turn2_indx = grep(turn2_slope_length, lengths$lengths *
!lengths$values)[1]
}
}
before_turn2_slope_lengths = sum(lengths$lengths[1:(turn2_indx -
1)])
}
return(c(before_turn1_slope_lengths + 1, before_turn1_slope_lengths +
turn1_slope_length, before_turn2_slope_lengths + 1, before_turn2_slope_lengths +
turn2_slope_length))
}
# Segment two turns for a subject (second try)
find_turns_swap <- function(sub, t, smoothing_order) {
ch_indx = 4 # gx channel
ch_sub = sub[, ch_indx]
# apply trapezoidal integration
ch_sub_pos = as.vector(cumtrapz(t, ch_sub))
# smooth the integrated line to avoid unnecessary parts
# with confusing slopes
ch_sub_pos_filter = as.vector(ma(ch_sub_pos, order = smoothing_order))
ch_sub_pos_filter[is.na(ch_sub_pos_filter)] = 0
df_acc_pos_filter <- data.frame(t, ch_sub_pos_filter)
names(df_acc_pos_filter) <- c("t", titles[ch_indx])
# calculate slope between successive points
slope = c(0, diff(df_acc_pos_filter[, 2])/diff(df_acc_pos_filter[,
1]))
labels = rep(NA, length(t))
# find segments with slopes
labels[slope > 0.45] = TRUE
labels[slope < -0.45] = FALSE
constant <- data.frame(matrix(ncol = 2, nrow = length(t)))
colnames(constant) = c("slope", "label")
constant$slope = slope
constant$label = labels
lengths = rle(constant$label)
all_pos_slope_lengths = lengths$lengths * lengths$values
all_pos_slope_lengths = all_pos_slope_lengths[!is.na(all_pos_slope_lengths)]
all_neg_slope_lengths = lengths$lengths * !lengths$values
all_neg_slope_lengths = all_neg_slope_lengths[!is.na(all_neg_slope_lengths)]
min_turn_length = sampling_rate
two_pos_turns = NA
max_pos_slope_length = max(all_pos_slope_lengths)
second_max_pos_slope_length = max(all_pos_slope_lengths[all_pos_slope_lengths !=
max_pos_slope_length])
max_neg_slope_length = max(all_neg_slope_lengths)
second_max_neg_slope_length = max(all_neg_slope_lengths[all_neg_slope_lengths !=
max_neg_slope_length])
# if finding two turns with positive slopes failed then
# find two turns with negative slopes
if (tried_pos == TRUE) {
two_pos_turns = FALSE
# turns are the largest two segments with negative
# slopes
turn1_slope_length = max_neg_slope_length
if (length(grep(turn1_slope_length, all_neg_slope_lengths)) ==
1) {
turn2_slope_length = second_max_neg_slope_length
} else {
turn2_slope_length = max_neg_slope_length
}
} else {
# finding two turns with negative slopes failed
# then find two turns with positive slopes
two_pos_turns = TRUE
# turns are the largest two segments with positive
# slopes
turn1_slope_length = max_pos_slope_length
if (length(grep(turn1_slope_length, all_pos_slope_lengths)) ==
1) {
turn2_slope_length = second_max_pos_slope_length
} else {
turn2_slope_length = max_pos_slope_length
}
}
# Find the start and end of the two turns
if (is.na(two_pos_turns)) {
before_turn1_slope_lengths = sum(lengths$lengths[1:(grep(turn1_slope_length,
lengths$lengths)[1] - 1)])
} else if (two_pos_turns == TRUE) {
before_turn1_slope_lengths = sum(lengths$lengths[1:(grep(turn1_slope_length,
lengths$lengths * lengths$values)[1] - 1)])
} else {
before_turn1_slope_lengths = sum(lengths$lengths[1:(grep(turn1_slope_length,
lengths$lengths * !lengths$values)[1] - 1)])
}
if (turn2_slope_length != max_pos_slope_length) {
if (length(grep(turn2_slope_length, lengths$lengths)) ==
1) {
turn2_indx = grep(turn2_slope_length, lengths$lengths)[1]
} else {
if (is.na(two_pos_turns)) {
turn2_indx = grep(turn2_slope_length, lengths$lengths)[1]
before_turn2_slope_lengths = sum(lengths$lengths[1:(turn2_indx -
1)])
if (before_turn1_slope_lengths == before_turn2_slope_lengths) {
turn2_indx = grep(turn2_slope_length, lengths$lengths)[2]
}
} else if (two_pos_turns == TRUE) {
turn2_indx = grep(turn2_slope_length, lengths$lengths *
lengths$values)[1]
} else {
turn2_indx = grep(turn2_slope_length, lengths$lengths *
!lengths$values)[1]
}
}
before_turn2_slope_lengths = sum(lengths$lengths[1:(turn2_indx -
1)])
} else {
if (length(grep(turn2_slope_length, lengths$lengths)) ==
1) {
turn2_indx = grep(turn2_slope_length, lengths$lengths)[1]
} else {
if (is.na(two_pos_turns)) {
turn2_indx = grep(turn2_slope_length, lengths$lengths)[1]
before_turn2_slope_lengths = sum(lengths$lengths[1:(turn2_indx -
1)])
if (before_turn1_slope_lengths == before_turn2_slope_lengths) {
turn2_indx = grep(turn2_slope_length, lengths$lengths)[2]
}
} else if (two_pos_turns == TRUE) {
turn2_indx = grep(turn2_slope_length, lengths$lengths *
lengths$values)[1]
} else {
turn2_indx = grep(turn2_slope_length, lengths$lengths *
!lengths$values)[1]
}
}
before_turn2_slope_lengths = sum(lengths$lengths[1:(turn2_indx -
1)])
}
return(c(before_turn1_slope_lengths + 1, before_turn1_slope_lengths +
turn1_slope_length, before_turn2_slope_lengths + 1, before_turn2_slope_lengths +
turn2_slope_length))
}
# Write segmented parts to files
write_segments_to_files <- function(TUG_file, smoothing_order) {
# read file with 6 channels of a subject
sub = read.table(TUG_file)
L = nrow(sub)
t = (0:(L - 1)) * T
# trim constant parts
trim_sub_lengths = trim(sub, t, a_const_thr = 5, g_const_thr = 450)
start_const_length = trim_sub_lengths[1]
end_const_length = trim_sub_lengths[2]
sub = sub[((start_const_length + 1):(length(t) - end_const_length)),
]
t = t[((start_const_length + 1):(length(t) - end_const_length))]
# filter channels
sub = filter(sub)
# start segmentation
is_walking = rep(TRUE, length(t))
# get sit to stand part
range_sit_to_stand = find_sit_to_stand(sub, t)
is_walking[range_sit_to_stand[1]:range_sit_to_stand[2]] = FALSE
# get stand to sit part
range_stand_to_sit = find_stand_to_sit(sub, t)
is_walking[range_stand_to_sit[1]:range_stand_to_sit[2]] = FALSE
# get turning part
range_turns = find_turns(sub, t, smoothing_order)
is_walking[range_turns[1]:range_turns[2]] = FALSE
is_walking[range_turns[3]:range_turns[4]] = FALSE
# get walking part (segments not labeled as
# sit-to-stand, stand-to-sit, and turns)
lengths = rle(is_walking)
walking_lengths = lengths$lengths * lengths$values
not_walking_lengths = lengths$lengths * !lengths$values
range_walks = c(not_walking_lengths[1] + 1, not_walking_lengths[1] +
walking_lengths[2] + 1, sum(lengths$lengths[1:3]) + 1,
sum(lengths$lengths[1:3]) + walking_lengths[4] + 1)
# if error with segmentation is found, try finding
# other turns
if ((is.na(range_walks[3]) || is.na(range_walks[4]))) {
is_walking = rep(TRUE, length(t))
is_walking[range_sit_to_stand[1]:range_sit_to_stand[2]] = FALSE
is_walking[range_stand_to_sit[1]:range_stand_to_sit[2]] = FALSE
# reextract turning part
range_turns = find_turns_swap(sub, t, smoothing_order)
is_walking[range_turns[1]:range_turns[2]] = FALSE
is_walking[range_turns[3]:range_turns[4]] = FALSE
# reextract walking part
lengths = rle(is_walking)
walking_lengths = lengths$lengths * lengths$values
not_walking_lengths = lengths$lengths * !lengths$values
range_walks = c(not_walking_lengths[1] + 1, not_walking_lengths[1] +
walking_lengths[2] + 1, sum(lengths$lengths[1:3]) +
1, sum(lengths$lengths[1:3]) + walking_lengths[4] +
1)
# if error with segmentation is still found, try
# finding turns in another direction
if ((is.na(range_walks[3]) || is.na(range_walks[4]))) {
is_walking = rep(TRUE, length(t))
is_walking[range_sit_to_stand[1]:range_sit_to_stand[2]] = FALSE
is_walking[range_stand_to_sit[1]:range_stand_to_sit[2]] = FALSE
# reextract turning parts
tried_pos <<- !tried_pos
range_turns = find_turns_swap(sub, t, smoothing_order)
t_turn1 = t[range_turns[1]:range_turns[2]]
t_turn2 = t[range_turns[3]:range_turns[4]]
is_walking[range_turns[1]:range_turns[2]] = FALSE
is_walking[range_turns[3]:range_turns[4]] = FALSE
# reextract walking parts
lengths = rle(is_walking)
walking_lengths = lengths$lengths * lengths$values
not_walking_lengths = lengths$lengths * !lengths$values
range_walks = c(not_walking_lengths[1] + 1, not_walking_lengths[1] +
walking_lengths[2] + 1, sum(lengths$lengths[1:3]) +
1, sum(lengths$lengths[1:3]) + walking_lengths[4] +
1)
}
}
min_turn_sit_length = sampling_rate + 400
turn2_end = max(range_turns[2], range_turns[4])
# check if 2nd turn is far from stand to sit, then
# search for other turns
if (((range_stand_to_sit[1] - turn2_end) > min_turn_sit_length) ||
((turn2_end - range_stand_to_sit[1]) > 650)) {
is_walking = rep(TRUE, length(t))
is_walking[range_sit_to_stand[1]:range_sit_to_stand[2]] = FALSE
is_walking[range_stand_to_sit[1]:range_stand_to_sit[2]] = FALSE
# reextract turning parts
range_turns = find_turns_swap(sub, t, smoothing_order)
t_turn1 = t[range_turns[1]:range_turns[2]]
t_turn2 = t[range_turns[3]:range_turns[4]]
is_walking[range_turns[1]:range_turns[2]] = FALSE
is_walking[range_turns[3]:range_turns[4]] = FALSE
# reextract walking parts
lengths = rle(is_walking)
walking_lengths = lengths$lengths * lengths$values
not_walking_lengths = lengths$lengths * !lengths$values
range_walks = c(not_walking_lengths[1] + 1, not_walking_lengths[1] +
walking_lengths[2] + 1, sum(lengths$lengths[1:3]) +
1, sum(lengths$lengths[1:3]) + walking_lengths[4] +
1)
turn2_end = max(range_turns[2], range_turns[4])
# if 2nd turn is still far from stand to sit,
# search for other turns
if (((range_stand_to_sit[1] - turn2_end) > min_turn_sit_length) ||
((turn2_end - range_stand_to_sit[1]) > 650)) {
is_walking = rep(TRUE, length(t))
is_walking[range_sit_to_stand[1]:range_sit_to_stand[2]] = FALSE
is_walking[range_stand_to_sit[1]:range_stand_to_sit[2]] = FALSE
# reextract turning parts
tried_pos <<- !tried_pos
range_turns = find_turns_swap(sub, t, smoothing_order)
t_turn1 = t[range_turns[1]:range_turns[2]]
t_turn2 = t[range_turns[3]:range_turns[4]]
is_walking[range_turns[1]:range_turns[2]] = FALSE
is_walking[range_turns[3]:range_turns[4]] = FALSE
# reextract walking parts
lengths = rle(is_walking)
walking_lengths = lengths$lengths * lengths$values
not_walking_lengths = lengths$lengths * !lengths$values
range_walks = c(not_walking_lengths[1] + 1, not_walking_lengths[1] +
walking_lengths[2] + 1, sum(lengths$lengths[1:3]) +
1, sum(lengths$lengths[1:3]) + walking_lengths[4] +
1)
}
}
# swap turns labeling if 1st turn starts after 2nd turn
if (range_turns[1] > range_turns[3]) {
holder = c(range_turns[1], range_turns[2])
range_turns[1] = range_turns[3]
range_turns[2] = range_turns[4]
range_turns[3] = holder[1]
range_turns[4] = holder[2]
t_turn1 = t[range_turns[1]:range_turns[2]]
t_turn2 = t[range_turns[3]:range_turns[4]]
}
# divide channels into corresponding segments
sub_sit_to_stand = sub[range_sit_to_stand[1]:range_sit_to_stand[2],
]
sub_stand_to_sit = sub[range_stand_to_sit[1]:range_stand_to_sit[2],
]
sub_turn1 = sub[range_turns[1]:range_turns[2], ]
sub_turn2 = sub[range_turns[3]:range_turns[4], ]
sub_walk1 = sub[range_walks[1]:range_walks[2], ]
sub_walk2 = sub[range_walks[3]:range_walks[4], ]
# write segmented components to files
name_ext = "sTs_1.txt"
write.table(sub_sit_to_stand, file = name_ext, sep = "\t",
col.names = FALSE, row.names = FALSE)
name_ext = "sTs_2.txt"
write.table(sub_stand_to_sit, file = name_ext, sep = "\t",
col.names = FALSE, row.names = FALSE)
name_ext = "turn_1.txt"
write.table(sub_turn1, file = name_ext, sep = "\t", col.names = FALSE,
row.names = FALSE)
name_ext = "turn_2.txt"
write.table(sub_turn2, file = name_ext, sep = "\t", col.names = FALSE,
row.names = FALSE)
name_ext = "walk_1.txt"
write.table(sub_walk1, file = name_ext, sep = "\t", col.names = FALSE,
row.names = FALSE)
name_ext = "walk_2.txt"
write.table(sub_walk2, file = name_ext, sep = "\t", col.names = FALSE,
row.names = FALSE)
}