เพิ่มสมการเส้นถดถอยและ R ^ 2 บนกราฟ


227

ฉันสงสัยว่าจะเพิ่มเส้นสมการถดถอยและ R ^ 2 ggplotบน รหัสของฉันคือ:

library(ggplot2)

df <- data.frame(x = c(1:100))
df$y <- 2 + 3 * df$x + rnorm(100, sd = 40)
p <- ggplot(data = df, aes(x = x, y = y)) +
            geom_smooth(method = "lm", se=FALSE, color="black", formula = y ~ x) +
            geom_point()
p

ความช่วยเหลือใด ๆ จะได้รับการชื่นชมอย่างมาก


1
สำหรับตาข่ายlatticeExtra::lmlineq()กราฟิกให้ดู
Josh O'Brien

คำตอบ:


234

นี่คือทางออกหนึ่ง

# GET EQUATION AND R-SQUARED AS STRING
# SOURCE: https://groups.google.com/forum/#!topic/ggplot2/1TgH-kG5XMA

lm_eqn <- function(df){
    m <- lm(y ~ x, df);
    eq <- substitute(italic(y) == a + b %.% italic(x)*","~~italic(r)^2~"="~r2, 
         list(a = format(unname(coef(m)[1]), digits = 2),
              b = format(unname(coef(m)[2]), digits = 2),
             r2 = format(summary(m)$r.squared, digits = 3)))
    as.character(as.expression(eq));
}

p1 <- p + geom_text(x = 25, y = 300, label = lm_eqn(df), parse = TRUE)

แก้ไข ฉันหาแหล่งที่มาจากที่ที่ฉันเลือกรหัสนี้ นี่คือลิงค์ไปยังโพสต์ต้นฉบับในกลุ่ม ggplot2 google

เอาท์พุต


1
@ ความคิดเห็นของ JonasRaedle เกี่ยวกับการทำให้ข้อความที่ดูดีขึ้นannotateนั้นถูกต้องในเครื่องของฉัน
IRTFM

2
สิ่งนี้ดูไม่เหมือนเอาท์พุทที่โพสต์บนเครื่องของฉันที่ฉลากถูกเขียนทับหลาย ๆ ครั้งตามที่ข้อมูลถูกเรียกใช้ทำให้ข้อความฉลากหนาและพร่ามัว ส่งต่อฉลากไปยัง data.frame ก่อนใช้งาน (ดูคำแนะนำของฉันในความคิดเห็นด้านล่าง
PatrickT

@PatrickT: ลบและสอดคล้องกันaes( ใช้สำหรับการแมปตัวแปรดาต้าเฟรมไฟล์กับตัวแปรภาพซึ่งไม่จำเป็นต้องใช้ที่นี่เนื่องจากมีเพียงอินสแตนซ์เดียวดังนั้นคุณจึงสามารถวางทั้งหมดไว้ในการโทรหลักได้ ฉันจะแก้ไขสิ่งนี้ในคำตอบ )aesgeom_text
naught101

ปัญหาเกี่ยวกับการแก้ปัญหานี้ดูเหมือนว่าถ้าชุดข้อมูลมีขนาดใหญ่ขึ้น (การสังเกต 370000 ของฉัน) ฟังก์ชั่นดูเหมือนจะล้มเหลว ฉันอยากจะแนะนำวิธีแก้ปัญหาจาก @kdauria ซึ่งทำเช่นเดียวกัน แต่เร็วกว่ามาก
เบนจามิน

3
สำหรับผู้ที่ต้องการค่า r และ p แทน R2 และสมการ: eq <- ตัวแทน (ตัวเอียง (r) ~ "=" ~ rvalue * "," ~ ตัวเอียง (p) ~ "=" ~ pvalue รายการ (rvalue = sprintf ("% .2f", เครื่องหมาย (coef (m) [2]) * sqrt (สรุป (m) $ r.squared)), pvalue = รูปแบบ (สรุป (m) สัมประสิทธิ์ $ [2,4], หลัก = 2 )))
Jerry T

135

ฉันรวมสถิติstat_poly_eq()ในแพ็คเกจggpmiscที่อนุญาตคำตอบนี้:

library(ggplot2)
library(ggpmisc)
df <- data.frame(x = c(1:100))
df$y <- 2 + 3 * df$x + rnorm(100, sd = 40)
my.formula <- y ~ x
p <- ggplot(data = df, aes(x = x, y = y)) +
   geom_smooth(method = "lm", se=FALSE, color="black", formula = my.formula) +
   stat_poly_eq(formula = my.formula, 
                aes(label = paste(..eq.label.., ..rr.label.., sep = "~~~")), 
                parse = TRUE) +         
   geom_point()
p

ป้อนคำอธิบายรูปภาพที่นี่

สถิตินี้ใช้ได้กับพหุนามใด ๆ โดยไม่มีเงื่อนไขหายไปและหวังว่าจะมีความยืดหยุ่นเพียงพอที่จะเป็นประโยชน์โดยทั่วไป ฉลาก R ^ 2 หรือปรับ R ^ 2 สามารถใช้กับสูตรรุ่นใดก็ได้ที่ติดตั้ง lm () เป็นสถิติ ggplot มันทำงานตามที่คาดไว้ทั้งกับกลุ่มและแง่มุม

แพ็คเกจ 'ggpmisc' มีให้บริการผ่าน CRAN

เวอร์ชัน 0.2.6 เพิ่งได้รับการยอมรับจาก CRAN

มันแสดงความคิดเห็นโดย @shabbychef และ @ MYaseen208

@ MYaseen208 นี้แสดงให้เห็นวิธีการเพิ่มหมวก

library(ggplot2)
library(ggpmisc)
df <- data.frame(x = c(1:100))
df$y <- 2 + 3 * df$x + rnorm(100, sd = 40)
my.formula <- y ~ x
p <- ggplot(data = df, aes(x = x, y = y)) +
   geom_smooth(method = "lm", se=FALSE, color="black", formula = my.formula) +
   stat_poly_eq(formula = my.formula,
                eq.with.lhs = "italic(hat(y))~`=`~",
                aes(label = paste(..eq.label.., ..rr.label.., sep = "~~~")), 
                parse = TRUE) +         
   geom_point()
p

ป้อนคำอธิบายรูปภาพที่นี่

@shabbychef ตอนนี้มันเป็นไปได้ที่จะจับคู่ตัวแปรในสมการกับที่ใช้สำหรับป้ายชื่อแกน หากต้องการแทนที่xด้วย say zและyด้วยhจะใช้:

p <- ggplot(data = df, aes(x = x, y = y)) +
   geom_smooth(method = "lm", se=FALSE, color="black", formula = my.formula) +
   stat_poly_eq(formula = my.formula,
                eq.with.lhs = "italic(h)~`=`~",
                eq.x.rhs = "~italic(z)",
                aes(label = ..eq.label..), 
                parse = TRUE) + 
   labs(x = expression(italic(z)), y = expression(italic(h))) +          
   geom_point()
p

ป้อนคำอธิบายรูปภาพที่นี่

การเป็นตัวอักษรกรีกทั่วไปในการแยกวิเคราะห์อาร์สามารถใช้ทั้งใน lhs และ rhs ของสมการได้

[2017-03-08] @elarry แก้ไขเพื่อตอบคำถามเดิมอย่างแม่นยำยิ่งขึ้นโดยแสดงวิธีการเพิ่มเครื่องหมายจุลภาคระหว่างสมการและป้ายกำกับ R2

p <- ggplot(data = df, aes(x = x, y = y)) +
  geom_smooth(method = "lm", se=FALSE, color="black", formula = my.formula) +
  stat_poly_eq(formula = my.formula,
               eq.with.lhs = "italic(hat(y))~`=`~",
               aes(label = paste(..eq.label.., ..rr.label.., sep = "*plain(\",\")~")), 
               parse = TRUE) +         
  geom_point()
p

ป้อนคำอธิบายรูปภาพที่นี่

[2019-10-20] @ helen.h ฉันให้ตัวอย่างด้านล่างของการใช้stat_poly_eq()กับการจัดกลุ่ม

library(ggpmisc)
df <- data.frame(x = c(1:100))
df$y <- 20 * c(0, 1) + 3 * df$x + rnorm(100, sd = 40)
df$group <- factor(rep(c("A", "B"), 50))
my.formula <- y ~ x
p <- ggplot(data = df, aes(x = x, y = y, colour = group)) +
  geom_smooth(method = "lm", se=FALSE, formula = my.formula) +
  stat_poly_eq(formula = my.formula, 
               aes(label = paste(..eq.label.., ..rr.label.., sep = "~~~")), 
               parse = TRUE) +         
  geom_point()
p

p <- ggplot(data = df, aes(x = x, y = y, linetype = group)) +
  geom_smooth(method = "lm", se=FALSE, formula = my.formula) +
  stat_poly_eq(formula = my.formula, 
               aes(label = paste(..eq.label.., ..rr.label.., sep = "~~~")), 
               parse = TRUE) +         
  geom_point()
p

ป้อนคำอธิบายรูปภาพที่นี่

ป้อนคำอธิบายรูปภาพที่นี่

[2020-01-21] @Herman มันอาจจะเป็นเคาน์เตอร์ที่เข้าใจง่ายตั้งแต่แรกเห็น แต่เพื่อให้ได้สมการเดียวเมื่อใช้การจัดกลุ่มหนึ่งจำเป็นต้องทำตามไวยากรณ์ของกราฟิก จำกัด การแมปที่สร้างการจัดกลุ่มให้กับแต่ละเลเยอร์ (แสดงด้านล่าง) หรือเก็บการแมปเริ่มต้นและแทนที่ด้วยค่าคงที่ในเลเยอร์ที่คุณไม่ต้องการจัดกลุ่ม (เช่นcolour = "black" )

ดำเนินการต่อจากตัวอย่างก่อนหน้า

p <- ggplot(data = df, aes(x = x, y = y)) +
  geom_smooth(method = "lm", se=FALSE, formula = my.formula) +
  stat_poly_eq(formula = my.formula, 
               aes(label = paste(..eq.label.., ..rr.label.., sep = "~~~")), 
               parse = TRUE) +         
  geom_point(aes(colour = group))
p

ป้อนคำอธิบายรูปภาพที่นี่

[2020-01-22] เพื่อเป็นตัวอย่างที่สมบูรณ์แบบด้วย facets แสดงให้เห็นว่าในกรณีนี้ความคาดหวังของไวยากรณ์ของกราฟิกจะเกิดขึ้นจริง

library(ggpmisc)
df <- data.frame(x = c(1:100))
df$y <- 20 * c(0, 1) + 3 * df$x + rnorm(100, sd = 40)
df$group <- factor(rep(c("A", "B"), 50))
my.formula <- y ~ x

p <- ggplot(data = df, aes(x = x, y = y)) +
  geom_smooth(method = "lm", se=FALSE, formula = my.formula) +
  stat_poly_eq(formula = my.formula, 
               aes(label = paste(..eq.label.., ..rr.label.., sep = "~~~")), 
               parse = TRUE) +         
  geom_point() +
  facet_wrap(~group)
p

ป้อนคำอธิบายรูปภาพที่นี่


1
ควรสังเกตว่าxและyในสูตรอ้างอิงถึงxและyข้อมูลในเลเยอร์ของพล็อตและไม่จำเป็นต้องอยู่ในขอบเขตในเวลาmy.formulaนั้น ดังนั้นสูตรควรใช้ตัวแปร x และ y เสมอหรือไม่
shabbychef

มันเป็นความจริงอย่างยิ่งที่xและyอ้างถึงตัวแปรใดก็ตามที่ถูกแมปกับสุนทรียภาพเหล่านี้ นั่นคือความคาดหวังสำหรับ geom_smooth () และไวยากรณ์ของกราฟิก มันชัดเจนกว่าที่จะใช้ชื่อต่าง ๆ ภายใน data frame แต่ฉันเพิ่งเก็บไว้เหมือนในคำถามเดิม
Pedro Aphalo

ggpmiscจะเป็นไปได้ในรุ่นถัดไปของ ขอบคุณสำหรับคำแนะนำ!
Pedro Aphalo

3
จุดดี @elarry! สิ่งนี้เกี่ยวข้องกับการทำงานของการแยกวิเคราะห์ R) จากการทดลองและข้อผิดพลาดฉันพบว่าaes(label = paste(..eq.label.., ..rr.label.., sep = "*plain(\",\")~"))ทำงานได้
Pedro Aphalo

1
@HermanToothrot ปกติ R2 เป็นที่ต้องการสำหรับการถดถอยดังนั้นไม่มี r.label stat_poly_eq()ที่กำหนดไว้ล่วงหน้าในข้อมูลที่ส่งกลับโดย คุณสามารถใช้stat_fit_glance()จากแพ็คเกจ 'ggpmisc' ซึ่งส่งคืน R2 เป็นค่าตัวเลข ดูตัวอย่างในหน้าความช่วยเหลือและแทนที่โดยstat(r.squared) sqrt(stat(r.squared))
Pedro Aphalo

99

ฉันเปลี่ยนไม่กี่บรรทัดของซอร์สstat_smoothและฟังก์ชันที่เกี่ยวข้องเพื่อสร้างฟังก์ชันใหม่ที่เพิ่มสมการพอดีและค่า R กำลังสอง นี้จะทำงานบนแปลง facet เกินไป!

library(devtools)
source_gist("524eade46135f6348140")
df = data.frame(x = c(1:100))
df$y = 2 + 5 * df$x + rnorm(100, sd = 40)
df$class = rep(1:2,50)
ggplot(data = df, aes(x = x, y = y, label=y)) +
  stat_smooth_func(geom="text",method="lm",hjust=0,parse=TRUE) +
  geom_smooth(method="lm",se=FALSE) +
  geom_point() + facet_wrap(~class)

ป้อนคำอธิบายรูปภาพที่นี่

ฉันใช้รหัสในคำตอบของ @ Ramnath เพื่อจัดรูปแบบสมการ stat_smooth_funcฟังก์ชั่นไม่แข็งแกร่งมาก แต่ก็ไม่ควรจะยากที่จะเล่นรอบกับมัน

https://gist.github.com/kdauria/524eade46135f6348140 ลองอัปเดตggplot2หากคุณได้รับข้อผิดพลาด


2
ขอบคุณมาก. อันนี้ไม่เพียงทำงานได้สำหรับ facets แต่สำหรับกลุ่ม ฉันคิดว่ามันมีประโยชน์มากสำหรับการถดถอยแบบชิ้นเดียวเช่นstat_smooth_func(mapping=aes(group=cut(x.val,c(-70,-20,0,20,50,130))),geom="text",method="lm",hjust=0,parse=TRUE)ใช้ร่วมกับ EvaluateSmooths จากstackoverflow.com/questions/19735149/…
Julian

1
@aelwan เปลี่ยนบรรทัดเหล่านี้: gist.github.com/kdauria/…ตามที่คุณต้องการ จากนั้นsourceไฟล์ทั้งหมดในสคริปต์ของคุณ
kdauria

1
@kdauria จะเกิดอะไรขึ้นถ้าฉันมีสมการหลายอย่างในแต่ละ facet_wraps และฉันมี y_ ค่าที่แตกต่างกันในแต่ละ facet_wrap ข้อเสนอแนะวิธีการแก้ไขตำแหน่งของสมการหรือไม่ ฉันลองตัวเลือก hjust, vjust และ angle หลายอย่างโดยใช้ตัวอย่างนี้dropbox.com/s/9lk9lug2nwgno2l/R2_facet_wrap.docx?dl=0แต่ฉันไม่สามารถนำสมการทั้งหมดมาอยู่ในระดับเดียวกันในแต่ละ facet_wrap
มันเงา

3
@aelwan ตำแหน่งของสมการจะถูกกำหนดโดยเส้นเหล่านี้: gist.github.com/kdauria/... ฉันทำxposและyposข้อโต้แย้งของฟังก์ชั่นในส่วนสำคัญ ดังนั้นถ้าคุณอยากสมการทั้งหมดที่จะซ้อนทับกันเพียงแค่ตั้งค่าและxpos yposมิฉะนั้นxposและyposจะถูกคำนวณจากข้อมูล หากคุณต้องการสิ่งที่นักเล่นไม่ควรที่จะเพิ่มตรรกะในฟังก์ชั่น ตัวอย่างเช่นคุณอาจเขียนฟังก์ชั่นเพื่อกำหนดว่าส่วนใดของกราฟมีพื้นที่ว่างมากที่สุดและวางฟังก์ชันไว้ที่นั่น
kdauria

6
ฉันพบข้อผิดพลาดกับ source_gist: ข้อผิดพลาดใน r_files [[ที่]]: ประเภทห้อยไม่ถูกต้อง 'ปิด' ดูโพสต์นี้สำหรับการแก้ปัญหา: stackoverflow.com/questions/38345894/r-source-gist-not-working
Matifou

73

ฉันได้แก้ไขโพสต์ของ Ramnath ไปที่ a) สร้างสามัญมากขึ้นดังนั้นจึงยอมรับโมเดลเชิงเส้นเป็นพารามิเตอร์แทนที่จะเป็น data frame และ b) แสดงรายการเชิงลบอย่างเหมาะสมยิ่งขึ้น

lm_eqn = function(m) {

  l <- list(a = format(coef(m)[1], digits = 2),
      b = format(abs(coef(m)[2]), digits = 2),
      r2 = format(summary(m)$r.squared, digits = 3));

  if (coef(m)[2] >= 0)  {
    eq <- substitute(italic(y) == a + b %.% italic(x)*","~~italic(r)^2~"="~r2,l)
  } else {
    eq <- substitute(italic(y) == a - b %.% italic(x)*","~~italic(r)^2~"="~r2,l)    
  }

  as.character(as.expression(eq));                 
}

การใช้งานจะเปลี่ยนเป็น:

p1 = p + geom_text(aes(x = 25, y = 300, label = lm_eqn(lm(y ~ x, df))), parse = TRUE)

17
มันดูดีมาก! แต่ฉันกำลังวางแผน geom_points บนหลาย facets โดยที่ df นั้นแตกต่างกันไปตามตัวแปร facet ฉันจะทำอย่างไร
bshor

24
วิธีการแก้ปัญหาของ Jayden ทำงานได้ค่อนข้างดี แต่รูปแบบตัวพิมพ์ดูน่าเกลียดมาก ฉันขอแนะนำให้เปลี่ยนการใช้งานเป็น: p1 = p + annotate("text", x = 25, y = 300, label = lm_eqn(lm(y ~ x, df)), colour="black", size = 5, parse=TRUE)แก้ไข: สิ่งนี้จะแก้ไขปัญหาใด ๆ ที่คุณอาจมีด้วยตัวอักษรที่ปรากฏในตำนานของคุณ
Jonas Raedle

1
@ "cannot coerce class "lm" to a data.frame"โจนัสด้วยเหตุผลบางอย่างที่ฉันได้รับ ทางเลือกนี้ใช้งานได้: df.labs <- data.frame(x = 25, y = 300, label = lm_eqn(df))และ p <- p + geom_text(data = df.labs, aes(x = x, y = y, label = label), parse = TRUE)
PatrickT

1
@PatrickT - นั่นเป็นข้อผิดพลาดที่คุณจะได้รับหากคุณโทรหาlm_eqn(lm(...))ด้วยโซลูชันของ Ramnath คุณอาจจะพยายามหนึ่งนี้หลังจากที่พยายามที่หนึ่ง แต่ลืมที่จะให้แน่ใจว่าคุณได้นิยามใหม่lm_eqn
Hamy

@PatrickT: คุณช่วยแยกคำตอบออกเป็นคำตอบได้ไหม? ฉันยินดีที่จะให้คะแนน!
JelenaČuklina

11

รักโซลูชั่น @Ramnath จริงๆ ในการอนุญาตให้ใช้ในการปรับแต่งสูตรการถดถอย (แทนที่จะกำหนดเป็น y และ x เป็นชื่อตัวแปรตามตัวอักษร) และเพิ่มค่า p-value ในงานพิมพ์ด้วย (เช่น @Jerry T แสดงความคิดเห็น) นี่คือ mod:

lm_eqn <- function(df, y, x){
    formula = as.formula(sprintf('%s ~ %s', y, x))
    m <- lm(formula, data=df);
    # formating the values into a summary string to print out
    # ~ give some space, but equal size and comma need to be quoted
    eq <- substitute(italic(target) == a + b %.% italic(input)*","~~italic(r)^2~"="~r2*","~~p~"="~italic(pvalue), 
         list(target = y,
              input = x,
              a = format(as.vector(coef(m)[1]), digits = 2), 
              b = format(as.vector(coef(m)[2]), digits = 2), 
             r2 = format(summary(m)$r.squared, digits = 3),
             # getting the pvalue is painful
             pvalue = format(summary(m)$coefficients[2,'Pr(>|t|)'], digits=1)
            )
          )
    as.character(as.expression(eq));                 
}

geom_point() +
  ggrepel::geom_text_repel(label=rownames(mtcars)) +
  geom_text(x=3,y=300,label=lm_eqn(mtcars, 'hp','wt'),color='red',parse=T) +
  geom_smooth(method='lm')

ป้อนคำอธิบายรูปภาพที่นี่ ขออภัยนี่ใช้ไม่ได้กับ facet_wrap หรือ facet_grid


เรียบร้อยมากผมได้อ้างอิงที่นี่ คำชี้แจง - รหัสของคุณหายไปggplot(mtcars, aes(x = wt, y = mpg, group=cyl))+ก่อน geom_point () หรือไม่? คำถามกึ่งที่เกี่ยวข้อง - ถ้าเราอ้างถึงhpและwtในคำว่าaes()ggplot เราสามารถจับพวกมันไว้ใช้ในการเรียกlm_eqnดังนั้นเราจึงต้องเขียนโค้ดในที่เดียวเท่านั้น? ฉันรู้ว่าเราสามารถตั้งค่าxvar = "hp"ก่อนการเรียก ggplot () และใช้ xvar ในทั้งสองสถานที่เพื่อแทนที่hpแต่สิ่งนี้รู้สึกว่ามันไม่จำเป็น
Mark Neal

9

ใช้ggpubr :

library(ggpubr)

# reproducible data
set.seed(1)
df <- data.frame(x = c(1:100))
df$y <- 2 + 3 * df$x + rnorm(100, sd = 40)

# By default showing Pearson R
ggscatter(df, x = "x", y = "y", add = "reg.line") +
  stat_cor(label.y = 300) +
  stat_regline_equation(label.y = 280)

ป้อนคำอธิบายรูปภาพที่นี่

# Use R2 instead of R
ggscatter(df, x = "x", y = "y", add = "reg.line") +
  stat_cor(label.y = 300, 
           aes(label = paste(..rr.label.., ..p.label.., sep = "~`,`~"))) +
  stat_regline_equation(label.y = 280)

## compare R2 with accepted answer
# m <- lm(y ~ x, df)
# round(summary(m)$r.squared, 2)
# [1] 0.85

ป้อนคำอธิบายรูปภาพที่นี่


คุณเคยเห็นวิธีการเขียนโปรแกรมที่เป็นระเบียบเรียบร้อยเพื่อระบุจำนวนlabel.yหรือไม่?
Mark Neal

@ MarkNeal อาจได้ค่า y สูงสุดแล้วคูณด้วย 0.8 label.y = max(df$y) * 0.8
zx8754

1
@ MarkNeal คะแนนที่ดีอาจส่งปัญหาตามคำขอคุณลักษณะที่ GitHub ggpubr
zx8754

1
ปัญหาเกี่ยวกับตำแหน่งอัตโนมัติที่ส่งมาที่นี่
Mark Neal

1
@ zx8754 ในพล็อตของคุณจะแสดง rho ไม่ใช่R²วิธีง่ายๆในการแสดงR²?
matmar

5

นี่คือรหัสที่ง่ายที่สุดสำหรับทุกคน

หมายเหตุ: แสดง Rho ของ Pearson ไม่ใช่ R ^ 2

library(ggplot2)
library(ggpubr)

df <- data.frame(x = c(1:100)
df$y <- 2 + 3 * df$x + rnorm(100, sd = 40)
p <- ggplot(data = df, aes(x = x, y = y)) +
        geom_smooth(method = "lm", se=FALSE, color="black", formula = y ~ x) +
        geom_point()+
        stat_cor(label.y = 35)+ #this means at 35th unit in the y axis, the r squared and p value will be shown
        stat_regline_equation(label.y = 30) #this means at 30th unit regresion line equation will be shown

p

ตัวอย่างหนึ่งที่มีชุดข้อมูลของฉันเอง


ปัญหาเช่นเดียวกับข้างต้นในพล็อตของคุณจะปรากฏ rho และไม่R²!
matmar

3

แรงบันดาลใจจากรูปแบบสมการที่ให้ไว้ในคำตอบนี้วิธีการทั่วไปมากขึ้น (มากกว่าหนึ่งตัวทำนาย + น้ำยางเป็นตัวเลือก) สามารถ:

print_equation= function(model, latex= FALSE, ...){
    dots <- list(...)
    cc= model$coefficients
    var_sign= as.character(sign(cc[-1]))%>%gsub("1","",.)%>%gsub("-"," - ",.)
    var_sign[var_sign==""]= ' + '

    f_args_abs= f_args= dots
    f_args$x= cc
    f_args_abs$x= abs(cc)
    cc_= do.call(format, args= f_args)
    cc_abs= do.call(format, args= f_args_abs)
    pred_vars=
        cc_abs%>%
        paste(., x_vars, sep= star)%>%
        paste(var_sign,.)%>%paste(., collapse= "")

    if(latex){
        star= " \\cdot "
        y_var= strsplit(as.character(model$call$formula), "~")[[2]]%>%
            paste0("\\hat{",.,"_{i}}")
        x_vars= names(cc_)[-1]%>%paste0(.,"_{i}")
    }else{
        star= " * "
        y_var= strsplit(as.character(model$call$formula), "~")[[2]]        
        x_vars= names(cc_)[-1]
    }

    equ= paste(y_var,"=",cc_[1],pred_vars)
    if(latex){
        equ= paste0(equ," + \\hat{\\varepsilon_{i}} \\quad where \\quad \\varepsilon \\sim \\mathcal{N}(0,",
                    summary(MetamodelKdifEryth)$sigma,")")%>%paste0("$",.,"$")
    }
    cat(equ)
}

modelโต้แย้งคาดว่าlmวัตถุที่latexอาร์กิวเมนต์เป็นบูลที่จะขอตัวละครง่ายหรือสมการน้ำยางรูปแบบหนึ่งและ...อาร์กิวเมนต์ส่งผ่านค่าให้กับformatฟังก์ชั่น

ฉันยังเพิ่มตัวเลือกในการแสดงผลเป็นลาเท็กซ์เพื่อให้คุณสามารถใช้ฟังก์ชั่นนี้ใน rmarkdown ดังนี้:


```{r echo=FALSE, results='asis'}
print_equation(model = lm_mod, latex = TRUE)
```

ตอนนี้ใช้มัน:

df <- data.frame(x = c(1:100))
df$y <- 2 + 3 * df$x + rnorm(100, sd = 40)
df$z <- 8 + 3 * df$x + rnorm(100, sd = 40)
lm_mod= lm(y~x+z, data = df)

print_equation(model = lm_mod, latex = FALSE)

รหัสนี้ให้ผล: y = 11.3382963933174 + 2.5893419 * x + 0.1002227 * z

และถ้าเราถามสมการลาเท็กซ์ให้ปัดเศษพารามิเตอร์เป็น 3 หลัก:

print_equation(model = lm_mod, latex = TRUE, digits= 3)

อัตราผลตอบแทนนี้: สมการน้ำยาง


0

ฉันมีข้อสงสัยว่าจะใส่สถิติสำคัญของ t.test สำหรับ bheta ในสมการได้ggpmisc::stat_poly_eq()อย่างไร?

อดีต: expression(hat(Y)== 0000*"**"+0000*"x"*"*"-0000*"x"^2*"**"~~~~"R"^2*":"~~0.000)

โดยการใช้ไซต์ของเรา หมายความว่าคุณได้อ่านและทำความเข้าใจนโยบายคุกกี้และนโยบายความเป็นส่วนตัวของเราแล้ว
Licensed under cc by-sa 3.0 with attribution required.