URREA FTE ABANCONV RLS V1
Miriam Alonso
2022-10-19
R Markdown
This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see http://rmarkdown.rstudio.com.
When you click the Knit button a document will be generated that includes both content as well as the output of any embedded R code chunks within the document. You can embed an R code chunk like this:
R Markdown Ejemplo de Regresión Lineal Simple Anuncios y Carros Vendidos
Este es el archivo Markdown de Regresión Lineal Simple en R, de la Base de Datos FteAbandConv de URREA. Este ejercicio es una actividad para RETO de la Concentración CD2001C Analítica para Negocios: De los datos a las decisiones del semestre Agosto - Diciembre 2022. Profesora: Miriam Alonso en colaboración con la Profesora: Dra. Ma. Margarita Orozco Gómez.
Instalación de librerías
Para iniciar la ejecución de este Markdown es necesario instalar en la consola las librerías: tidyverse, readxl, ggplot2, janitor, dplyr, dbplyr, modeest, y ggthemes.
Archivo R Script de instalación de librerías
Para ello, es recomendable ejecutar primero el archivo R Script de instalación de librerías en el que están las siguientes instrucciones: install.packages(‘tidyverse’) install.packages(‘readxl’) install.packages(‘ggplot2’) install.packages(‘janitor’) install.packages(‘dplyr’) install.packages(‘dbplyr’) install.packages(“modeest”) install.packages(“ggthemes”) install.packages(“ggthemes”) install.packages(“psych”) install.packages(“lubridate”) library(tidyverse) library(dslabs) library(dplyr) library(ggplot2) library(psych) library(PerformanceAnalytics)
Llamado de las librerías en Markdown
Después de ejecutar las librerías en el R Script o la consola, en el Markdown hay que llamarlas para que estén habilitadas las funciones que utilizaremos.
library(tidyverse)## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.2 ──
## ✔ ggplot2 3.3.6 ✔ purrr 0.3.5
## ✔ tibble 3.1.8 ✔ dplyr 1.0.10
## ✔ tidyr 1.2.1 ✔ stringr 1.4.1
## ✔ readr 2.1.3 ✔ forcats 0.5.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()library(readxl)
library(ggplot2)
library(dplyr)
library(dbplyr)##
## Attaching package: 'dbplyr'
##
## The following objects are masked from 'package:dplyr':
##
## ident, sqllibrary(janitor)##
## Attaching package: 'janitor'
##
## The following objects are masked from 'package:stats':
##
## chisq.test, fisher.testlibrary(modeest)## Registered S3 method overwritten by 'rmutil':
## method from
## print.response httrlibrary(ggthemes)
library(psych)## Registered S3 method overwritten by 'psych':
## method from
## plot.residuals rmutil
##
## Attaching package: 'psych'
##
## The following objects are masked from 'package:ggplot2':
##
## %+%, alphalibrary(lubridate)##
## Attaching package: 'lubridate'
##
## The following objects are masked from 'package:base':
##
## date, intersect, setdiff, unionlibrary(knitr)
library(DT)Abrir el archivo de datos
library(readxl)
Fte1 <- read_excel("URREAFTE.xlsx")
#View(Fte1)Cambiar nombres de variables a minúsculas y quitar acentos
Esto hará que escribir los nombres de las variables en los análisis posteriores sea más fácil, ya que no tendremos que recordar qué es mayúscula y qué no y si le habíamos o no puesto acentos. Instala el paquete janitor:
library(janitor)
fte2 <- Fte1 %>%
janitor::clean_names()
names(fte2)## [1] "fte_medio" "catg_evento" "usuarios_cant"
## [4] "usuario_nvo_cant" "sesiones_cant" "rebote_porc"
## [7] "sesion_pagina" "sesion_durc_media" "tasa_conv_e_comm"
## [10] "transaccion_cant" "ingresos_mto"Escala de medición de las variables
Para analizar la escala de medición de las variables utilizaremos la función sapply(data, class)
sapply(fte2, class)## fte_medio catg_evento usuarios_cant usuario_nvo_cant
## "character" "character" "numeric" "numeric"
## sesiones_cant rebote_porc sesion_pagina sesion_durc_media
## "numeric" "numeric" "numeric" "numeric"
## tasa_conv_e_comm transaccion_cant ingresos_mto
## "numeric" "numeric" "numeric"Otra función que nos sirve para analizar la escala de medición de las variables es str(data)
str(fte2)## tibble [100 × 11] (S3: tbl_df/tbl/data.frame)
## $ fte_medio : chr [1:100] "fb / Facebook_Mobile_Feed" "(direct) / (none)" "google / organic" "urrea.mx / referral" ...
## $ catg_evento : chr [1:100] "Carritos" "Carritos" "Carritos" "Carritos" ...
## $ usuarios_cant : num [1:100] 779 573 548 512 485 349 234 201 190 128 ...
## $ usuario_nvo_cant : num [1:100] 617 508 383 405 410 240 228 112 152 84 ...
## $ sesiones_cant : num [1:100] 823 627 780 618 504 378 230 324 207 142 ...
## $ rebote_porc : num [1:100] 0 0 0 0 0 0 0 0 0 0 ...
## $ sesion_pagina : num [1:100] 5.11 5.17 12.87 12 6.17 ...
## $ sesion_durc_media: num [1:100] 233 311 826 701 337 ...
## $ tasa_conv_e_comm : num [1:100] 0.12 3.35 7.95 2.27 1.98 0 0 21.6 0.48 1.41 ...
## $ transaccion_cant : num [1:100] 1 21 62 14 10 0 0 70 1 2 ...
## $ ingresos_mto : num [1:100] 882 42601 133731 66051 16375 ...Recodificando variables cadena en factores
Las variables que tienen definidas categorías Ej. nominales, ordinales, o de intervalo, en R deben ser codificadas como factores. Para ello, utilizaremos la función as.data.frame en combinación con la función unclass para convertir todas las columnas que aparecen como cadena (characters/chr) en variables tipo factor.
fte3 <- as.data.frame (unclass(fte2),
stringsAsFactors = TRUE)sapply(fte3, class)## fte_medio catg_evento usuarios_cant usuario_nvo_cant
## "factor" "factor" "numeric" "numeric"
## sesiones_cant rebote_porc sesion_pagina sesion_durc_media
## "numeric" "numeric" "numeric" "numeric"
## tasa_conv_e_comm transaccion_cant ingresos_mto
## "numeric" "numeric" "numeric"Quitar notación científica
Para que las escalas no aparezcan en notación científica en los gráficos
options(scipen=999)Histograma de la variable dependiente Ingresos_Mto
hist(fte3$ingresos_mto, density = 20, prob = TRUE,
xlab = "Ingresos",
main = "Distribución de la Variable Dependiente(x)")
curve(dnorm(x, mean = mean(fte3$ingresos_mto), sd = sd(fte3$ingresos_mto)),
col = "red", lwd = 2, add = TRUE,
yaxt = "n")
Gráfico QQ de la variable dependiente Ingresos_Mto
# QQ Plot
qqnorm (fte3$ingresos_mto, ylab = "Ingresos", col = "red")
qqline(fte3$ingresos_mto)
Gráfico de caja y bigotes de la variable dependiente Ingresos_Mto
boxplot(fte3$ingresos_mto, col = "green",
xlab= " ",
ylab= "Ingresos",
main = "Gráfico de la Variable Dependiente")
Histograma de la variable independiente Transacciones
hist(fte3$transaccion_cant, density = 20, prob = TRUE,
xlab = "Transacciones",
main = "Histograma de la variable independiente")
curve(dnorm(x, mean = mean(fte3$transaccion_cant), sd = sd(fte3$transaccion_cant)),
col = "red", lwd = 2, add = TRUE,
yaxt = "n")
Gráfico QQ de la variable independiente Transacciones
# QQ Plot
qqnorm (fte3$transaccion_cant, ylab = "Transacciones", col = "red")
qqline(fte3$transaccion_cant)
Gráfico de caja y bigotes de la variable independiente Transacciones
boxplot(fte3$transaccion_cant, col = "green",
xlab= " ",
ylab= "Transacciones",
main = "Gráfico de la variable independiente")
Identificación de datos atípicos con Z-score en la variable dependiente
fte3$ing_z <- (fte3$ingresos_mto - mean(fte3$ingresos_mto, na.rm=T))/sd(fte3$ingresos_mto, na.rm = TRUE)summary(fte3$ing_z)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.2611 -0.2611 -0.2611 0.0000 -0.2611 6.0983El resultado nos índica que SI existen observaciones que definidos como OUTLIERS en la variable dependiente. Esto, porque las puntuaciones z NO están dentro de -3 a 3. Nota: tomaremos como referencia el 3 porque tenemos pocos datos.
Identificación de datos atípicos con Z-score en la variable independiente
fte3$trans_z <- (fte3$transaccion_cant - mean(fte3$transaccion_cant, na.rm=T))/sd(fte3$transaccion_cant, na.rm = TRUE)summary(fte3$trans_z)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.2558 -0.2558 -0.2558 0.0000 -0.2558 6.7383El resultado nos índica que SI existen observaciones que definidos como OUTLIERS en la variable dependiente. Esto, porque las puntuaciones z NO están dentro de -3 a 3. Nota: tomaremos como referencia el 3 porque tenemos pocos datos.
sum(fte3$ing_z > 3, na.rm=TRUE)## [1] 3sum(fte3$trans_z > 3, na.rm=TRUE)## [1] 2sum(fte3$ing_z < -3, na.rm=TRUE)## [1] 0sum(fte3$trans_z < -3, na.rm=TRUE)## [1] 0# Determinamos el trim (recorte)
#para ingresos 3 datos >3 + 0 datos >-3 entre el total de datos
3/100 #=0.03## [1] 0.03#para transacciones 2 datos >3 + 0 datos >-3 entre el total de datos
2/100 #=0.02## [1] 0.02Como podemos observar la cantidad de datos atípicos de ingresos es de 3, lo cual representa el 3% de los datos y para transacciones 2%.
Winsorizacion
#Winzor
fte4 <- fte3 %>%
mutate(ing_w = winsor(ingresos_mto,trim = 0.03, na.rm=T))
summary(fte4$ing_w)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0 0 0 4363 0 66382summary(fte4$ingresos_mto)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0 0 0 5922 0 144251#View(fte4)
fte5 <- fte4 %>%
mutate(tran_w = winsor(transaccion_cant,trim = 0.02, na.rm=T))
summary(fte5$tran_w)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000 0.000 0.000 1.755 0.000 25.740summary(fte5$transaccion_cant)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.00 0.00 0.00 2.56 0.00 70.00#View(fte5)Gráfico de dispersión XY
ggplot(fte5, aes(tran_w, ing_w)) +
geom_point()+
labs (x = "Número de transacciones", y = "Ingreso")+
geom_smooth(method ="lm", color ="red", se = TRUE)## `geom_smooth()` using formula 'y ~ x'
Cálculo de la correlación entre X y Y
cor(fte5$transaccion_cant, fte5$ingresos_mto)## [1] 0.9698096cor(fte5$tran_w, fte5$ing_w)## [1] 0.9536358Modelo de Regresión Lineal Simple
model1<-lm(ing_w~ tran_w, data = fte5) #Create a model
summary(model1)##
## Call:
## lm(formula = ing_w ~ tran_w, data = fte5)
##
## Residuals:
## Min 1Q Median 3Q Max
## -11775 197 197 197 29866
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -196.98 465.21 -0.423 0.673
## tran_w 2598.72 82.85 31.368 <0.0000000000000002 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 4419 on 98 degrees of freedom
## Multiple R-squared: 0.9094, Adjusted R-squared: 0.9085
## F-statistic: 983.9 on 1 and 98 DF, p-value: < 0.00000000000000022Interpretación de los resultados del Modelo de Regresión Lineal Simple
Prueba t para el Intercepto (Beta0)
Hipótesis nula es que Beta0 = 0 “El intercepto no es significativo” Hipótesis alterna es que Beta0 =! 0 “El intercepto sí es significativo”
Con una t de -0.423 que tiene una significancia de 0.673 mayor que alfa de 0.05, NO se rechaza HO con una confianza de 95% (*). Es decir, el Intercepto NO es significativo en la ecuación de regresión.
Prueba t para la pendiente (Beta1)
Hipótesis nula es que Beta1 = 0 “La pendiente poblacional es igual a cero. Es decir, el número de transacciones no sirve (es independiente) para pronosticar elos ingresos vendidos” Hipótesis alterna es que Beta1 =! 0 “La pendiente poblacional es diferente de cero. Es decir, el número de transacciones sí ayuda a pronosticar los ingresos”
Con una t de 31.368 que tiene una significancia de 0.00000000000000022 menor que alfa de 0.001, se rechaza HO con una confianza de 99.9% (***). Es decir, la pendiente sí es significativa en la ecuación de regresión. Se valida estadísticamente que el coeficiente Beta (pendiente poblacional) es diferente de 0.
Prueba F para el Modelo de Regresión
Con una F de 983.9 que tiene una significancia de 0.00008358 menor que alfa de 0.001, se rechaza HO con una confianza de 99.9% (***). Es decir, la pendiente sí es significativa en la ecuación de regresión. En otras palabras, el número de carros vendidos depende del número de anuncios publicados.
Interpretación de los coeficientes de la ecuación de regresión.
Interpretación del intercepto a
Independientemente de la cantidad de trancciones que se realicen, se espera que como mínimo un ingreso de -196.98 pesos.
Interpretación de la pendiente b
Como b = 2598.72 , Por cada transacción que se realice, se espera que las ventas mensuales se incrementen en 2598.72 pesos.
Error Cuadrático Medio (MSE)
mse <- mean(residuals(model1)^2)
rmse <- sqrt(mse)
mse #Mean Square Error (ECM: Error Cuadrático Medio)## [1] 19137572rmse #Root Mean Square Error## [1] 4374.651y.pron<-predict(model1) #Valores pronosticados
res<- resid(model1) #Residul (Y - y.pron)
stand.res<-rstandard(model1) #Residuos estandarizados
stud.res<-rstudent(model1) #Residuos estudentizados ("Leave one out" residual)
hist(stand.res, density=20, prob=TRUE,
xlab="Residuos estandarizados",
main="Gráfico de los Residuos estandarizados")
curve(dnorm(x, mean=mean(stand.res), sd=sd(stand.res)),
col="darkblue", lwd=2, add=TRUE, yaxt="n")
qqnorm(stand.res, ylab = "Residuos estandarizados", col = "navyblue")
qqline(stand.res)
Prueba de Normalidad de los residuos
Recordando que, uno de los supuestos más importantes en el Análisis de Regresión, es que, los residuos (errores) tengan una distribución Normal. Es decir, que se distribuyan arriba y debajo del 0 entre -2 y 2 (los estandarizados), hacemos la prueba de Normalidad.
Hipotesis nula: Los residuos se distribuyen Normal Hipótesis alterna:Los residuos no se distribuyen Normal
Con un estadístico de Kolmogorov-Sminorv de 0.4621330142 y una significancia (p.value) de 0.000000000 (7.37e-10) memor que alfa de 0.10, Se rechaza H0 con una confianza de 90%. NO se cumple el supuesto de la distribución Normal de los residuos. Cabe mencionar que esta prueba la podemos hacer tanto para los residuos como para los residuos estandarizados y obtendremos lo mismo. Hay que recordar que el estandarizar una variable no la hace Normal, solo cambia sus unidades originales a unidades de desviaciones estándar. Así que, si los residuos son Normales, los estandarizados, también lo serán. Y si no, pues, no.
library(nortest)
sw<-shapiro.test(res) #Shapiro-Wilk
ks<-lillie.test(res) #kolmogorov-Smirnov
cv<-cvm.test(res) #Cramer-von Mises## Warning in cvm.test(res): p-value is smaller than 7.37e-10, cannot be computed
## more accuratelyad<-ad.test(res) #Anderson-Darling
stat<-cbind(sw$statistic,ks$statistic,cv$statistic,ad$statistic)
p.value<-cbind(sw$p.value,ks$p.value,cv$p.value,ad$p.value)
normal.table<-rbind(stat,p.value)
colnames(normal.table)<-c("Shapiro-Wilk","kolmogorov-Smirnov",
"Cramer-von Mises","Anderson-Darling")
rownames(normal.table)<-c("statistic", "p-value")
normal.table## Shapiro-Wilk
## statistic 0.3585213689096977685011325
## p-value 0.0000000000000000006482228
## kolmogorov-Smirnov
## statistic 0.4621330142545820862665095773991197347640991210937500000000000000000
## p-value 0.0000000000000000000000000000000000000000000000000000000000001745487
## Cramer-von Mises Anderson-Darling
## statistic 5.348318493359 25.2793113261615332021392533
## p-value 0.000000000737 0.0000000000000000000000037Estimación puntual y de intervalo para Y, dado un valor de X
Estimación puntual
Si utilizamos la ecuación de regresión para pronosticar los ingresos que se obtendrían si realizamos 50 transacciones (y.pron = a+bX = -196.98 + 2598.72(50)), el resultado nos indica que esperaríamos vender 129739.02 pesos. Sin embargo, sabemos que la probabilidad de que este valor sea correcto o exacto es muy poca, tirando a 0. Por ello, es mejor calcular el intervalo de confianza para la estimación.
Estimación por intervalo para Y dado un valor de X
Si se realizarón 50 transacciones en un mes, se espera con un 90% de confianza que al menos ingrese como min 119,817.4 pesos, y como máximo, de 139,660.6 pesos.
nuevo <- data.frame(tran_w=50)
predict(object=model1, newdata=nuevo, interval="prediction", level=0.90)## fit lwr upr
## 1 129739 119817.4 139660.6Estimación intervalo para la Media de Y
Si se realizaron 50 transacciones en diferentes meses, en promedio los ingresos de dichos meses se espera que con un 90% de confianza se encuentre entre 123,061.4 136,416.6 pesos.
nuevo <- data.frame(tran_w=50)
predict(object=model1, newdata=nuevo, interval="confidence", level=0.90)## fit lwr upr
## 1 129739 123061.4 136416.6###Ahora vamos a obtener todos los IC para Y y los vamos a almacenar en el objeto future_y que luego luego vamos a agregar al conjunto de datos original.
future_y <- predict(object=model1, interval="prediction", level=0.95)## Warning in predict.lm(object = model1, interval = "prediction", level = 0.95): predictions on current data refer to _future_ responsesfte6 <- cbind(fte5, future_y)
#Warning_in
predict.lm(object = model1, interval = "prediction", level = 0.95)## Warning in predict.lm(object = model1, interval = "prediction", level = 0.95): predictions on current data refer to _future_ responses## fit lwr upr
## 1 2401.7442 -6412.358 11215.847
## 2 54376.1389 45012.154 63740.124
## 3 66694.0705 57038.868 76349.273
## 4 36185.1008 27144.859 45225.343
## 5 25790.2218 16873.352 34707.092
## 6 -196.9755 -9014.925 8620.974
## 7 -196.9755 -9014.925 8620.974
## 8 66694.0705 57038.868 76349.273
## 9 2401.7442 -6412.358 11215.847
## 10 5000.4639 -3812.857 13813.785
## 11 -196.9755 -9014.925 8620.974
## 12 43981.2600 34818.556 53143.964
## 13 64771.0179 55164.862 74377.173
## 14 5000.4639 -3812.857 13813.785
## 15 28388.9416 19445.601 37332.282
## 16 2401.7442 -6412.358 11215.847
## 17 -196.9755 -9014.925 8620.974
## 18 2401.7442 -6412.358 11215.847
## 19 7599.1837 -1216.423 16414.790
## 20 -196.9755 -9014.925 8620.974
## 21 -196.9755 -9014.925 8620.974
## 22 -196.9755 -9014.925 8620.974
## 23 -196.9755 -9014.925 8620.974
## 24 2401.7442 -6412.358 11215.847
## 25 -196.9755 -9014.925 8620.974
## 26 5000.4639 -3812.857 13813.785
## 27 5000.4639 -3812.857 13813.785
## 28 2401.7442 -6412.358 11215.847
## 29 -196.9755 -9014.925 8620.974
## 30 -196.9755 -9014.925 8620.974
## 31 -196.9755 -9014.925 8620.974
## 32 -196.9755 -9014.925 8620.974
## 33 -196.9755 -9014.925 8620.974
## 34 -196.9755 -9014.925 8620.974
## 35 -196.9755 -9014.925 8620.974
## 36 -196.9755 -9014.925 8620.974
## 37 -196.9755 -9014.925 8620.974
## 38 10197.9034 1376.948 19018.859
## 39 -196.9755 -9014.925 8620.974
## 40 -196.9755 -9014.925 8620.974
## 41 -196.9755 -9014.925 8620.974
## 42 -196.9755 -9014.925 8620.974
## 43 -196.9755 -9014.925 8620.974
## 44 -196.9755 -9014.925 8620.974
## 45 -196.9755 -9014.925 8620.974
## 46 -196.9755 -9014.925 8620.974
## 47 -196.9755 -9014.925 8620.974
## 48 -196.9755 -9014.925 8620.974
## 49 -196.9755 -9014.925 8620.974
## 50 -196.9755 -9014.925 8620.974
## 51 -196.9755 -9014.925 8620.974
## 52 -196.9755 -9014.925 8620.974
## 53 -196.9755 -9014.925 8620.974
## 54 -196.9755 -9014.925 8620.974
## 55 -196.9755 -9014.925 8620.974
## 56 -196.9755 -9014.925 8620.974
## 57 -196.9755 -9014.925 8620.974
## 58 -196.9755 -9014.925 8620.974
## 59 -196.9755 -9014.925 8620.974
## 60 -196.9755 -9014.925 8620.974
## 61 -196.9755 -9014.925 8620.974
## 62 -196.9755 -9014.925 8620.974
## 63 -196.9755 -9014.925 8620.974
## 64 -196.9755 -9014.925 8620.974
## 65 -196.9755 -9014.925 8620.974
## 66 -196.9755 -9014.925 8620.974
## 67 -196.9755 -9014.925 8620.974
## 68 -196.9755 -9014.925 8620.974
## 69 -196.9755 -9014.925 8620.974
## 70 -196.9755 -9014.925 8620.974
## 71 -196.9755 -9014.925 8620.974
## 72 -196.9755 -9014.925 8620.974
## 73 -196.9755 -9014.925 8620.974
## 74 5000.4639 -3812.857 13813.785
## 75 5000.4639 -3812.857 13813.785
## 76 -196.9755 -9014.925 8620.974
## 77 -196.9755 -9014.925 8620.974
## 78 -196.9755 -9014.925 8620.974
## 79 -196.9755 -9014.925 8620.974
## 80 -196.9755 -9014.925 8620.974
## 81 -196.9755 -9014.925 8620.974
## 82 2401.7442 -6412.358 11215.847
## 83 -196.9755 -9014.925 8620.974
## 84 -196.9755 -9014.925 8620.974
## 85 -196.9755 -9014.925 8620.974
## 86 -196.9755 -9014.925 8620.974
## 87 -196.9755 -9014.925 8620.974
## 88 -196.9755 -9014.925 8620.974
## 89 -196.9755 -9014.925 8620.974
## 90 -196.9755 -9014.925 8620.974
## 91 -196.9755 -9014.925 8620.974
## 92 -196.9755 -9014.925 8620.974
## 93 -196.9755 -9014.925 8620.974
## 94 -196.9755 -9014.925 8620.974
## 95 -196.9755 -9014.925 8620.974
## 96 -196.9755 -9014.925 8620.974
## 97 -196.9755 -9014.925 8620.974
## 98 -196.9755 -9014.925 8620.974
## 99 -196.9755 -9014.925 8620.974
## 100 -196.9755 -9014.925 8620.974#predictions on current data refer to _future_ responses
#View(fte6)Con el código mostrado a continuación se construye el diagrama de dispersión y se agrega la línea de regresión (en azul) y los IC para las Medias de Y pronosticado (en rosado) por medio de geom_smooth. Los IC para el pronóstico de Y (en rojo) se agregan por medio de geom_line.
library(ggplot2)
ggplot(fte6, aes(x=tran_w, y=ing_w))+
geom_point() +
geom_line(aes(y=lwr), color="red", linetype="dashed") +
geom_line(aes(y=upr), color="red", linetype="dashed") +
geom_smooth(method=lm, formula=y~x, se=TRUE, level=0.95, col='blue', fill='pink2') +
theme_light()