#r #dataframe #tidyverse
Вопрос:
У меня есть файл excel, который выглядит так:
| ID | strength_score_недельник_1 | agility_score_недельник_1 | strength_score_недель_2 | agility_score_недельник_2 |
|---|---|---|---|---|
| 1 | 3 | 6 | 4 | 6 |
| 2 | 5 | 6 | 6 | 6 |
| 3 | 8 | 8 | 9 | 8 |
| 4 | 6 | 7 | 6 | 4 |
Я хочу переставить/ переписать приведенные выше данные в фрейм данных, который упорядочивает их в этом формате:
| Неделя | тип обучения | средний балл |
|---|---|---|
| 1 | проворство | |
| 1 | сила | |
| 2 | проворство | |
| 2 | сила |
по сути, я хочу сделать с итоговой таблицей следующее: я хочу сгруппировать ее по типу тренировки и построить 2 линейных графика, показывающих средний балл за ловкость и силу за период 40 недель
любая помощь будет очень признательна!
Ответ №1:
df <- data.frame(
ID = c(1L, 2L, 3L, 4L),
strength_score_week_1 = c(3L, 5L, 8L, 6L),
agility_score_week_1 = c(6L, 6L, 8L, 7L),
strength_score_week_2 = c(4L, 6L, 9L, 6L),
agility_score_week_2 = c(6L, 6L, 8L, 4L)
)
df
#> ID strength_score_week_1 agility_score_week_1 strength_score_week_2
#> 1 1 3 6 4
#> 2 2 5 6 6
#> 3 3 8 8 9
#> 4 4 6 7 6
#> agility_score_week_2
#> 1 6
#> 2 6
#> 3 8
#> 4 4
library(tidyverse)
df %>%
pivot_longer(!ID, names_pattern = '([^_]*)_score_week_(.*)', names_to = c('training_type', 'week')) %>%
group_by(week, training_type) %>%
summarise(mean_score = mean(value), .groups = 'drop') %>%
mutate(week = as.numeric(week)) %>%
ggplot(aes(x = week, y = mean_score, color = training_type, group = training_type))
geom_line()
Создано 2021-07-22 пакетом reprex (v2.0.0)
Комментарии:
1. Я попытался, как вы советовали — сделал трюк, я думаю, однако, ось x не упорядочена правильно при продлении до 40 недель. Есть какие-нибудь советы о том, как это преодолеть? поместите изображение, о котором идет речь, для ссылки на
2. Между тем
pivot_longerиgroup_byсделайте это:mutate(week = as.numeric(week)) %>%3. @fireplush, да, я забыл отредактировать это. Видишь это сейчас
Ответ №2:
Попробуйте это
library(readxl) #library to import excel sheets
df <- t(read_excel('Book1.xlsx')[,-1]) #import data (remove id column)
df_mean <- rowMeans(df) #calculate mean score
#get auxiliar matrix with names of elements
aux <- matrix(unlist(strsplit(rownames(df), '_')), nrow = nrow(df), byrow = T)[,c(1,4)]
colnames(aux) <- c('feature', 'week')
#Join everything in a data frame
df <- as.data.frame(cbind(df_mean, aux))
#plot
library(ggplot2)
ggplot(df)
geom_point(aes(x = week, y = df_mean, colour = factor(feature)))
Ответ №3:
library(dplyr)
library(tibble)
library(stringr)
dt <- as.data.frame(t(dt))[-1,]
dt %>%
rownames_to_column() %>%
rowwise() %>%
mutate(`training type` = str_split(rowname, "_")[[1]][1],
week = str_split(rowname, "_")[[1]][4]) %>%
ungroup() %>%
mutate(`mean score` = rowMeans(.[,2:5])) %>%
select(week, `training type`, `mean score`)
Что приводит к:
# A tibble: 4 x 3
week `training type` `mean score`
<chr> <chr> <dbl>
1 1 strength 5.5
2 1 agility 6.75
3 2 strength 6.25
4 2 agility 6
Если у вас есть типы обучения, содержащие несколько слов, вам следует использовать другую функцию вместо str_split. Если это так, я могу переписать эту часть кода заново
Ответ №4:
Базовый вариант R
do.call(
rbind,
apply(
aggregate(
cbind(strength, agility) ~ time,
reshape(
setNames(df, gsub("_score_", ".", names(df))),
direction = "long",
idvar = "ID",
varying = -1
), mean
), 1, function(x) cbind(week = x[[1]], rev(stack(x[-1])))
)
)
дает
week ind values
1 week_1 strength 5.50
2 week_1 agility 6.75
3 week_2 strength 6.25
4 week_2 agility 6.00
Ответ №5:
Я бы использовал смесь pivot_longer , seperate и mutate таким образом,
data %>%
pivot_longer(cols = -"ID", names_to = "training_type") %>%
mutate(training_type = str_remove(training_type, "_score")) %>%
group_by(training_type) %>%
summarise(mean_score = mean(value, na.rm = TRUE)) %>%
separate(
col = "training_type",
sep = "_week_",
into = c("training_type", "week")
) %>%
mutate(week = as.numeric(week))
Что дает вам следующее output ,
# A tibble: 4 x 3
training_type week mean_score
<chr> <dbl> <dbl>
1 agility 1 6.75
2 agility 2 6
3 strength 1 5.5
4 strength 2 6.25
Которые готовы быть нанесены на,
data %>% ggplot(
mapping = aes(
x = week,
y = mean_score,
color = training_type
)
) geom_line()
