金魚亭日常

読書,ガジェット,競技プログラミング

R で data.frame をグループ分けして fit して プロットする

suppressPackageStartupMessages(library(dplyr))
library(purrr)
library(ggplot2)
library(RColorBrewer)
species <- iris$Species %>% 
            unique() %>% 
            as.character()
fits <- species %>% 
          set_names() %>% 
          map(function(x){
            df <- iris %>% 
              filter(Species == x)
            fit <- lm(Sepal.Length ~ Sepal.Width, data=df)
            fit
          })

fits
#> $setosa
#> 
#> Call:
#> lm(formula = Sepal.Length ~ Sepal.Width, data = df)
#> 
#> Coefficients:
#> (Intercept)  Sepal.Width  
#>      2.6390       0.6905  
#> 
#> 
#> $versicolor
#> 
#> Call:
#> lm(formula = Sepal.Length ~ Sepal.Width, data = df)
#> 
#> Coefficients:
#> (Intercept)  Sepal.Width  
#>      3.5397       0.8651  
#> 
#> 
#> $virginica
#> 
#> Call:
#> lm(formula = Sepal.Length ~ Sepal.Width, data = df)
#> 
#> Coefficients:
#> (Intercept)  Sepal.Width  
#>      3.9068       0.9015

my_palette <- setNames(brewer.pal(3, "Set1"), species)
iris %>% 
  ggplot(aes(x=Sepal.Width, y=Sepal.Length, group=Species, colour=Species)) +
    geom_point() + 
    scale_color_manual(values = my_palette) +
    stat_function(data=data.frame(x=c(1, 5)), 
                  mapping=aes(x, colour=species[1]), 
                  fun=function(x, fit){
                    predict(fit, newdata=data.frame(Sepal.Width=x)
                  )}, 
                  args=list(fit=fits$setosa), 
                  geom="line", 
                  inherit.aes = FALSE) + 
    stat_function(data=data.frame(x=c(1, 5)), 
                  mapping=aes(x, colour=species[2]), 
                  fun=function(x, fit){
                    predict(fit, newdata=data.frame(Sepal.Width=x)
                  )}, 
                  args=list(fit=fits$versicolor), 
                  geom="line", 
                  inherit.aes = FALSE) + 
    stat_function(data=data.frame(x=c(1, 5)), 
                  mapping=aes(x, colour=species[3]), 
                  fun=function(x, fit){
                    predict(fit, newdata=data.frame(Sepal.Width=x)
                  )}, 
                  args=list(fit=fits$virginica), 
                  geom="line", inherit.aes = FALSE)