La idea principal de este proyecto es conocer si después de una breve demostración de lo que puede realizar el software R, las personas muestran un interés en el uso de dicho software.
Para eso se realizó una aplicación shiny, en donde cada pregunta enriquece una base de datos, además de realizar un cálculo demostrativo donde básicamente es en tiempo real.
Con los primeros datos se realizo una grafica de pastel, pues se recabaron datos nominales y solo se tiene ese dato.
ExisMix <- c(DatosEncuesta()$ConoceR, input$existencia)
# Obtiene la frecuencia para diagrama
FrecPastel <- table(ExisMix)
# Crear el diagrama de pastel
output$PastelR <- renderPlotly({
plot_ly(labels = names(FrecPastel), values = ~FrecPastel,
type = "pie", marker = list(colors = list("#0000FF50", "#FF000050"))) %>%
layout(title = list(text = "<b>Gráfica de personas que conocen el software R</b>", #en negritas con <b>
font = list(size = 20)))
})Con la segunda pregunta ya se tienen información de dos datos nominales, por lo que se realizo una grafica de barras usando el color como otro distintivo
# Combinar los datos anteriores con la nueva selección
ExisMix <- c(DatosEncuesta()$ConoceR, input$existencia)
PlanMix <- c(DatosEncuesta()$Plantel, input$plantel)
# Crear un data frame para ggplot2
DataCarre <- data.frame(ConoceR = ExisMix, Planteles = PlanMix)
# Crear el gráfico de barras con ggplot2
InteractivoSiNoPlantel <- ggplot(DataCarre, aes(x = Planteles, fill = ConoceR)) +
geom_bar(position = "stack") + #separa en la misma columna por fill
scale_fill_manual(values = c("SI" = "#0000FF50", "NO" = "#FF000050")) + #Colores con 0.5 transparencia
ggtitle("Gráfico de barras apiladas de planteles que conocen R") +
labs(fill = "Conocen R", x = "Planteles", y = "Frecuencia") +
theme_minimal() + # Fondo minimalista antes de theme()
# Estetica de texto
theme(plot.title = element_text(size = 20, face = "bold"),
axis.text = element_text(size = 15),
axis.title = element_text(size = 15, face = "bold"))
output$SiNoPlantel <- renderPlotly({ #se cambia renderPlot por renderPlotly si se usa ggplotly
ggplotly(InteractivoSiNoPlantel)
})Con la tercera pregunta se obtuvo nuevamente datos nominales pero esta vez con un rango mas amplio de valores, por la cual se utilizo el grafico de barras
InteractivoBarrasCarrera <- ggplot(DataCarre, aes(x = Carreras, y = Frecuencia)) +
geom_bar(stat = "identity", fill = "steelblue1", alpha = 0.7) +
coord_flip()+
ggtitle("Gráfico de Barras de carreras Encuestados") +
labs(x = "Carreras", y = "Frecuencia") +
theme_minimal() + # Fondo minimalista antes de theme()
# Estetica de texto
theme(plot.title = element_text(size = 20, face = "bold"),
axis.text = element_text(size = 15),
axis.title = element_text(size = 15, face = "bold"))
output$BarrasCarrera <- renderPlotly({ #se cambia renderPlot por renderPlotly si se usa ggplotly
ggplotly(InteractivoBarrasCarrera)
})Con la cuarta pregunta se obtiene los primeros datos continuos, la demostración es la obtención de valores de tendencia central, los cuales se mostraron en una tabla
# Combinar los datos anteriores con la nueva selección
TimeMix <- c(DatosEncuesta()$Tiempo, input$tiempo)
# Variables donde se guardaran datos
media <- round(mean(TimeMix), 4)
mediana <- median(TimeMix)
moda <- mfv(TimeMix)
minimo <- min(TimeMix)
maximo <- max(TimeMix)
rangoI <- IQR(TimeMix)
cuarti <- quantile(TimeMix, c(0.25, 0.75))
desvi <- round(sd(TimeMix), 4)
#crear el texto final
TextoFinal <- matrix(c("Media", media,
"Mediana", mediana,
"Moda", paste(moda, collapse = ","), #Si son varios datos unirlos
"Mínimo", minimo,
"Máximo", maximo,
"Cuartiles 1 y 3", paste(cuarti, collapse = ", "),
"Rango intercuartílico",rangoI,
"Desviación estándar", desvi),
ncol = 2, nrow = 8, byrow = TRUE,
dimnames = list(c("Media", "Mediana", "Moda", "Mínimo", "Máximo",
"Cuartiles 1 y 3", "Rango intercuartílico",
"Desviación estándar"), c("Estadística", "Valor")))
# Mostrara texto
output$TablaTiempo <- renderTable({
TextoFinal
}, align = "lc") # primera columna l-izq segunda c-centroCon la quinta pregunta se obtuvo la segunda variable continua, la cual se graficó en una clásica curva continua de estaturas
# Combinar los datos anteriores con la nueva selección
EstaMix <- c(DatosEncuesta()$Estatura, input$estatura)
# Crear un data frame con los datos para ggplot2
DataEsta <- data.frame(Estaturas = EstaMix)
# Crear camapana con ggplot2
InteractivoCampana <- ggplot(DataEsta, aes(x = Estaturas)) +
geom_density(fill = "steelblue1", color = "blue", size = 1, alpha = 0.7) +
ggtitle("Distribución de estaturas") +
labs(x = "Estatura", y = "Densidad") +
theme_minimal() + # Fondo minimalista antes de theme()
# Estetica de texto
theme(plot.title = element_text(size = 20, face = "bold"),
axis.text = element_text(size = 15),
axis.title = element_text(size = 15, face = "bold"))
output$campana <- renderPlotly({ #se cambia renderPlot por renderPlotly si se usa ggplotly
ggplotly(InteractivoCampana)
})Con la sexta pregunta se añadió una variable nominal, donde se busco hacer uso de escalas de Likert, y como una demostración se decidió hacer un análisis de Xi cuadrada, usando la variable de conocimiento, en esta pregunta se tenía la intención de no poder refutar la hipótesis nula
# Combinar los datos anteriores con la nueva selección
ProgramarMix <- c(DatosEncuesta()$Programacion, input$progra)
ExisMix <- c(DatosEncuesta()$ConoceR, input$existencia)
# Crear un data frame
DataPro <- data.frame(Programacion = as.factor(ProgramarMix), ConoceR = ExisMix)
#crear tabla
TabPro <- xtabs (formula = ~ ConoceR + Programacion, data=DataPro)
#obtener el valor de xi
ResuChi <- chisq.test(TabPro)
ValChi <- as.numeric(ResuChi$statistic)
# Obtener el limite grafico para rechazar H0
Limite <- qchisq(.95,4) # alpha =5 df= (2-1)*(5-1)
# Crear el gráfico
output$xiProgra <- renderPlotly({
# Calcula los valores de la distribución xi para la curva y el sombreado
CurvaX <- seq(0, 45, length.out = 200)
CurvaY <- dchisq(CurvaX, df = 4)
PoligX <- seq(ValChi, 45, length=100)
PoligY <- dchisq(PoligX, df=4)
# Crea el gráfico con plotly
plot_ly() %>%
# Agrega la curva de la distribución xi
add_lines(x = CurvaX, y= CurvaY, color = I("green"), name = "Distribución") %>%
# Agrega el polígono sombreado
add_trace(x = c(PoligX, rev(PoligX)), y = c(PoligY, rep(0, length(PoligY))),
fill = 'tozeroy', fillcolor = 'rgba(0,0,255,0.2)',
line = list(color = 'transparent'), mode = "none",
name = "Valor Xi") %>%
# Agrega el el límite
add_segments(x = Limite, xend = Limite, y = 0, yend = dchisq(Limite, df = 4),
line = list(color = 'red', width = 2), name = "Límite") %>%
# Añade el texto para los valores
add_text(x = ValChi+1, y = 0.08, text = paste("Xi^2:\n", round(ValChi, 4)),
textfont = list(color = "blue", size = 15), showlegend = FALSE) %>%
add_text(x = Limite, y = 0.05, text = paste("Límite:\n", round(Limite, 4)),
textfont = list(color = "red", size = 15), showlegend = FALSE) %>%
add_text(x = 20, y = 0.1, text = paste("p-value:\n", round(ResuChi$p.value, 5)),
textfont = list(color = "black", size = 20), showlegend = FALSE) %>%
# Estetica de texto
layout(title = list(text = "<b>Distribución Xi^2 sobre conocer R y porgramar</b>",
font = list(size = 20)),
xaxis = list(title = "<b>Valores de Xi</b>",
tickfont = list(size = 15)),
yaxis = list(title = "<b>Densidad</b>",
tickfont = list(size = 15)))
})
# crea un texto para hipotesis
output$hipotesis <- renderText({
paste("Se tiene como hipótesis nula que el conocimiento de programación no tiene relación alguna con conocer el software R.",
"_______________",
"Si el valor del p-value [", round(ResuChi$p.value, 4), "] es menor que 0.5 se rechaza la hipótesis\n",
"o si gráficamente el sombreado se encuentra a la izquierda del valor de color rojo")
})
# Muestra el resumen de Xi en forma de codigo
output$ResumenXi <- renderPrint({
ResuChi
})Con la séptima pregunta se busco añadir una variable numérica y una nominal para realizar un análisis ANOVA, se usó la variable anterior del plantel de procedencia, se tenia como meta refutar una hipótesis y la otra no, la que se pretendía refutar era la relación entre la edad y el plantel haciendo énfasis en que es de posgrado una de las respuestas, la hipótesis que no se quería refutar era la relación entre la edad y el genero
# Combinar los datos anteriores con la nueva selección
EdadMix <- c(DatosEncuesta()$Edad, input$edad)
GenMix <- c(DatosEncuesta()$Genero, input$genero)
PlanMix <- c(DatosEncuesta()$Plantel, input$plantel)
# Crear un data frame
DataGen <- data.frame(Edad = EdadMix, Genero = GenMix, Plantel = PlanMix)
#hacer el analisis ANOVA
ANOVA <- aov(Edad ~ Genero + Plantel, data = DataGen)
#creando el resumen
ResuANOVA <- summary(ANOVA)
#mostrar resumen
output$ResumenANOVA <- renderPrint({
ResuANOVA
})
output$hipoANOVA <- renderText({
paste("Primera hipótesis: la edad es independiente al género",
"____________________________________________________________________",
"Segunda hipótesis: la edad es independiente del plantel",
"_________________________________________________________________",
"Si se tiene algún valor menor a 0.5 se puede rechazar su correspondiente hipótesis",
"o de forma visual en la gráfica de cajas")
})
# Dividir los datos por género
data_femenino <- subset(DataGen, Genero == "Femenino")
data_masculino <- subset(DataGen, Genero == "Masculino")
# Obtener el rango igual en y
mayorFem <- max(data_femenino$Edad)
mayorMas <- max(data_masculino$Edad)
if (mayorFem > mayorMas) {
Yrango <- 10 + mayorFem
} else
Yrango <- 10 + mayorMas
output$anova <- renderPlotly({ #se cambia renderPlot por renderPlotly si se usa ggplotly
# Grafico para masculino
plot_plantel <- plot_ly(data_masculino, x = ~Plantel, y = ~Edad, type = "box",
color = I("cadetblue4"), name = "Masculino") %>%
add_markers(x = ~Plantel, y = ~Edad, showlegend = FALSE, marker = list(size = 10, opacity = 0.5)) %>%
layout(yaxis = list(range = range(0, Yrango)))
# Grafico para femenino
plot_genero <- plot_ly(data_femenino, x = ~Plantel, y = ~Edad, type = "box",
color = I("deeppink4"), name = "Femenino") %>%
add_markers(x = ~Plantel, y = ~Edad, showlegend = FALSE, marker = list(size = 10, opacity = 0.5)) %>%
layout(yaxis = list(range = range(0, Yrango)))
# Crear subgráficos
subplot(plot_plantel, plot_genero, nrows = 1, titleX = TRUE) %>%
# Estetica de texto
layout(title = list(text = "<b>Gráfica de cajas por plantel y edad, separado por genero</b>",
font = list(size = 20)),
xaxis = list(title = "<b>Plantel</b>",
tickfont = list(size = 15)),
yaxis = list(title = "<b>Edad</b>",
tickfont = list(size = 15)))
})La ultima pregunta era lo que se buscaba analizar, si después de las anteriores demostraciones el usuario estaría interesado en usar R
# Combinar los datos anteriores y nuevo
UsoMix <- c(DatosEncuesta()$Uso, input$uso)
#Calculos para mostrar texto
PersonasSi <- sum(UsoMix == "SI")
PersonasTotales <- length(UsoMix)
PorcentSi <- (PersonasSi/ PersonasTotales) * 100
#cuenta el numero de encuestas
output$encuestados <- renderText({
paste("Eres la persona número", PersonasTotales, " en responder la encuesta")
})
# Muestra el porcentaje de personas que si
output$porcentaje <- renderText({
paste("Hasta este momento se tiene que el ", round(PorcentSi, 2), "porciento de las personas si usarían R después de una demostración")
})
# Obtiene la frecuencia de los datos
FrecUso <- table(UsoMix)
# Para mostrar grafica de pastel
if (!is.null(input$uso)) {
# Crear el diagrama de pastel
output$PastelUso <- renderPlotly({
plot_ly(labels = names(FrecUso), values = ~FrecUso,
type = "pie", marker = list(colors = list("#FF00FF70", "#00FFFF70", "#FFFF0070"))) %>%
layout(title = list(text = "<b>Gráfica de personas que usarian el software R</b>", #en negritas con <b>
font = list(size = 20)))
})Este proyecto no tiene como finalidad generar alguna estadística de respecto a alguna población, solo es demostrativa en las personas que llenaron el formulario.
Aunque no es un trabajo estadístico la encuesta se diseño para una muestra que tenga conocimientos de estadística o que probablemente conozca del software.
Se realizaron pruebas de que la app funcionara correctamente, se encontraron varios errores, los cuales se solucionaron, sin embargo, puede que todavía tenga deficiencias el código.