Подберите сглаживатели лесса для нескольких групп по нескольким переменным - PullRequest
0 голосов
/ 04 марта 2020

Мне нужно разместить множество сплайнов Лёсса с помощью переменной группировки (Animal) в нескольких столбцах чисел c (Var1, Var2) и извлечь эти значения.

Я нашел код для выполнения этой задачи одна переменная за раз;

# Create dataframe 1
OneVarDF <- data.frame(Day = c(replicate(1,sample(1:50,200,rep=TRUE))),
                 Animal = c(c(replicate(100,"Greyhound"), c(replicate(100,"Horse")))),
                 Var1 = c(c(replicate(1,sample(2:10,100,rep=TRUE))), c(replicate(1,sample(15:20,100,rep=TRUE)))))


library(dplyr)
library(tidyr)
library(purrr)

# Get fitted values from each model
Models <- OneVarDF %>%
  tidyr::nest(-Animal) %>%
  dplyr::mutate(m = purrr::map(data, loess, formula = Var1 ~ Day, span = 0.30),
                fitted = purrr::map(m, `[[`, "fitted")
  )

# Create prediction column
Results <- Models %>%
  dplyr::select(-m) %>%
  tidyr::unnest()

Этот «Результаты» датафрейм необходим для последующих задач (не требуя большого количества непараметрических параметров c распределения).

Как мы можем достичь этого с помощью кадра данных с несколькими цифрами c столбцов (код ниже) и извлечь «Results» dataframe? Спасибо.

# Create dataframe 2
TwoVarDF <- data.frame(Day = c(replicate(1,sample(1:50,200,rep=TRUE))),
                       Animal = c(c(replicate(100,"Greyhound"), c(replicate(100,"Horse")))),
                       Var1 = c(c(replicate(1,sample(2:10,100,rep=TRUE))), c(replicate(1,sample(15:20,100,rep=TRUE)))),
                       Var2 = c(c(replicate(1,sample(22:27,100,rep=TRUE))), c(replicate(1,sample(29:35,100,rep=TRUE)))))

Ответы [ 2 ]

1 голос
/ 04 марта 2020

Мы можем получить данные в длинном формате, используя. pivot_longer, group_by Animal и имя столбца и применить loess к каждой комбинации.

library(dplyr)
library(tidyr)

TwoVarDF %>%
  pivot_longer(cols = starts_with('Var')) %>%
  group_by(Animal, name) %>%
  mutate(model = loess(value~Day, span = 0.3)$fitted)
0 голосов
/ 04 марта 2020

Включите функцию gather(), чтобы выполнить действия, аналогичные предыдущему коду.

Models2 <- TwoVarDF %>%
  gather(varName, varVal, 3:4) %>% 
  tidyr::nest(-Animal, -varName) %>%
  dplyr::mutate(m = purrr::map(data, loess, formula = varVal ~ Day, span = 0.30),
                fitted = purrr::map(m, `[[`, "fitted")
  )
...