मुझे आश्चर्य है कि प्रतिगमन रेखा समीकरण और आर ^ 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किसी भी तरह की सहायता की हम सराहना करेंगे।
जवाबों:
यहाँ एक उपाय है
# 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 समूहों में मूल पोस्ट का लिंक दिया गया है
annotateमेरे मशीन पर बेहतर दिखने वाले ग्रंथों के बारे में सही थी।
aes(और इसी को हटा दें )। aesडेटाफ़ेयर वैरिएबल को विज़ुअल वेरिएबल्स की मैपिंग के लिए - कि यहाँ कोई ज़रूरत नहीं है, क्योंकि सिर्फ एक उदाहरण है, इसलिए आप इसे मुख्य geom_textकॉल में रख सकते हैं। मैं इसे उत्तर में संपादित करूँगा।
मैंने 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
@ शब्बीचेफ अब अक्ष-लेबलों के लिए उपयोग किए जाने वाले समीकरणों में चर का मिलान करना संभव है। बदलने के लिए एक्स कहते हैं के साथ z और y के साथ ज एक का प्रयोग करेंगे:
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 दोनों में उपयोग किए जा सकते हैं।
[२०१ [-०३-० address] @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
[२०१ ९ -१०-२०] @ हेलन। मैं 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
[२०२०-०१-२१] @ हर्मन यह पहली नजर में थोड़ा जवाबी हो सकता है, लेकिन ग्राफिक्स के व्याकरण का पालन करने के लिए किसी एक को समूहीकृत करने का उपयोग करते समय एक एकल समीकरण प्राप्त करना। या तो उस मैपिंग को प्रतिबंधित करें जो ग्रुपिंग को अलग-अलग लेयर्स के लिए बनाता है (नीचे दिखाया गया है) या डिफॉल्ट मैपिंग को बनाए रखें और इसे उस लेयर में एक स्थिर मान के साथ ओवरराइड करें जहां आप ग्रुपिंग नहीं चाहते हैं (जैसे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
[२०२०-०१-२२] पूर्णता के लिए पहलुओं के साथ एक उदाहरण, यह दर्शाता है कि इस मामले में भी ग्राफिक्स के व्याकरण की अपेक्षाएं पूरी होती हैं।
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
xऔर yसूत्र में भूखंड की परतों में डेटा xऔर yडेटा का उल्लेख है , और जरूरी नहीं कि उस समय के दायरे में उन लोगों के my.formulaलिए निर्माण किया जाए। इस प्रकार सूत्र हमेशा x और y चर का उपयोग करना चाहिए ?
xऔर yजो कुछ भी इन सौंदर्यशास्त्र के लिए मैप किए गए हैं, उन्हें देखें। यही उम्मीद है कि जियोम_सूट () और ग्राफिक्स का व्याकरण कैसे काम करता है। यह डेटा फ्रेम के भीतर अलग-अलग नामों का उपयोग करने के लिए स्पष्ट हो सकता था लेकिन मैंने उन्हें मूल प्रश्न के रूप में रखा।
ggpmisc। सलाह के लिये धन्यवाद!
aes(label = paste(..eq.label.., ..rr.label.., sep = "*plain(\",\")~"))काम करता है।
stat_poly_eq()। आप stat_fit_glance()पैकेज 'ggpmisc' से भी उपयोग कर सकते हैं , जो R2 को एक संख्यात्मक मान के रूप में लौटाता है। सहायता पृष्ठ में उदाहरण देखें, और उसके stat(r.squared)द्वारा प्रतिस्थापित करें sqrt(stat(r.squared))।
मैंने stat_smoothएक नया फ़ंक्शन बनाने के लिए और संबंधित फ़ंक्शन के स्रोत की कुछ पंक्तियों को बदल दिया, जो कि फिट समीकरण और आर स्क्वेर्ड मूल्य जोड़ता है। यह पहलू भूखंडों पर भी काम करेगा!
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)
मैंने समीकरण को प्रारूपित करने के लिए @ रामनाथ के उत्तर में कोड का उपयोग किया। stat_smooth_funcसमारोह बहुत मजबूत नहीं है, लेकिन यह इसके साथ चारों ओर खेलने के लिए मुश्किल नहीं होना चाहिए।
https://gist.github.com/kdauria/524eade46135f6348140 । ggplot2त्रुटि मिलने पर अपडेट करने का प्रयास करें ।
stat_smooth_func(mapping=aes(group=cut(x.val,c(-70,-20,0,20,50,130))),geom="text",method="lm",hjust=0,parse=TRUE), stackoverflow.com/questions/19735149/…
sourceअपनी स्क्रिप्ट में पूरी फाइल।
xposऔर yposतर्क दिए । इसलिए यदि आप सभी समीकरणों को ओवरलैप करना चाहते हैं, तो बस सेट करें xposऔर ypos। अन्यथा, xposऔर yposडेटा से गणना की जाती है। यदि आप कुछ कट्टर चाहते हैं, तो फ़ंक्शन के अंदर कुछ तर्क जोड़ना मुश्किल नहीं होना चाहिए। उदाहरण के लिए, शायद आप यह निर्धारित करने के लिए फ़ंक्शन लिख सकते हैं कि ग्राफ़ के किस हिस्से में सबसे खाली जगह है और फ़ंक्शन को वहां रखा जाए।
मैंने रामनाथ की पोस्ट को संशोधित कर a) को और अधिक सामान्य बना दिया है ताकि यह एक रैखिक मॉडल को डेटा फ्रेम के बजाय पैरामीटर के रूप में स्वीकार कर ले और 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)p1 = p + annotate("text", x = 25, y = 300, label = lm_eqn(lm(y ~ x, df)), colour="black", size = 5, parse=TRUE)संपादित करें: यह आपके द्वारा लीजेंड में दिखाए गए पत्रों के साथ हो सकने वाली किसी भी समस्या का समाधान करता है।
"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)
lm_eqn(lm(...))रामनाथ के समाधान के साथ कॉल करने पर आपको मिलने वाला त्रुटि संदेश । आपने शायद इसे आज़माने के बाद एक कोशिश की लेकिन यह सुनिश्चित करना भूल गए कि आपने फिर से परिभाषित किया हैlm_eqn
वास्तव में @ रामनाथ समाधान से प्यार है। प्रतिगमन सूत्र को अनुकूलित करने के लिए उपयोग करने की अनुमति देने के लिए (शाब्दिक चर नामों के रूप में y और x के रूप में निश्चित के बजाय), और प्रिंटआउट में पी-मान को जोड़ा (साथ ही @ जेरी टी टिप्पणी की गई), यहां मॉड है:
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 () से पहले गायब है ? एक अर्द्ध संबंधित सवाल - अगर हम का उल्लेख अश्वशक्ति और भार में aes()ggplot के लिए, हम तो कर सकते हैं हड़पने उन्हें कॉल में उपयोग करने के लिए lm_eqnहै, तो फिर हम केवल एक ही स्थान पर कोड के लिए है? मुझे पता है कि हम xvar = "hp"ggplot () कॉल से पहले सेट कर सकते हैं, और hp को बदलने के लिए दोनों स्थानों में xvar का उपयोग कर सकते हैं , लेकिन ऐसा लगता है कि यह अनावश्यक होना चाहिए।
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?
label.y = max(df$y) * 0.8
यहां सभी के लिए सबसे सरल कोड है
नोट: पियर्सन की रो दिखा और न 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
इस उत्तर में प्रदान की गई समीकरण शैली से प्रेरित होकर , एक अधिक सामान्य दृष्टिकोण (विकल्प के रूप में एक से अधिक पूर्वसूचक + लेटेक्स आउटपुट) हो सकते हैं:
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 समारोह।
मैंने इसे लेटेक्स के रूप में आउटपुट करने के लिए एक विकल्प भी जोड़ा है ताकि आप इस फ़ंक्शन का उपयोग इस तरह एक रेकॉर्डडाउन में कर सकें:
```{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)यह प्रदान करता है:
मुझे शक है, कैसे समीकरण में bheta के लिए t.test के एक signficant आँकड़े डाल दिया, का उपयोग कर ggpmisc::stat_poly_eq() ?
उदाहरण के लिए: expression(hat(Y)== 0000*"**"+0000*"x"*"*"-0000*"x"^2*"**"~~~~"R"^2*":"~~0.000)
latticeExtra::lmlineq()।