Filter Datenfeld durch numerische Variable, lm(), und extrahieren Steigung

Question

Ich möchte verschiedene Ebenen eines numerischen Filters (z. B. seq(10,80, by=2)) anwenden und dann diese in einem einzigen Datenfeld zum Vergleich gegen eine andere Variable zurückstecken. Momentan kann ich das tun, aber ich hoffe, dass es einen besseren Weg gibt, da ich einfach Code kopiere und wieder einfüge und dann alles wieder hinzufüge. Das Endergebnis, das ich möchte, ist, was ich habe, jeder Filterschritt als eigene Spalte mit dem Steigungsparameter von lm() extrahiert.

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>. 

verwende ich derzeit eine NSE-Pipeline in der hadleyverse und würde es gerne, aber ich bin glücklich Basis, um zu sehen, data.table oder andere Implementierungen. Ich habe purrr angeschaut, aber ich bin mir nicht sicher, wie man den Filter auf eine Variable inline abbildet.

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 

Answer 1

Viel kürzer! Danke @NoamRoss über Twitter.

1. Mit Karte, stellen Sie die Reihe, die Sie iterieren wollen über seq(10,80, by=2)
2. Es hat eine Reihe von Datenrahmen für jede Iteration erzeugt
3. eine namesafe Spalte Beschreibung erstellen für Spaltennamen verwenden später
4. Verwendung bind_rows() um alles zusammen zu bringen
5. Verwenden Sie spread(), um jede Ebene der PCTwidth eine Spalte
6. Profit ???

``

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