Encuesta aceptación_Diego

los packages

library("tidyverse")
library("forcats")
library("ggthemes")
library("ggsignif")
library("broom")
library("viridis")
library("viridisLite")

Abro mi df

df <- read.csv("datos diego.csv", header = TRUE, sep=",")

Summary de datos

summary(df)

            M..todo     Pregunta.1      Pregunta.2      Pregunta.3      Pregunta.4   
 Aceptacion ICAV:42   Min.   :2.000   Min.   :2.000   Min.   :3.000   Min.   :3.000  
 Tradicional    :46   1st Qu.:3.000   1st Qu.:3.000   1st Qu.:4.000   1st Qu.:4.000  
                      Median :4.000   Median :4.000   Median :5.000   Median :5.000  
                      Mean   :4.023   Mean   :3.852   Mean   :4.568   Mean   :4.545  
                      3rd Qu.:5.000   3rd Qu.:5.000   3rd Qu.:5.000   3rd Qu.:5.000  
                      Max.   :5.000   Max.   :5.000   Max.   :5.000   Max.   :5.000  
   Pregunta.5      Pregunta.6         Suma        Genero.1H.2M      Genero        Edad      
 Min.   :3.000   Min.   :2.000   Min.   :19.00   Min.   :1.000   Hombre:41   Min.   :20.00  
 1st Qu.:4.000   1st Qu.:3.000   1st Qu.:23.00   1st Qu.:1.000   Mujer :47   1st Qu.:21.00  
 Median :5.000   Median :4.000   Median :25.50   Median :2.000               Median :22.00  
 Mean   :4.545   Mean   :3.852   Mean   :25.39   Mean   :1.534               Mean   :22.09  
 3rd Qu.:5.000   3rd Qu.:5.000   3rd Qu.:28.00   3rd Qu.:2.000               3rd Qu.:23.00  
 Max.   :5.000   Max.   :5.000   Max.   :30.00   Max.   :2.000               Max.   :27.00  
    Estatura    
 Min.   :1.500  
 1st Qu.:1.600  
 Median :1.685  
 Mean   :1.673  
 3rd Qu.:1.740  
 Max.   :1.830  

Agrupo por metodo y calculo promedios y sd

Grafico histograma edad

hist(df$Edad)

Graficas histograma para estatura

hist(df$Estatura)

Grafico para puntaje total y tipo de metodo

df %>% 
ggplot(aes(x=M..todo, y=Suma)) +
  geom_boxplot() +
  xlab("Tipo de metodo") + 
  ylab("Puntaje total encuesta") + 
  ggtitle("Puntaje total por tipo de metodo") +
  theme_classic()+
  geom_signif(comparisons = list(c("Aceptacion ICAV", "Tradicional")),
               map_signif_level = TRUE, textsize = 4)

Existe diferencia entre el método y el puntaje total de encuesta???

t.test(Suma ~ M..todo, data=df) # Existen diferencias

    Welch Two Sample t-test

data:  Suma by M..todo
t = 10.199, df = 85.016, p-value < 2.2e-16
alternative hypothesis: true difference in means is not equal to 0
95 percent confidence interval:
 3.475237 5.158304
sample estimates:
mean in group Aceptacion ICAV     mean in group Tradicional 
                     27.64286                      23.32609 

Algo similar pero filtro por genero

df %>% 
ggplot(aes(x=M..todo, y=Suma, fill=Genero)) +
  scale_fill_manual(values=c("black", "blue")) +
  geom_boxplot() +
  xlab("Tipo metodo") + 
  ylab("Puntaje total encuesta") + 
  ggtitle("Puntaje total por tipo de metodo segun sexo") + 
  theme_classic() + 
  theme(legend.position = "right") + 
  scale_y_continuous(limits = c(0,40)) + 
  theme(axis.title.x = element_text(face="bold", vjust=-0.5, colour="black", size=rel(1))) + 
  theme(axis.title.y = element_text(face="bold", vjust=1.5, colour="black", size=rel(1))) +
  scale_fill_discrete(name="Genero", labels=c("Femenino","Masculino"))

Scale for 'fill' is already present. Adding another scale for 'fill', which will replace the
existing scale.

Existen diferencias entre la suma y el genero ????

t.test(Suma ~ Genero, data=df) #No existen 

    Welch Two Sample t-test

data:  Suma by Genero
t = 0.22709, df = 80.251, p-value = 0.8209
alternative hypothesis: true difference in means is not equal to 0
95 percent confidence interval:
 -1.119901  1.408433
sample estimates:
mean in group Hombre  mean in group Mujer 
            25.46341             25.31915 

Ahora grafico método por estatura y filtro por genero

df %>% 
ggplot(aes(x=M..todo, y=Estatura, fill=Genero)) +
  geom_boxplot() 

existe diferencia entre el método y estatura ??

t.test(Estatura ~ M..todo, data=df) #No existen diferencias

    Welch Two Sample t-test

data:  Estatura by M..todo
t = -0.57897, df = 83.813, p-value = 0.5642
alternative hypothesis: true difference in means is not equal to 0
95 percent confidence interval:
 -0.04632257  0.02543231
sample estimates:
mean in group Aceptacion ICAV     mean in group Tradicional 
                     1.667381                      1.677826 

Modelo de regresion para estatura y suma

model <- lm(df$Estatura ~ df$Suma, data = df)
summary(model)

Call:
lm(formula = df$Estatura ~ df$Suma, data = df)

Residuals:
     Min       1Q   Median       3Q      Max 
-0.16126 -0.06980  0.01020  0.07036  0.16992 

Coefficients:
             Estimate Std. Error t value Pr(>|t|)    
(Intercept)  1.762460   0.078339  22.498   <2e-16 ***
df$Suma     -0.003530   0.003066  -1.152    0.253    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 0.08378 on 86 degrees of freedom
Multiple R-squared:  0.01518,   Adjusted R-squared:  0.003733 
F-statistic: 1.326 on 1 and 86 DF,  p-value: 0.2527

plot(model)

Ahora lo grafico

Ahora reformateo mis datos del df1

long_grafico1 <- df %>% 
gather(key = "Preguntas", value = "Puntaje", Pregunta.1:Pregunta.6)

Ahora selecciono lo que necesito

long2 <- long_grafico1 %>% 
select(M..todo,Preguntas,Puntaje)

Ahora grafico y filtro por pregunta

long2 %>% 
  ggplot(aes(x=M..todo, y=Puntaje, fill= Preguntas)) +
 geom_boxplot()

Ahora grafico y filtro por metodo

long2 %>% 
  ggplot(aes(x=Preguntas, y=Puntaje, fill= M..todo)) +
 geom_boxplot()+
  facet_wrap(~ M..todo) +
  ylab("Puntaje") +
  xlab("Numero de pregunta") +
  ggtitle("Puntaje por preguntas segun tipo de metodo") +
  scale_fill_discrete(name="Metodo") +
  annotate("text", x = 1, y = 6, label = "*", size = 5) +
  annotate("text", x = 2, y = 6, label = "*", size = 5) +
  annotate("text", x = 6, y = 6, label = "*", size = 5) +
   scale_y_continuous(limit = c(0,7)) +
  theme_classic()+
  coord_flip()

aov para preguntas y puntaje

aov <- aov(long2$Puntaje~long2$Preguntas)
summary(aov)

                 Df Sum Sq Mean Sq F value   Pr(>F)    
long2$Preguntas   5   56.5  11.294   17.17 9.66e-16 ***
Residuals       522  343.3   0.658                     
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Ahora donde estan esas diferencias ????

TukeyHSD(aov) 

  Tukey multiple comparisons of means
    95% family-wise confidence level

Fit: aov(formula = long2$Puntaje ~ long2$Preguntas)

$`long2$Preguntas`
                               diff        lwr        upr     p adj
Pregunta.2-Pregunta.1 -1.704545e-01 -0.5201729  0.1792638 0.7306199
Pregunta.3-Pregunta.1  5.454545e-01  0.1957362  0.8951729 0.0001449
Pregunta.4-Pregunta.1  5.227273e-01  0.1730089  0.8724457 0.0003258
Pregunta.5-Pregunta.1  5.227273e-01  0.1730089  0.8724457 0.0003258
Pregunta.6-Pregunta.1 -1.704545e-01 -0.5201729  0.1792638 0.7306199
Pregunta.3-Pregunta.2  7.159091e-01  0.3661907  1.0656275 0.0000001
Pregunta.4-Pregunta.2  6.931818e-01  0.3434634  1.0429002 0.0000004
Pregunta.5-Pregunta.2  6.931818e-01  0.3434634  1.0429002 0.0000004
Pregunta.6-Pregunta.2 -1.776357e-15 -0.3497184  0.3497184 1.0000000
Pregunta.4-Pregunta.3 -2.272727e-02 -0.3724457  0.3269911 0.9999693
Pregunta.5-Pregunta.3 -2.272727e-02 -0.3724457  0.3269911 0.9999693
Pregunta.6-Pregunta.3 -7.159091e-01 -1.0656275 -0.3661907 0.0000001
Pregunta.5-Pregunta.4  1.776357e-15 -0.3497184  0.3497184 1.0000000
Pregunta.6-Pregunta.4 -6.931818e-01 -1.0429002 -0.3434634 0.0000004
Pregunta.6-Pregunta.5 -6.931818e-01 -1.0429002 -0.3434634 0.0000004

en otra visualizacion

long2 %>% 
  ggplot(aes(x = Puntaje)) + 
  geom_histogram(bins = 7) + 
  facet_grid(Preguntas~M..todo)

Ahora reformateo los datos para calcular los promedios por preguntas

long2 %>% 
  group_by(M..todo, Preguntas) %>% 
  summarise( "Promedios" = mean(Puntaje))

Lo tranformo a objeto para poder graficar los promedios

long3 <- long2 %>% 
  group_by(M..todo, Preguntas) %>% 
  summarise( "Promedios" = mean(Puntaje))

Ahora puedo graficar los promedios por pregunta (para col)

long3 %>% 
   ggplot(aes(x=Preguntas, y=Promedios, fill= M..todo, color=M..todo)) +
 geom_col()+
  coord_flip()

Otro grafico

long3 %>% 
   ggplot(aes(x=Preguntas, y=Promedios, fill= M..todo, color=M..todo)) +
 geom_jitter()

long3 %>% 
   ggplot(aes(x=Preguntas, y=Promedios, fill= M..todo, color=M..todo)) +
 geom_col()+
  facet_wrap(~ M..todo)+
  coord_flip()

Abro los datos 2

df2 <- read.csv("datos diego2.csv", header = TRUE, sep=",")

Summary

summary(df2)

         Metodo   EXTENSION.M.D   EXTENSION.B.L   ELIMINACION.TECHO   SOCAVADOS    
 ICAV       :34   Min.   :2.000   Min.   :1.000   Min.   :1.000     Min.   :1.000  
 Tradicional:38   1st Qu.:3.000   1st Qu.:3.000   1st Qu.:2.750     1st Qu.:3.000  
                  Median :4.000   Median :4.000   Median :3.500     Median :4.000  
                  Mean   :3.528   Mean   :3.319   Mean   :3.208     Mean   :3.458  
                  3rd Qu.:4.000   3rd Qu.:4.000   3rd Qu.:4.000     3rd Qu.:4.000  
                  Max.   :4.000   Max.   :4.000   Max.   :4.000     Max.   :4.000  
 AMPLITUD.CERVICAL      SUMA           TIEMPO     
 Min.   :1.000     Min.   : 9.00   Min.   :22.00  
 1st Qu.:2.750     1st Qu.:14.00   1st Qu.:28.00  
 Median :3.000     Median :18.00   Median :32.50  
 Mean   :3.125     Mean   :16.64   Mean   :33.51  
 3rd Qu.:4.000     3rd Qu.:20.00   3rd Qu.:39.25  
 Max.   :4.000     Max.   :20.00   Max.   :45.00  

Veo estructura de mis datos

str(df2)

'data.frame':   72 obs. of  8 variables:
 $ Metodo           : Factor w/ 2 levels "ICAV","Tradicional": 1 1 1 1 1 1 1 1 1 1 ...
 $ EXTENSION.M.D    : int  4 4 2 4 3 4 3 4 4 3 ...
 $ EXTENSION.B.L    : int  4 1 1 4 2 3 2 4 4 3 ...
 $ ELIMINACION.TECHO: int  4 4 1 4 3 3 3 4 4 3 ...
 $ SOCAVADOS        : int  4 1 4 4 3 4 4 4 4 1 ...
 $ AMPLITUD.CERVICAL: int  4 1 1 4 3 4 4 4 4 2 ...
 $ SUMA             : int  20 11 9 20 14 18 16 20 20 12 ...
 $ TIEMPO           : int  35 43 31 25 35 31 32 44 35 41 ...

Grafico para tipo de metodo y puntaje de desempeno

df2 %>% 
  ggplot(aes(x=Metodo, y=SUMA)) +
  geom_boxplot() +
  xlab("Tipo de metodo") + 
  ylab("Puntaje total de desempeno") + 
  ggtitle("Puntaje total del desempeno segun tipo de metodo") +
  theme_classic()

Existen diferencias entre el tipo de metodo y la suma total ???

t.test(df2$SUMA~df2$Metodo)

    Welch Two Sample t-test

data:  df2$SUMA by df2$Metodo
t = -1.1626, df = 66.672, p-value = 0.2492
alternative hypothesis: true difference in means is not equal to 0
95 percent confidence interval:
 -2.5319999  0.6682228
sample estimates:
       mean in group ICAV mean in group Tradicional 
                 16.14706                  17.07895 

Grafico para tipo de metodo y tiempo

df2 %>% 
  ggplot(aes(x=Metodo, y=TIEMPO)) +
  geom_boxplot() +
  xlab("Tipo de metodo") + 
  ylab("Tiempo") + 
  ggtitle("Tiempo segun tipo de metodo") +
  theme_classic()

Existen diferencias entre metodo y tiempo????

t.test(df2$TIEMPO~df2$Metodo)

    Welch Two Sample t-test

data:  df2$TIEMPO by df2$Metodo
t = 1.4595, df = 69.342, p-value = 0.1489
alternative hypothesis: true difference in means is not equal to 0
95 percent confidence interval:
 -0.7669473  4.9496099
sample estimates:
       mean in group ICAV mean in group Tradicional 
                 34.61765                  32.52632 

Modelo regresion entre tiempo y suma total de desempeno

model2 <- lm(df2$TIEMPO ~ df2$SUMA, data = df2)
summary(model2)

Call:
lm(formula = df2$TIEMPO ~ df2$SUMA, data = df2)

Residuals:
     Min       1Q   Median       3Q      Max 
-10.5764  -5.1794  -0.1794   4.8428  12.8206 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept)  40.1202     3.5826  11.198   <2e-16 ***
df2$SUMA     -0.3970     0.2111  -1.881   0.0641 .  
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 6.017 on 70 degrees of freedom
Multiple R-squared:  0.04812,   Adjusted R-squared:  0.03452 
F-statistic: 3.539 on 1 and 70 DF,  p-value: 0.06411

plot(model2)

Lo grafico (lm 2/modelo)