rgl segments3d to connect 3d scatter points in order to plot a skeleton - r

I am working with motion capture data, and wish to plot two skeletons in 3D (motion capture data obtained from two different systems).
I have managed to plot and label the joints, but I can´t figure out how to connect the joints with lines.
A short explanation to the abreviations used in the sample dataset below:
RA and LA (Right and Left Ankle)
RK and LK (Right and Left Knee)
RH and LH (Right and Left Hip)
CG (Center of Gravity)
Simplified data set:
df <- data.frame(
Joint = c("LA", "RA", "LK", "RK", "LH", "RH", "CG", "LA", "RA", "LK", "RK", "LH", "RH", "CG"),
system = c("A", "A", "A", "A", "A", "A", "A", "B", "B", "B", "B", "B", "B", "B"),
x = c(0, 10, 0, 10, 0, 10, 5, 0, 10, 0, 10, 0, 10, 5),
y = c(0,0,0,0,0,0,0, 20,20,20,20,20,20,20),
z = c(0, 0, 20, 20, 40, 40, 50, 0, 0, 20, 20, 40, 40, 50))
My code so far to plot and label the joints from the two systems:
library(rgl)
with(df, plot3d(x, y, z, type="s", col = as.numeric(system)))
with(df, text3d(x, y, z, text = Joint, adj = 2))
Can you help me connect the joints?

Use the segments3d function to draw line segments. It takes the usual
x, y, z coordinates, and joins pairs of points. So you'll need to work out which joints are joined, and plot segments between those joints.
If the joints are always in the order you gave, it would go something like this:
segs <- c(1, 3, 2, 4, 3, 5, 4, 6, 5, 7, 6, 7)
segments3d(df[segs, 3:5])
(This just does the system A segments.)
Edited to add: In response to the first comment: You will need to tell R that ankles connect to knees, etc, but you can do that. For example:
segs <- c()
for (s in unique(df$system)) {
seg <- with(df, c(which(system == s & Joint == "LA"),
which(system == s & Joint == "LK"))
if (length(seg) == 2)
segs <- c(segs, seg)
seg <- with(df, c(which(system == s & Joint == "LK"),
which(system == s & Joint == "CG"))
if (length(seg) == 2)
segs <- c(segs, seg)
# etc for the other side
}
segments3d(df[segs, 3:5])
This could all be compressed if you have the connections arranged in an R object somehow. I'll leave that to you to work out.

Related

Problem with 'mutate()' input 'data' in ANOVA (rstatix)

This is driving me crazy. I am using anova_test from rstatix and it's telling me that my columns aren't there when they clearly are.
This is what my dataframe looks like:
ID = c(1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3)
Form = c("A", "A", "A", "B", "B", "B", "A", "A", "A", "B", "B", "B", "A", "A", "A", "B", "B", "B")
Pen = c("Red", "Blue", "Green", "Red", "Blue", "Green", "Red", "Blue", "Green","Red", "Blue", "Green","Red", "Blue", "Green","Red", "Blue", "Green")
Time = c(20, 4, 6, 2, 76, 3, 86, 35, 74, 94, 14, 35, 63, 12, 15, 73, 87, 33)
df <- data.frame(ID, Form, Pen, Time)
ID, Form, and Pen are factors, while Time is numeric. So each subject completed forms A and B with Red, Blue, and Green pens, and I measured how long each took in completing the form.
This is a fake dataset that I've purposefully come up with to ask this question. In reality, this dataframe is derived from a larger dataset with several more variables. Each variable has a lot more observations (so not just one datapoint for subject 1 & Form A & Red Pen, as in this example, but multiple), so I've summarized them to get mean Time.
df <- original.df %>% dplyr::select(ID, Form, Pen, Time)
df <- df %>% dplyr::group_by(ID, Form, Pen) %>% dplyr::summarise(Time = mean(Time))
df <- df %>% convert_as_factor(ID, Form, Pen)
df$Time <- as.numeric(df$Time)
I wanted to test the main and interaction effects, so I'm doing a 2 by 3 repeated measures ANOVA (a two-way ANOVA, because Form and Pen are two independent variables).
aov <- rstatix::anova_test(data = df, dv = Time, wid = ID, within = c(Form, Pen))
and I KEEP getting this error:
Error: Problem with `mutate()` input `data`.
x Can't subset columns that don't exist.
x Columns `ID` and `Form` don't exist.
ℹ Input `data` is `map(.data$data, .f, ...)`.
WHY?! Any help would be greatly appreciated. I've been searching solutions for HOURS and I'm getting pretty frustrated.
Thank you for adding the additional details to the post - based on what you've provided it looks like you need to ungroup your df before passing it to anova_test(), e.g.
#install.packages("rstatix")
library(rstatix)
library(tidyverse)
ID = c(1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3)
Form = c("A", "A", "A", "B", "B", "B", "A", "A", "A", "B", "B", "B", "A", "A", "A", "B", "B", "B")
Pen = c("Red", "Blue", "Green", "Red", "Blue", "Green", "Red", "Blue", "Green","Red", "Blue", "Green","Red", "Blue", "Green","Red", "Blue", "Green")
Time = c(20, 4, 6, 2, 76, 3, 86, 35, 74, 94, 14, 35, 63, 12, 15, 73, 87, 33)
original.df <- data.frame(ID, Form, Pen, Time)
df <- original.df %>%
dplyr::select(ID, Form, Pen, Time)
df <- df %>%
dplyr::group_by(ID, Form, Pen) %>%
dplyr::summarise(Time = mean(Time))
df <- df %>%
convert_as_factor(ID, Form, Pen)
df$Time <- as.numeric(df$Time)
df <- ungroup(df)
aov <- rstatix::anova_test(data = df, dv = Time, wid = ID, within = c(Form, Pen))
You can see whether a dataframe is grouped using str(), e.g. str(df) before and after ungrouped() shows you the difference. Please let me know if you are still getting errors after making this change

How to correctly add a transformed variable to ggplot axis

I would like to plot a transformed variable (in this case an average shift value) on the y axis. For the life of me I can't understand how to get R to plot the overall result (not just the calculated sum of each day's average). Any help would be greatly appreciated.
# set up
library(tidyverse)
# example data
df <-
tribble(
~Week, ~Day, ~Team, ~Sales, ~Shifts,
"WK1", 1, "A", 100, 1,
"WK1", 1, "B", 120, 1,
"WK1", 2, "A", 100, 1,
"WK1", 2, "B", 120, 1,
"WK1", 3, "A", 100, 1,
"WK1", 3, "B", 120, 1,
"WK1", 4, "A", 100, 1,
"WK1", 4, "B", 120, 1,
"WK1", 5, "A", 100, 1,
"WK1", 5, "B", 120, 1,
"WK1", 6, "A", 100, 1,
"WK1", 6, "B", 120, 1,
"WK1", 7, "A", 100, 1,
"WK1", 7, "B", 120, 1
)
# P1: y axis is not the shift average as desired. For example, Team A's shift average should be 100.
ggplot(df, aes(x = Week, y = (Sales/Shifts) )) +
geom_col() +
facet_grid(.~ Team)
# P2: ggplot seems to be calculating the sum of each individual day's shift average
ggplot(df, aes(x = Week, y = (Sales/Shifts), fill = Day )) +
geom_col() +
facet_grid(.~ Team)
The overall shift average should be
Team A: 100
Team B: 120
I'd recommend summarizing your data and giving ggplot the values you want to plot, rather than trying to use the graphics package to do the data manipulation for you.
df_avg = df %>%
group_by(Team, Week) %>%
summarize(Shift_Avg = mean(Sales / Shifts))
## or maybe you want sum(Sales) / sum(Shifts) ? Might be more appropriate
ggplot(df_avg, aes(x = Week, y = Shift_Avg)) +
geom_col() +
facet_grid(~ Team)

Plot observation number (label) in outlier points

I have this boxplot with outliers, i need to plot the number of the line that contain the outlier observation, to make it easy to go in the data set and find where the value, somebody can help me?
set.seed(1)
a <- runif(10,1,100)
b <-c("A","A","A","A","A","B","B","B","B","B")
t <- cbind(a,b)
bp <- boxplot(a~b)
text(x = 1, y = bp$stats[,1] + 2, labels = round(bp$stats[,1], 2))
text(x = 2, y = bp$stats[,2] + 2, labels = round(bp$stats[,2], 2))
What is the point of t <- cbind(a, b)? That makes a character matrix and converts your numbers to character strings? You don't use it anyway. If you want a single data structure use data.frame(a, b) which will make a a factor and leave b numeric. I do not get the plot you do with set.seed(1) so I'll provide slightly different data. Note the use of the pos= and offset= arguments in text(). Be sure to read the manual page to see what they are doing:
a <- c(99.19, 59.48, 48.95, 18.17, 75.73, 45.94, 51.61, 21.55, 37.41,
59.98, 57.91, 35.54, 4.52, 64.64, 75.03, 60.21, 56.53, 53.08,
98.52, 51.26)
b <- c("A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "B", "B",
"B", "B", "B", "B", "B", "B", "B", "B")
bp <- boxplot(a~b)
text(x = 1, y = bp$stats[,1], labels = round(bp$stats[, 1], 2),
pos=c(1, 3, 3, 1, 3), offset=.2)
text(x = 2, y = bp$stats[, 2], labels = round(bp$stats[, 2], 2),
pos=c(1, 3, 3, 1, 3), offset=.2)
obs <- which(a %in% bp$out)
text(bp$group, bp$out, obs, pos=4)

Using matplot in R whenever certain column changes

Sorry in advance because I am new at asking questions here and don't know how to input this table properly.
Say I have a data frame in R constructed like:
team = c("A", "A", "A", "B", "B", "B", "C", "C", "C")
value = c(1, 2, 3, 4, 5, 6, 7, 8, 9)
m = cbind(team, value)
I want to create a plot that will give me 3 lines graphing the values for teams A, B, and C. I believe I can do this inputting the matrix m into matplot somehow, but I'm not sure how.
EDIT: I've gotten a lot closer to solving my problem. However I've realized that for some reason, with the code I have, "Value" is a list of 745 which matches the number of rows in my dataframe m. However when I unlist(Value) it turns into a numeric of length 894. Any ideas on why this would happen?
You can try something like this:
team = c("A", "A", "A", "B", "B", "B", "C", "C", "C")
value = c(1, 2, 3, 4, 5, 6, 7, 8, 9)
m = cbind.data.frame(team, value)
library(ggplot2)
ggplot(m, aes(x=as.factor(1:nrow(m)), y=value, group=team, col=team)) +
geom_line(lwd=2) + xlab('index')
if you have same number of ordered values for each team, you could use matplot to visualize them. but the data should be converted to matrix first;
m = cbind.data.frame(team, value, index = rep(1:3, 3))
m <- reshape(m, v.names = 'value', idvar = 'team', direction = 'wide', timevar = 'index')
matplot(t(m[, 2:4]), type = 'l', lty = 1)
legend('top', legend = m[, 1], lty = 1, col = 1:3)

Facets and multiple datasets in ggplot2

I need to display two datasets on the same faceted plots with ggplot2. The first dataset (dat) is to be shown as crosses like this:
While the second dataset (dat2) is to be shown as a color line. For an element of context, the second dataset is actually the Pareto frontier of the first set...
Both datasets (dat and dat2) look like this:
modu mnc eff
1 0.3080473 0 0.4420544
2 0.3110355 4 0.4633741
3 0.3334024 9 0.4653061
Here's my code so far:
library(ggplot2)
dat <- structure(list(modu = c(0.30947265625, 0.3094921875, 0.32958984375,
0.33974609375, 0.33767578125, 0.3243359375, 0.33513671875, 0.3076171875,
0.3203125, 0.3205078125, 0.3220703125, 0.28994140625, 0.31181640625,
0.352421875, 0.31978515625, 0.29642578125, 0.34982421875, 0.3289453125,
0.30802734375, 0.31185546875, 0.3472265625, 0.303828125, 0.32279296875,
0.3165234375, 0.311328125, 0.33640625, 0.3140234375, 0.33515625,
0.34314453125, 0.33869140625), mnc = c(15, 9, 6, 0, 10, 12, 14,
9, 5, 11, 0, 15, 0, 2, 14, 13, 14, 17, 11, 12, 13, 6, 4, 0, 13,
7, 10, 12, 7, 13), eff = c(0.492448979591836, 0.49687074829932,
0.49421768707483, 0.478571428571428, 0.493537414965986, 0.493809523809524,
0.49891156462585, 0.499319727891156, 0.495102040816327, 0.492285714285714,
0.482312925170068, 0.498911564625851, 0.479931972789116, 0.492857142857143,
0.495238095238095, 0.49891156462585, 0.49530612244898, 0.495850340136055,
0.50156462585034, 0.496, 0.492897959183673, 0.487959183673469,
0.495605442176871, 0.47795918367347, 0.501360544217687, 0.497850340136054,
0.493496598639456, 0.493741496598639, 0.496734693877551, 0.499659863945578
)), .Names = c("modu", "mnc", "eff"), row.names = c(NA, 30L), class = "data.frame")
dat2 <- structure(list(modu = c(0.26541015625, 0.282734375, 0.28541015625,
0.29216796875, 0.293671875), mnc = c(0.16, 0.28, 0.28, 0.28,
0.28), eff = c(0.503877551020408, 0.504149659863946, 0.504625850340136,
0.505714285714286, 0.508503401360544)), .Names = c("modu", "mnc",
"eff"), row.names = c(NA, 5L), class = "data.frame")
dat$modu = dat$modu
dat$mnc = dat$mnc*50
dat$eff = dat$eff
dat2$modu = dat2$modu
dat2$mnc = dat2$mnc*50
dat2$eff = dat2$eff
res <- do.call(rbind, combn(1:3, 2, function(ii)
cbind(setNames(dat[,c(ii, setdiff(1:3, ii))], c("x", "y")),
var=paste(names(dat)[ii], collapse="/")), simplify=F))
ggplot(res, aes(x=x, y=y))+ geom_point(shape=4) +
facet_wrap(~ var, scales="free")
How should I go about doing this? Do I need to add a layer? If so, how to do this in a faceted plot?
Thanks!
Here's one way:
pts <- do.call(rbind, combn(1:3, 2, function(ii)
cbind(setNames(dat[,c(ii, setdiff(1:3, ii))], c("x", "y")),
var=paste(names(dat)[ii], collapse="/")), simplify=F))
lns <- do.call(rbind, combn(1:3, 2, function(ii)
cbind(setNames(dat2[,c(ii, setdiff(1:3, ii))], c("x", "y")),
var=paste(names(dat2)[ii], collapse="/")), simplify=F))
gg.df <- rbind(cbind(geom="pt",pts),cbind(geom="ln",lns))
ggplot(gg.df,aes(x,y)) +
geom_point(data=gg.df[gg.df$geom=="pt",], shape=4)+
geom_path(data=gg.df[gg.df$geom=="ln",], color="red")+
facet_wrap(~var, scales="free")
The basic idea is to create separate data.frames for the points and the lines, then bind them together row-wise with an extra column (geom) indicating which geometry the data goes with. Then we plot the points based on the subset of gg.df with geom=="pt" and similarly with the lines.
The result isn't very interesting with your limited example, but this seems (??) to be what you want. Notice the use of geom_path(...) rather than geom_line(...). The latter orders the x-values before plotting.

Resources