如何寫一個函數來移動每個Facet的迴歸線？

Question

fit<-lm(log(all$fd) ~ log(all$area)) 
fintercept<-fit$coefficients[[1]] #intercept 
fslope<-fit$coefficients[[2]] #slope 
interceptmax<-max(log(all$fd)-fslope*log(all$area)) 

ggplot(all, aes(x=log(area), y=log(fd))) + 
    geom_point()+ 
    geom_abline(aes(intercept=interceptmax,slope=fslope))+ #shifted regression line 
    #facet_wrap(~id)+ 
    theme_bw()+ 
    theme(panel.grid.major = element_line(colour = "#808080"))+ 
    ggsave('test.png',width=6, height=4,dpi=300) 

這ggplot2給我一個包絡曲線（移位迴歸線）。如果我刪除facet_wrap（〜id），它會按預期工作。但我希望分別爲每個方面計算線條。任何建議如何我可以在每個方面做到這一點？ （以類似如何使用GGPLOT2作品裏面「流明」）的「所有」是

這裏集：

structure(list(fd = c(11, 7.75, 55.25, 45.25, 9.5, 89, 14.5, 
8, 84.25, 5.25, 79.5, 7.75, 71, 38.5, 242.25, 33, 32, 19, 58.5, 
249.25, 19, 72.5, 6.25, 27.0333333333333, 26.5, 81, 30, 29, 39.75, 
18.5, 64.25, 91, 4.5, 30.5, 74, 256.75, 9, 81, 27, 7.5, 107, 
26.75, 47.25, 16, 57, 37, 48.25, 48, 36, 147.25, 23.5, 42, 1.08333333333333, 
21.5, 6.51666666666667, 198, 47.5, 8.75, 16, 43.5, 34.75, 30.25, 
132.25, 2.25, 12.5, 225, 37, 17.25, 63.5, 48, 19.75, 12, 62.5, 
64, 27, 11, 72.25, 246, 27.75, 15.5, 178, 93.75, 3.75, 3, 46.25, 
4, 6.25, 5.25, 20, 44, 44.5, 1, 33, 18.25, 14.5, 29.25, 9, 33, 
133, 67), area = c(20168.2374, 432.528, 5780.8535, 1411.5435, 
543.8975, 660.447, 24995.9752, 543.8975, 2659.9178, 277.1287, 
147.8883, 153.0683, 2217.0298, 1188.8045, 4237.2205, 489.5078, 
1051.5352, 1362.3337, 1401.1836, 169.3852, 1333.8439, 1051.5352, 
29.5259, 1429.6734, 668.2169, 17068.0216, 660.447, 16860.8226, 
116.5495, 3820.2325, 784.7664, 841.7461, 1696.4422, 85.9876, 
2066.8105, 2090.1204, 121.7294, 9999.9441, 127.4274, 1152.5447, 
934.9857, 1424.4935, 1774.1419, 543.8975, 784.7664, 237.5019, 
3486.124, 1080.025, 6164.1717, 3348.8546, 236.2069, 510.2277, 
31.5979, 916.8558, 1994.2908, 3501.6639, 1152.5447, 486.9178, 
533.5376, 271.9488, 336.6985, 1103.3349, 9764.2552, 36.7778, 
2375.0191, 512.8176, 422.1681, 859.8761, 1118.8749, 237.5019, 
133.6434, 453.2479, 1787.0918, 6063.1622, 237.5019, 1383.0537, 
668.2169, 1424.4935, 621.5971, 1486.6532, 7355.5662, 984.1955, 
68.8937, 154.6223, 116.5495, 1665.3624, 43.5118, 450.6579, 510.2277, 
1494.4231, 404.0381, 598.2873, 339.2884, 12406.043, 274.5387, 
151.2553, 753.6865, 29059.6666, 3470.5841, 1885.5113), id = structure(c(3L, 
2L, 2L, 4L, 4L, 3L, 4L, 4L, 4L, 4L, 4L, 4L, 3L, 4L, 3L, 3L, 3L, 
4L, 3L, 1L, 3L, 4L, 4L, 4L, 4L, 4L, 3L, 3L, 4L, 4L, 3L, 4L, 4L, 
3L, 4L, 4L, 4L, 4L, 4L, 3L, 3L, 4L, 2L, 4L, 3L, 4L, 4L, 3L, 4L, 
3L, 4L, 4L, 4L, 3L, 4L, 3L, 3L, 4L, 3L, 4L, 4L, 3L, 4L, 4L, 4L, 
4L, 4L, 2L, 3L, 4L, 2L, 3L, 4L, 4L, 4L, 4L, 4L, 3L, 4L, 3L, 2L, 
1L, 4L, 2L, 4L, 2L, 4L, 2L, 4L, 4L, 4L, 4L, 3L, 4L, 4L, 3L, 4L, 
2L, 2L, 4L), .Label = c("Csb", "Dfb(E)", "Dfa", "Cfa"), class = "factor")), .Names = c("fd", 
"area", "id"), row.names = c("65775", "61848", "11286", "22467", 
"34601", "53841", "14661", "8941", "88607", "47681", "7898", 
"9598", "40615", "35550", "70985", "64634", "43864", "88065", 
"37520", "100794", "74916", "76759", "48928", "17575", "7424", 
"30848", "53970", "65662", "27392", "82248", "48004", "93560", 
"51147", "42321", "30070", "22096", "25575", "49067", "23702", 
"65877", "53617", "90727", "59449", "34568", "48155", "96101", 
"31358", "40150", "75458", "71566", "1687", "86603", "77451", 
"68075", "14478", "69151", "66028", "77394", "68580", "16328", 
"26945", "73615", "24179", "19497", "82448", "25098", "23565", 
"8113", "66312", "96062", "60313", "34767", "97877", "48598", 
"96135", "36877", "7309", "71065", "49622", "65051", "55340", 
"105109", "26480", "4550", "18935", "61714", "31667", "55035", 
"27563", "17332", "35694", "20092", "44334", "21344", "22303", 
"64816", "12814", "12391", "52770", "84979"), class = "data.frame") 

後續行動：How can I shift the regression line?

Answer 1

爲了讓每方面不同的線路，您可以分別爲每個ID計算斜率和期望截距。簡單地創建一個所需值的新數據集並在geom_abline中使用它通常是最簡單的。這個新的數據集需要包含一個id列以及要繪製的值，以便您可以從每個方面獲取單獨的信息。

有很多方法可以創建此數據集，包括逐個擬合迴歸和「手動」收集值。我將使用包dplyr中的函數來計算每id的迴歸，保存斜率，並使用您的公式計算新的截距。

library(dplyr) 

    all2 = all %>% 
     group_by(id) %>% 
     do({model = lm(log(fd) ~ log(area), data = .) 
     data.frame(fslope = coef(model)[2], interceptmax = max(log(.$fd) - coef(model)[2]*log(.$area))) 
     }) 
    all2 

Source: local data frame [4 x 3] 
Groups: id [4] 

     id  fslope interceptmax 
    (fctr)  (dbl)  (dbl) 
1 Csb -0.5556930 8.3703705 
2 Dfb(E) 0.5378457 0.5057893 
3 Dfa 0.1227013 4.6143276 
4 Cfa 0.3247770 3.3895178 

現在使用geom_abline中的新數據集。

ggplot(all, aes(x=log(area), y=log(fd))) + 
    geom_point() + 
    geom_abline(data = all2, aes(intercept=interceptmax, slope=fslope)) + #shifted regression line 
    facet_wrap(~id) + 
    theme_bw() + 
    theme(panel.grid.major = element_line(colour = "#808080")) 

結果圖對每個方面都有不同的線條。