| Title: | Anomaly Detection and Correction for OpenPose Gait Analysis |
|---|---|
| Description: | Detects and corrects the anatomical, biomechanical, physical, and detection-confidence anomalies that arise in two-dimensional video-based gait analysis with OpenPose, then imputes and smooths the corrected keypoint trajectories. Implements the method of Sugiyama, Uno and Matsui (2023) <doi:10.1371/journal.pcbi.1009989>. |
| Authors: | Yusuke Matsui [aut, cre] (corresponding author and lead developer), Yuki Sugiyama [aut], Kohei Uno [aut] |
| Maintainer: | Yusuke Matsui <[email protected]> |
| License: | GPL-3 |
| Version: | 0.2.1 |
| Built: | 2026-10-03 13:42:34 UTC |
| Source: | https://github.com/x-biosignal/PoseFixeR |
Flags values lying more than k standard deviations from the mean.
anomaly(x, k = 2)anomaly(x, k = 2)
x |
A numeric vector. |
k |
Number of standard deviations for the threshold (default 2). |
A list with caselist (logical outlier flags) and abnormal.values
(the sorted flagged values).
set.seed(1) x <- c(rnorm(30), 8) # a series with one clear outlier flags <- anomaly(x, k = 2) which(flags$caselist) # position of the flagged value(s) flags$abnormal.values # the flagged value(s)set.seed(1) x <- c(rnorm(30), 8) # a series with one clear outlier flags <- anomaly(x, k = 2) which(flags$caselist) # position of the flagged value(s) flags$abnormal.values # the flagged value(s)
Lays out one scatter-plus-skeleton panel per frame (see plt.segment()).
diplay_frames(obj, layout = c(5, 5), xlim = c(450, 800), ylim = c(700, 200))diplay_frames(obj, layout = c(5, 5), xlim = c(450, 800), ylim = c(700, 200))
obj |
Reshaped keypoint data (see |
layout |
Length-2 vector |
xlim |
Length-2 vector for the x-axis range. |
ylim |
Length-2 vector for the y-axis range (top-down image coordinates). |
Called for its side effect of plotting; returns NULL.
parts <- c("nose","neck","Rshoulder","Relbow","Rwrist","Lshoulder","Lelbow", "Lwrist","Rhip","Rknee","Rankle","Lhip","Lknee","Lankle","Reye","Leye", "Rear","Lear") bx <- c(0,0,-.25,-.3,-.32,.25,.3,.32,-.18,-.2,-.22,.18,.2,.22,-.05,.05,-.1,.1) by <- c(-.3,0,.05,.5,.95,.05,.5,.95,1,1.65,2.28,1,1.65,2.28,-.35,-.35,-.3,-.3) obj <- list(x = matrix(bx, 2, 18, byrow = TRUE, dimnames = list(NULL, parts)), y = matrix(by, 2, 18, byrow = TRUE, dimnames = list(NULL, parts))) op <- graphics::par(no.readonly = TRUE) diplay_frames(obj, layout = c(1, 2), xlim = c(-1, 1), ylim = c(2.5, -0.5)) graphics::par(op)parts <- c("nose","neck","Rshoulder","Relbow","Rwrist","Lshoulder","Lelbow", "Lwrist","Rhip","Rknee","Rankle","Lhip","Lknee","Lankle","Reye","Leye", "Rear","Lear") bx <- c(0,0,-.25,-.3,-.32,.25,.3,.32,-.18,-.2,-.22,.18,.2,.22,-.05,.05,-.1,.1) by <- c(-.3,0,.05,.5,.95,.05,.5,.95,1,1.65,2.28,1,1.65,2.28,-.35,-.35,-.3,-.3) obj <- list(x = matrix(bx, 2, 18, byrow = TRUE, dimnames = list(NULL, parts)), y = matrix(by, 2, 18, byrow = TRUE, dimnames = list(NULL, parts))) op <- graphics::par(no.readonly = TRUE) diplay_frames(obj, layout = c(1, 2), xlim = c(-1, 1), ylim = c(2.5, -0.5)) graphics::par(op)
Euclidean distance between two keypoints
distance(dat, a, b, time)distance(dat, a, b, time)
dat |
Reshaped keypoint data (see |
a, b
|
Keypoint indices or names. |
time |
Frame index or vector of frames. |
The distance(s) between keypoints a and b.
## a minimal reshaped pose: 18 keypoints over three frames parts <- c("nose","neck","Rshoulder","Relbow","Rwrist","Lshoulder","Lelbow", "Lwrist","Rhip","Rknee","Rankle","Lhip","Lknee","Lankle","Reye","Leye", "Rear","Lear") bx <- c(0,0,-.25,-.3,-.32,.25,.3,.32,-.18,-.2,-.22,.18,.2,.22,-.05,.05,-.1,.1) by <- c(-.3,0,.05,.5,.95,.05,.5,.95,1,1.65,2.28,1,1.65,2.28,-.35,-.35,-.3,-.3) dat <- list(x = matrix(bx, 3, 18, byrow = TRUE, dimnames = list(NULL, parts)), y = matrix(by, 3, 18, byrow = TRUE, dimnames = list(NULL, parts))) ## shoulder width over frames 1:3 (by name) and hip width (by index) distance(dat, "Rshoulder", "Lshoulder", 1:3) distance(dat, 9, 12, 1)## a minimal reshaped pose: 18 keypoints over three frames parts <- c("nose","neck","Rshoulder","Relbow","Rwrist","Lshoulder","Lelbow", "Lwrist","Rhip","Rknee","Rankle","Lhip","Lknee","Lankle","Reye","Leye", "Rear","Lear") bx <- c(0,0,-.25,-.3,-.32,.25,.3,.32,-.18,-.2,-.22,.18,.2,.22,-.05,.05,-.1,.1) by <- c(-.3,0,.05,.5,.95,.05,.5,.95,1,1.65,2.28,1,1.65,2.28,-.35,-.35,-.3,-.3) dat <- list(x = matrix(bx, 3, 18, byrow = TRUE, dimnames = list(NULL, parts)), y = matrix(by, 3, 18, byrow = TRUE, dimnames = list(NULL, parts))) ## shoulder width over frames 1:3 (by name) and hip width (by index) distance(dat, "Rshoulder", "Lshoulder", 1:3) distance(dat, 9, 12, 1)
Hip joint angle between three keypoints
hdegree(dat, a, b, c, time)hdegree(dat, a, b, c, time)
dat |
Reshaped keypoint data (see |
a, b, c
|
Keypoint indices or names (angle measured at |
time |
Frame index or vector of frames. |
The hip angle(s) in degrees.
## a minimal reshaped pose (one frame is enough for a single angle) parts <- c("nose","neck","Rshoulder","Relbow","Rwrist","Lshoulder","Lelbow", "Lwrist","Rhip","Rknee","Rankle","Lhip","Lknee","Lankle","Reye","Leye", "Rear","Lear") bx <- c(0,0,-.25,-.3,-.32,.25,.3,.32,-.18,-.2,-.22,.18,.2,.22,-.05,.05,-.1,.1) by <- c(-.3,0,.05,.5,.95,.05,.5,.95,1,1.65,2.28,1,1.65,2.28,-.35,-.35,-.3,-.3) dat <- list(x = matrix(bx, 2, 18, byrow = TRUE, dimnames = list(NULL, parts)), y = matrix(by, 2, 18, byrow = TRUE, dimnames = list(NULL, parts))) ## right hip flexion at the hip (neck - Rhip - Rknee) in frame 1 hdegree(dat, 2, 9, 10, 1)## a minimal reshaped pose (one frame is enough for a single angle) parts <- c("nose","neck","Rshoulder","Relbow","Rwrist","Lshoulder","Lelbow", "Lwrist","Rhip","Rknee","Rankle","Lhip","Lknee","Lankle","Reye","Leye", "Rear","Lear") bx <- c(0,0,-.25,-.3,-.32,.25,.3,.32,-.18,-.2,-.22,.18,.2,.22,-.05,.05,-.1,.1) by <- c(-.3,0,.05,.5,.95,.05,.5,.95,1,1.65,2.28,1,1.65,2.28,-.35,-.35,-.3,-.3) dat <- list(x = matrix(bx, 2, 18, byrow = TRUE, dimnames = list(NULL, parts)), y = matrix(by, 2, 18, byrow = TRUE, dimnames = list(NULL, parts))) ## right hip flexion at the hip (neck - Rhip - Rknee) in frame 1 hdegree(dat, 2, 9, 10, 1)
Import OpenPose JSON files in a batch
import_json( files, parts = c("nose", "neck", "Rshoulder", "Relbow", "Rwrist", "Lshoulder", "Lelbow", "Lwrist", "Rhip", "Rknee", "Rankle", "Lhip", "Lknee", "Lankle", "Reye", "Leye", "Rear", "Lear") )import_json( files, parts = c("nose", "neck", "Rshoulder", "Relbow", "Rwrist", "Lshoulder", "Lelbow", "Lwrist", "Rhip", "Rknee", "Rankle", "Lhip", "Lknee", "Lankle", "Reye", "Leye", "Rear", "Lear") )
files |
Character vector of OpenPose JSON file paths (one per frame). |
parts |
Keypoint names in row order (default: the 18-keypoint layout). |
A list of per-frame keypoint matrices (keypoint x c("X","Y","P")).
## Each file holds one frame as a flat vector of 54 values ## (18 keypoints x X, Y, confidence), written to a temporary directory here. bx <- c(0,0,-.25,-.3,-.32,.25,.3,.32,-.18,-.2,-.22,.18,.2,.22,-.05,.05,-.1,.1) by <- c(-.3,0,.05,.5,.95,.05,.5,.95,1,1.65,2.28,1,1.65,2.28,-.35,-.35,-.3,-.3) frame <- as.numeric(t(cbind(bx, by, 1))) # row-major X, Y, P per keypoint f <- tempfile(fileext = ".json") writeLines(rjson::toJSON(frame), f) keypoints <- import_json(f) dim(keypoints[[1]]) # 18 keypoints x 3 columns head(keypoints[[1]])## Each file holds one frame as a flat vector of 54 values ## (18 keypoints x X, Y, confidence), written to a temporary directory here. bx <- c(0,0,-.25,-.3,-.32,.25,.3,.32,-.18,-.2,-.22,.18,.2,.22,-.05,.05,-.1,.1) by <- c(-.3,0,.05,.5,.95,.05,.5,.95,1,1.65,2.28,1,1.65,2.28,-.35,-.35,-.3,-.3) frame <- as.numeric(t(cbind(bx, by, 1))) # row-major X, Y, P per keypoint f <- tempfile(fileext = ".json") writeLines(rjson::toJSON(frame), f) keypoints <- import_json(f) dim(keypoints[[1]]) # 18 keypoints x 3 columns head(keypoints[[1]])
Knee joint angle between three keypoints
kdegree(dat, a, b, c, time)kdegree(dat, a, b, c, time)
dat |
Reshaped keypoint data (see |
a, b, c
|
Keypoint indices or names (angle measured at |
time |
Frame index or vector of frames. |
The knee angle(s) in degrees.
## a minimal reshaped pose (one frame is enough for a single angle) parts <- c("nose","neck","Rshoulder","Relbow","Rwrist","Lshoulder","Lelbow", "Lwrist","Rhip","Rknee","Rankle","Lhip","Lknee","Lankle","Reye","Leye", "Rear","Lear") bx <- c(0,0,-.25,-.3,-.32,.25,.3,.32,-.18,-.2,-.22,.18,.2,.22,-.05,.05,-.1,.1) by <- c(-.3,0,.05,.5,.95,.05,.5,.95,1,1.65,2.28,1,1.65,2.28,-.35,-.35,-.3,-.3) dat <- list(x = matrix(bx, 2, 18, byrow = TRUE, dimnames = list(NULL, parts)), y = matrix(by, 2, 18, byrow = TRUE, dimnames = list(NULL, parts))) ## right knee angle (Rhip - Rknee - Rankle) in frame 1 kdegree(dat, 9, 10, 11, 1)## a minimal reshaped pose (one frame is enough for a single angle) parts <- c("nose","neck","Rshoulder","Relbow","Rwrist","Lshoulder","Lelbow", "Lwrist","Rhip","Rknee","Rankle","Lhip","Lknee","Lankle","Reye","Leye", "Rear","Lear") bx <- c(0,0,-.25,-.3,-.32,.25,.3,.32,-.18,-.2,-.22,.18,.2,.22,-.05,.05,-.1,.1) by <- c(-.3,0,.05,.5,.95,.05,.5,.95,1,1.65,2.28,1,1.65,2.28,-.35,-.35,-.3,-.3) dat <- list(x = matrix(bx, 2, 18, byrow = TRUE, dimnames = list(NULL, parts)), y = matrix(by, 2, 18, byrow = TRUE, dimnames = list(NULL, parts))) ## right knee angle (Rhip - Rknee - Rankle) in frame 1 kdegree(dat, 9, 10, 11, 1)
Normalizing coordinates from OpenPose
normalize(obj)normalize(obj)
obj |
Reshaped keypoint data (see |
The neck-normalised keypoint data, in the same x/y/p structure.
## a minimal reshaped pose over three frames parts <- c("nose","neck","Rshoulder","Relbow","Rwrist","Lshoulder","Lelbow", "Lwrist","Rhip","Rknee","Rankle","Lhip","Lknee","Lankle","Reye","Leye", "Rear","Lear") bx <- c(0,0,-.25,-.3,-.32,.25,.3,.32,-.18,-.2,-.22,.18,.2,.22,-.05,.05,-.1,.1) by <- c(-.3,0,.05,.5,.95,.05,.5,.95,1,1.65,2.28,1,1.65,2.28,-.35,-.35,-.3,-.3) dat <- list(x = matrix(bx, 3, 18, byrow = TRUE, dimnames = list(NULL, parts)), y = matrix(by, 3, 18, byrow = TRUE, dimnames = list(NULL, parts)), p = matrix(1, 3, 18, dimnames = list(NULL, parts))) norm <- normalize(dat) norm$x[, "neck"] # neck is the origin after normalisation## a minimal reshaped pose over three frames parts <- c("nose","neck","Rshoulder","Relbow","Rwrist","Lshoulder","Lelbow", "Lwrist","Rhip","Rknee","Rankle","Lhip","Lknee","Lankle","Reye","Leye", "Rear","Lear") bx <- c(0,0,-.25,-.3,-.32,.25,.3,.32,-.18,-.2,-.22,.18,.2,.22,-.05,.05,-.1,.1) by <- c(-.3,0,.05,.5,.95,.05,.5,.95,1,1.65,2.28,1,1.65,2.28,-.35,-.35,-.3,-.3) dat <- list(x = matrix(bx, 3, 18, byrow = TRUE, dimnames = list(NULL, parts)), y = matrix(by, 3, 18, byrow = TRUE, dimnames = list(NULL, parts)), p = matrix(1, 3, 18, dimnames = list(NULL, parts))) norm <- normalize(dat) norm$x[, "neck"] # neck is the origin after normalisation
Create segment line for frame plot
plt.segment(x, y)plt.segment(x, y)
x |
Numeric vector of keypoint x-coordinates for one frame. |
y |
Numeric vector of keypoint y-coordinates for one frame. |
Called for its side effect of drawing the segments; returns NULL.
bx <- c(0,0,-.25,-.3,-.32,.25,.3,.32,-.18,-.2,-.22,.18,.2,.22,-.05,.05,-.1,.1) by <- c(-.3,0,.05,.5,.95,.05,.5,.95,1,1.65,2.28,1,1.65,2.28,-.35,-.35,-.3,-.3) ## open a plot of the keypoints first, then draw the skeleton segments plot(bx, by, ylim = c(2.5, -0.5), asp = 1, pch = 19, main = "one pose") plt.segment(bx, by)bx <- c(0,0,-.25,-.3,-.32,.25,.3,.32,-.18,-.2,-.22,.18,.2,.22,-.05,.05,-.1,.1) by <- c(-.3,0,.05,.5,.95,.05,.5,.95,1,1.65,2.28,1,1.65,2.28,-.35,-.35,-.3,-.3) ## open a plot of the keypoints first, then draw the skeleton segments plot(bx, by, ylim = c(2.5, -0.5), asp = 1, pch = 19, main = "one pose") plt.segment(bx, by)
The main PoseFixeR workflow. Given imported and reshaped OpenPose keypoint
trajectories, it normalises them, detects and corrects left/right leg swaps,
anatomical (segment-length), biomechanical (joint-angle / range-of-motion) and
physical (frame-transition) anomalies as well as low-confidence detections,
sets anomalous keypoints to NA, standardises segment lengths, then imputes
and smooths the trajectories.
posefixer(dat, race, fps)posefixer(dat, race, fps)
dat |
Imported and reshaped OpenPose data (see |
race |
Reference-population index for the anatomical proportions (1 or 2). |
fps |
Frames per second of the source video. |
The corrected data in the same list structure as dat, or NA if the
recording fails the quality criteria.
Sugiyama Y, Uno K, Matsui Y (2023). Types of anomalies in two-dimensional video-based gait analysis in uncontrolled environments. PLOS Computational Biology 19:e1009989. doi:10.1371/journal.pcbi.1009989
## Build a small synthetic, neck-normalised gait recording (40 frames) with ## the legs swinging in anti-phase, then detect and correct anomalies. parts <- c("nose","neck","Rshoulder","Relbow","Rwrist","Lshoulder","Lelbow", "Lwrist","Rhip","Rknee","Rankle","Lhip","Lknee","Lankle","Reye","Leye", "Rear","Lear") bx <- c(0,0,-.25,-.3,-.32,.25,.3,.32,-.18,-.2,-.22,.18,.2,.22,-.05,.05,-.1,.1) by <- c(-.3,0,.05,.5,.95,.05,.5,.95,1,1.65,2.28,1,1.65,2.28,-.35,-.35,-.3,-.3) n <- 40 swing <- 0.45 * sin(seq(0, 4 * pi, length.out = n)) x <- matrix(bx, n, 18, byrow = TRUE, dimnames = list(NULL, parts)) y <- matrix(by, n, 18, byrow = TRUE, dimnames = list(NULL, parts)) x[, "Rankle"] <- bx[11] - swing x[, "Lankle"] <- bx[14] + swing x[, "Rknee"] <- bx[10] - 0.5 * swing x[, "Lknee"] <- bx[13] + 0.5 * swing dat <- list(x = x, y = y, p = matrix(1, n, 18, dimnames = list(NULL, parts))) fixed <- posefixer(dat, race = 1, fps = 25) str(fixed, max.level = 1) # corrected x / y / p trajectories## Build a small synthetic, neck-normalised gait recording (40 frames) with ## the legs swinging in anti-phase, then detect and correct anomalies. parts <- c("nose","neck","Rshoulder","Relbow","Rwrist","Lshoulder","Lelbow", "Lwrist","Rhip","Rknee","Rankle","Lhip","Lknee","Lankle","Reye","Leye", "Rear","Lear") bx <- c(0,0,-.25,-.3,-.32,.25,.3,.32,-.18,-.2,-.22,.18,.2,.22,-.05,.05,-.1,.1) by <- c(-.3,0,.05,.5,.95,.05,.5,.95,1,1.65,2.28,1,1.65,2.28,-.35,-.35,-.3,-.3) n <- 40 swing <- 0.45 * sin(seq(0, 4 * pi, length.out = n)) x <- matrix(bx, n, 18, byrow = TRUE, dimnames = list(NULL, parts)) y <- matrix(by, n, 18, byrow = TRUE, dimnames = list(NULL, parts)) x[, "Rankle"] <- bx[11] - swing x[, "Lankle"] <- bx[14] + swing x[, "Rknee"] <- bx[10] - 0.5 * swing x[, "Lknee"] <- bx[13] + 0.5 * swing dat <- list(x = x, y = y, p = matrix(1, n, 18, dimnames = list(NULL, parts))) fixed <- posefixer(dat, race = 1, fps = 25) str(fixed, max.level = 1) # corrected x / y / p trajectories
Reshape imported keypoints into frame-by-keypoint matrices
reshaping(obj, norm = TRUE)reshaping(obj, norm = TRUE)
obj |
A list of per-frame keypoint matrices (from |
norm |
Logical; normalise coordinates relative to the neck (default TRUE). |
A list with x, y and confidence matrices (frames x keypoints).
## five frames, each an 18 x 3 keypoint matrix as returned by import_json() parts <- c("nose","neck","Rshoulder","Relbow","Rwrist","Lshoulder","Lelbow", "Lwrist","Rhip","Rknee","Rankle","Lhip","Lknee","Lankle","Reye","Leye", "Rear","Lear") bx <- c(0,0,-.25,-.3,-.32,.25,.3,.32,-.18,-.2,-.22,.18,.2,.22,-.05,.05,-.1,.1) by <- c(-.3,0,.05,.5,.95,.05,.5,.95,1,1.65,2.28,1,1.65,2.28,-.35,-.35,-.3,-.3) frames <- lapply(1:5, function(i) { m <- cbind(X = bx, Y = by, P = 1) rownames(m) <- parts m }) resh <- reshaping(frames) dim(resh$x) # 5 frames x 18 keypoints colnames(resh$x)[1:4]## five frames, each an 18 x 3 keypoint matrix as returned by import_json() parts <- c("nose","neck","Rshoulder","Relbow","Rwrist","Lshoulder","Lelbow", "Lwrist","Rhip","Rknee","Rankle","Lhip","Lknee","Lankle","Reye","Leye", "Rear","Lear") bx <- c(0,0,-.25,-.3,-.32,.25,.3,.32,-.18,-.2,-.22,.18,.2,.22,-.05,.05,-.1,.1) by <- c(-.3,0,.05,.5,.95,.05,.5,.95,1,1.65,2.28,1,1.65,2.28,-.35,-.35,-.3,-.3) frames <- lapply(1:5, function(i) { m <- cbind(X = bx, Y = by, P = 1) rownames(m) <- parts m }) resh <- reshaping(frames) dim(resh$x) # 5 frames x 18 keypoints colnames(resh$x)[1:4]