この投稿は2年間で約6000回表示されているので、答えが必要だと思います。参考文献からたくさんのアイデアを借りましたが、いくつか変更を加えました。 base r の cars データを使用します。

  library（tidyverse）

＃外れ値をデータに挿入します。
cars1 <-cars [1:30、]＃元のデータ
cars_outliers <- data.frame（speed = c（1,19）、dist = c（198,199））＃外れ値を導入します。
cars2 <- rbind（cars1、cars_outliers）＃外れ値のあるデータ。
 

外れ値を使用してデータをプロットし、それらがどれほど極端かを確認しましょう。

 ＃外れ値のあるデータのプロット。

plot1 <- ggplot（data = cars1、aes（x = speed、y = dist））+
        geom_point（）+
        geom_smooth（method = lm）+
        xlim（0、20）+ ylim（0、220）+
        ggtitle（ "外れ値なし"）
plot2 <- ggplot（data = cars2、aes（x = speed、y = dist））+
        geom_point（）+
        geom_smooth（method = lm）+
        xlim（0、20）+ ylim（0、220）+
        ggtitle（ "外れ値あり"）

gridExtra :: grid.arrange（plot1、plot2、ncol = 2）
 

外れ値を導入した後、回帰直線の適合度が低いことがわかります。したがって、それらを識別するためにクックの距離を見てみましょう。 $ \ frac {4} {n} $の従来のカットオフを使用しています。 カットオフ値は、データの何が問題になっているのかを考えるのに役立つだけです。

  mod <- lm（dist〜speed、data = cars2）
Cooksd <- Cooks.distance（mod）

＃従来の4 / n基準を使用してクックの距離をプロットします
sample_size <- nrow（cars2）
plot（cooksd、pch = "*"、cex = 2、main = "Influential Obs by Cooks distance"）＃クックの距離をプロット
abline（h = 4 / sample_size、col = "red"）＃カットオフラインを追加
text（x = 1：length（cooksd）+ 1、y = cooksd、labels = ifelse（cooksd>4 / sample_size、names（cooksd）、 ""）、col = "red"）＃ラベルを追加
 

リファレンスに記載されているように、外れ値を処理する方法はたくさんあります。今、私は単にそれらを削除したいだけです。

 ＃外れ値の削除
＃影響力のある行番号
影響力のある<-as.numeric（names（cooksd）[（cooksd >（4 / sample_size））]）

＃または、上位x個の外れ値を削除して確認することもできます
＃top_x_outlier <-2
＃影響力のある<- as.numeric（names（sort（cooksd、減少= TRUE）[1：top_x_outlier]））

cars2_screen <-cars2 [-影響力のある、]

plot3 <- ggplot（data = cars2、aes（x = speed、y = dist））+
        geom_point（）+
        geom_smooth（method = lm）+
        xlim（0、20）+ ylim（0、220）+
        ggtitle（ "Before"）
plot4 <- ggplot（data = cars2_screen、aes（x = speed、y = dist））+
        geom_point（）+
        geom_smooth（method = lm）+
        xlim（0、20）+ ylim（0、220）+
        ggtitle（ "After"）

gridExtra :: grid.arrange（plot3、plot4、ncol = 2）
 

やったー、外れ値を正常に削除しました〜

優れたリファレンス：外れ値の処理