filter dataframe по числовой переменной, lm() и отклонению отложений

Я хочу применить различные уровни числового фильтра (например, seq(10,80, by=2)), а затем сшить их в единый блок данных для сравнения с другой переменной. В настоящее время я могу это сделать, но я надеюсь, что есть лучший способ, так как я просто копирую и вставляю код, а затем присоединяюсь ко всему. Конечным результатом, который я хочу, является то, что у меня есть, каждый шаг фильтра как его собственный столбец с параметром наклона из lm() извлечен.filter dataframe по числовой переменной, lm() и отклонению отложений

Source: local data frame [23 x 17] 

          File FruitNum  est10 
         <fctr> <int>  <dbl> 
1 IMG_7888.JPGcolcorrected.jpg  2 -4.0000000 
2 IMG_7888.JPGcolcorrected.jpg  4 -2.0000000 
3 IMG_7889.JPGcolcorrected.jpg  1 -0.8178571 
4 IMG_7889.JPGcolcorrected.jpg  2 -2.1000000 
5 IMG_7890.JPGcolcorrected.jpg  1 -2.8000000 
6 IMG_7892.JPGcolcorrected.jpg  3 -2.3571429 
7 IMG_7895.JPGcolcorrected.jpg  1 -0.4000000 
8 IMG_7896.JPGcolcorrected.jpg  3 -6.5000000 
9 IMG_7898.JPGcolcorrected.jpg  1 -3.0000000 
10 IMG_7888.JPGcolcorrected.jpg  1   NA 
..       ...  ...  ... 
Variables not shown: est15 <dbl>, est20 <dbl>, est25 <dbl>, 
    est30 <dbl>, est35 <dbl>, est40 <dbl>, est45 <dbl>, est50 
    <dbl>, est55 <dbl>, est60 <dbl>, est65 <dbl>, est70 <dbl>, 
    est75 <dbl>, est80 <dbl>.

Я в настоящее время с помощью NSE трубопровода в hadleyverse и хотел бы остаться там, но я рад видеть базу, data.table или других реализаций. Я смотрел на purrr, но я не уверен, как сопоставить фильтр с переменной inline.

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

cukeDataDL <- read.delim("https://gist.githubusercontent.com/bhive01/e7508f552db0415fec1749d0a390c8e5/raw/a12386d43c936c2f73d550dfdaecb8e453d19cfe/widthtest.tsv") 

cukeDatatest <- 
    cukeDataDL %>% 
    mutate(ObjectWidth = strsplit(as.character(cukeDatatest$ObjectWidth), ',')) %>% # split ObjectWidth into a nested column containing a vector 
    unnest() %>% # unnest nested column, melting data to long form 
    mutate(ObjectWidth = as.integer(ObjectWidth)) %>% # convert data to integer 
    group_by(File, FruitNum) %>% 
    mutate(rownum = row_number()) #location within File x fruit 

estimate10 <- 
    cukeDatatest %>% 
    filter(ObjectWidth < 0.10 * max(ObjectWidth) & rownum > mean(rownum)) %>% # filtering for 10% of maxwidth and second half of fruit 
    by_slice(~tidy(lm(ObjectWidth ~ rownum, data = .))) %>% #broom to clean up models and get coef()s 
    unnest() %>% #pull out nested information 
    filter(term == "rownum") %>% #only interested in slope value 
    select(File, FruitNum, est10 = estimate) #get rid of uninteresting columns and rename estimate for join 

estimate15 <- 
    cukeDatatest %>% 
    filter(ObjectWidth < 0.15 * max(ObjectWidth) & rownum > mean(rownum)) %>% 
    by_slice(~tidy(lm(ObjectWidth ~ rownum, data = .))) %>% 
    unnest() %>% 
    filter(term == "rownum") %>% 
    select(File, FruitNum, est15 = estimate) 

estimate20 <- 
    cukeDatatest %>% 
    filter(ObjectWidth < 0.20 * max(ObjectWidth) & rownum > mean(rownum)) %>% 
    by_slice(~tidy(lm(ObjectWidth ~ rownum, data = .))) %>% 
    unnest() %>% 
    filter(term == "rownum") %>% 
    select(File, FruitNum, est20 = estimate) 

estimate25 <- 
    cukeDatatest %>% 
    filter(ObjectWidth < 0.25 * max(ObjectWidth) & rownum > mean(rownum)) %>% 
    by_slice(~tidy(lm(ObjectWidth ~ rownum, data = .))) %>% 
    unnest() %>% 
    filter(term == "rownum") %>% 
    select(File, FruitNum, est25 = estimate) 

estimate30 <- 
    cukeDatatest %>% 
    filter(ObjectWidth < 0.30 * max(ObjectWidth) & rownum > mean(rownum)) %>% 
    by_slice(~tidy(lm(ObjectWidth ~ rownum, data = .))) %>% 
    unnest() %>% 
    filter(term == "rownum") %>% 
    select(File, FruitNum, est30 = estimate) 

estimate35 <- 
    cukeDatatest %>% 
    filter(ObjectWidth < 0.35 * max(ObjectWidth) & rownum > mean(rownum)) %>% 
    by_slice(~tidy(lm(ObjectWidth ~ rownum, data = .))) %>% 
    unnest() %>% 
    filter(term == "rownum") %>% 
    select(File, FruitNum, est35 = estimate) 

estimate40 <- 
    cukeDatatest %>% 
    filter(ObjectWidth < 0.40 * max(ObjectWidth) & rownum > mean(rownum)) %>% 
    by_slice(~tidy(lm(ObjectWidth ~ rownum, data = .))) %>% 
    unnest() %>% 
    filter(term == "rownum") %>% 
    select(File, FruitNum, est40 = estimate) 

estimate45 <- 
    cukeDatatest %>% 
    filter(ObjectWidth < 0.45 * max(ObjectWidth) & rownum > mean(rownum)) %>% 
    by_slice(~tidy(lm(ObjectWidth ~ rownum, data = .))) %>% 
    unnest() %>% 
    filter(term == "rownum") %>% 
    select(File, FruitNum, est45 = estimate) 

estimate50 <- 
    cukeDatatest %>% 
    filter(ObjectWidth < 0.50 * max(ObjectWidth) & rownum > mean(rownum)) %>% 
    by_slice(~tidy(lm(ObjectWidth ~ rownum, data = .))) %>% 
    unnest() %>% 
    filter(term == "rownum") %>% 
    select(File, FruitNum, est50 = estimate) 

estimate55 <- 
    cukeDatatest %>% 
    filter(ObjectWidth < 0.55 * max(ObjectWidth) & rownum > mean(rownum)) %>% 
    by_slice(~tidy(lm(ObjectWidth ~ rownum, data = .))) %>% 
    unnest() %>% 
    filter(term == "rownum") %>% 
    select(File, FruitNum, est55 = estimate) 

estimate60 <- 
    cukeDatatest %>% 
    filter(ObjectWidth < 0.60 * max(ObjectWidth) & rownum > mean(rownum)) %>% 
    by_slice(~tidy(lm(ObjectWidth ~ rownum, data = .))) %>% 
    unnest() %>% 
    filter(term == "rownum") %>% 
    select(File, FruitNum, est60 = estimate) 

estimate65 <- 
    cukeDatatest %>% 
    filter(ObjectWidth < 0.65 * max(ObjectWidth) & rownum > mean(rownum)) %>% 
    by_slice(~tidy(lm(ObjectWidth ~ rownum, data = .))) %>% 
    unnest() %>% 
    filter(term == "rownum") %>% 
    select(File, FruitNum, est65 = estimate) 

estimate70 <- 
    cukeDatatest %>% 
    filter(ObjectWidth < 0.70 * max(ObjectWidth) & rownum > mean(rownum)) %>% 
    by_slice(~tidy(lm(ObjectWidth ~ rownum, data = .))) %>% 
    unnest() %>% 
    filter(term == "rownum") %>% 
    select(File, FruitNum, est70 = estimate) 

estimate75 <- 
    cukeDatatest %>% 
    filter(ObjectWidth < 0.75 * max(ObjectWidth) & rownum > mean(rownum)) %>% 
    by_slice(~tidy(lm(ObjectWidth ~ rownum, data = .))) %>% 
    unnest() %>% 
    filter(term == "rownum") %>% 
    select(File, FruitNum, est75 = estimate) 
estimate80 <- 
    cukeDatatest %>% 
    filter(ObjectWidth < 0.80 * max(ObjectWidth) & rownum > mean(rownum)) %>% 
    by_slice(~tidy(lm(ObjectWidth ~ rownum, data = .))) %>% 
    unnest() %>% 
    filter(term == "rownum") %>% 
    select(File, FruitNum, est80 = estimate) 

    # put everything together 
allEstimates <- 
    full_join(estimate10, estimate15) %>% 
    full_join(., estimate20) %>% 
    full_join(., estimate25) %>% 
    full_join(., estimate30) %>% 
    full_join(., estimate35) %>% 
    full_join(., estimate40) %>% 
    full_join(., estimate45) %>% 
    full_join(., estimate50) %>% 
    full_join(., estimate55) %>% 
    full_join(., estimate60) %>% 
    full_join(., estimate65) %>% 
    full_join(., estimate70) %>% 
    full_join(., estimate75) %>% 
    full_join(., estimate80) 
allEstimates #print it out

источник

2016-05-17 bhive01

Было бы лучше, если бы вы были более ясно, на что именно вы пытаетесь сделать, а не показывая, как вы сделали это. Дайте желаемый результат для ввода образца. – MrFlick

Спасибо за комментарий @MrFlick. Выходной сигнал является желаемым выходом. Я хочу помочь с удалением всех повторений из моего кода. Я уверен, что это можно сделать, я просто не знаю, с чего начать. Я реорганизовал код, чтобы сделать его намного короче и отредактировал описание для ясности. – bhive01

Гораздо короче! Спасибо @NoamRoss через твиттер.

Используя карту, вы поставляете серии вы хотите перебрать seq(10,80, by=2)
Это создает ряд dataframes для каждой итерации
Создайте описание столбца namesafe использовать для имен столбцов позже
Используйте bind_rows(), чтобы собрать все вместе.
Используйте spread(), чтобы сделать каждый уровень PCTwidth столбец
Прибыль ???

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

cukeDataDL <- read.delim("https://gist.githubusercontent.com/bhive01/e7508f552db0415fec1749d0a390c8e5/raw/a12386d43c936c2f73d550dfdaecb8e453d19cfe/widthtest.tsv") 
cukeDatatest <- 
    cukeDataDL %>% 
     select(File, FruitNum, ObjectWidth) %>% 
     # split ObjectWidth into a nested column containing a vector 
     mutate(ObjectWidth = strsplit(as.character(.$ObjectWidth), ',')) %>% 
     # unnest nested column, melting data to long form 
     unnest() %>% 
     # convert data to integer 
     mutate(ObjectWidth = as.integer(ObjectWidth)) %>% # convert data to integer 
     group_by(File, FruitNum) %>% 
     mutate(rownum = row_number()) 
allEstimates <- 
    map(seq(0.10,0.80, by=0.02), function(x) { 
     cukeDatatest %>% 
      filter(ObjectWidth < x * max(ObjectWidth) & rownum > mean(rownum)) %>% 
      by_slice(~tidy(lm(ObjectWidth ~ rownum, data = .))) %>% 
      unnest() %>% 
      filter(term == "rownum") %>% 
      select(File, FruitNum, estimate) %>% 
      mutate(PCTwidth = paste("est", round(x*100), sep="")) 
     } 
    ) %>% 
    bind_rows() %>% 
    spread(., PCTwidth, estimate) 

allEstimates #print everything out

источник

2016-05-17 15:03:57 bhive01

filter dataframe по числовой переменной, lm() и отклонению отложений

ответ

Смежные вопросы