Как использовать применить группу функций в R для вычисления среднего значения с разделителем плюс

Question

У меня есть такие данные

tt<- structure(list(Time = c(48L, 48L, 72L, 72L), WT_H20 = structure(c(13L, 
11L, 17L, 14L), .Label = c("0", "0.2+0.2", "0.5+0.4", "0.5+0.6", 
"0.8+0.85", "1.2+1.3", "1.3+1.35", "1.5+1.1", "1.5+1.2", "1.6+2", 
"1.7+1.5", "1.8+1.5", "1.9+1.7", "1.9+2.1", "2.1+1.7", "2.3+2.7", 
"2.8+2.8", "2.9+2.2"), class = "factor"), WT_Ago2_800 = structure(c(1L, 
1L, 4L, 5L), .Label = c("0", "0.1+0.1", "0.5+0.1", "0.5+0.5", 
"0.8+0.8"), class = "factor"), WT_Ago2_400 = structure(c(14L, 
8L, 4L, 15L), .Label = c("0", "0.1+0.1", "0.2+0.2", "0.5+0.5", 
"0.6+0.55", "0.7+0.6", "0.75+0.7", "0.8+0.8", "0.9+0.8", "0.9+0.9", 
"1.1+1.1", "1.35+1.3", "1.6+1.7", "1+1", "2+2.4"), class = "factor")), row.names = 17:20, class = "data.frame")

Я хочу разбить строку и получить среднее значение в ячейках с +. У меня есть мой код, который делает это для одного столбца sapply(strsplit(as.character(tt$WT_H20), "\\+"), function(x) mean(as.numeric(x))), но я хочу сделать это для всех столбцов, используя применять группу функций. Я могу сделать это с помощью циклов, но хотел использовать функции применения.

Answer 1

lapply проходит через столбцы tt.grepl проверяет, есть ли в столбцах "+".Если это так, разделите на "+", преобразуйте в числовое и возьмите среднее значение.

data.frame(lapply(tt, function(x){
    if (any(grepl("\\+", x))){
        sapply(strsplit(as.character(x), "\\+"), function(y) mean(as.numeric(y)))
    }else{
        x
    }
}))
#  Time WT_H20 WT_Ago2_800 WT_Ago2_400
#1   48    1.8         0.0         1.0
#2   48    1.6         0.0         0.8
#3   72    2.8         0.5         0.5
#4   72    2.0         0.8         2.2

Answer 2

Поскольку в столбце есть выражение, мы можем использовать eval(parse, чтобы получить сумму (+), а затем разделить на 2

sapply(tt$WT_H20, function(x) eval(parse(text = as.character(x))))/2
#[1] 1.8 1.6 2.8 2.0

---

или использовать strsplit

sapply(strsplit(as.character(tt$WT_H20), "+", fixed = TRUE), 
      function(x) mean(as.numeric(x)))
#[1] 1.8 1.6 2.8 2.0

---

Для нескольких столбцов подход base R будет иметь lapply для каждого столбца, а затем разделить столбец по разделителю +, преобразовать в numeric и получить mean

tt[-1] <- lapply(tt[-1], function(x) sapply(strsplit(as.character(x), 
              "+", fixed = TRUE), function(y) mean(as.numeric(y))))

---

Или, используя tidyverse, мы перебираем столбцы с map, separate столбцами на две части, получаем rowMeans и создаем новый data.frame

library(tidyverse)
tt %>% 
  map_if(is.factor, ~ 
       tibble(col = as.character(.x)) %>% 
          separate(col, into = c('col1', 'col2'), convert = TRUE, sep = "[+]") %>%
          rowMeans(na.rm = TRUE)) %>% 
  bind_cols
# A tibble: 4 x 4
#   Time WT_H20 WT_Ago2_800 WT_Ago2_400
#  <int>  <dbl>       <dbl>       <dbl>
#1    48    1.8         0           1  
#2    48    1.6         0           0.8
#3    72    2.8         0.5         0.5
#4    72    2           0.8         2.2