Felipe Maldonado

library(tidyverse)
── Attaching packages ──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────── tidyverse 1.2.1 ──
✔ ggplot2 3.0.0     ✔ purrr   0.2.5
✔ tibble  1.4.2     ✔ dplyr   0.7.6
✔ tidyr   0.8.1     ✔ stringr 1.3.1
✔ readr   1.1.1     ✔ forcats 0.3.0
── Conflicts ─────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()

Dataset

concordancia <- read_csv("https://docs.google.com/spreadsheets/d/e/2PACX-1vRx7CiRoOuuyLcCngFADsks_1_Qn8Hyrjdruz3XoB4jJ0oogdjJu9iJPrj_R5B5a58dQFreGvOtmy3h/pub?gid=1894009846&single=true&output=csv")
Parsed with column specification:
cols(
  `Marca temporal` = col_character(),
  `N° Cuestionario` = col_integer(),
  `Años de ejercicio profesional` = col_integer(),
  Sexo = col_character(),
  `Nivel de Estudios` = col_character(),
  `Cantidad Promedio de Implantes Mensuales` = col_integer(),
  `Cantidad aproximada de implantes instalados` = col_integer(),
  `M1 Grosor V-P` = col_double(),
  `M1 Distacia MD` = col_double(),
  `M1 Altura ósea` = col_double(),
  `M2 Grosor V-P` = col_double(),
  `M2 Distancia M-D` = col_double(),
  `M2 Altura ósea` = col_double()
)
concordancia <- janitor::clean_names(concordancia)
summary(concordancia)
 marca_temporal     n_cuestionario  anos_de_ejercicio_profesional     sexo           nivel_de_estudios  cantidad_promedio_de_implantes_mensuales
 Length:32          Min.   : 1.00   Min.   : 2.00                 Length:32          Length:32          Min.   : 1.000                          
 Class :character   1st Qu.: 8.75   1st Qu.: 7.00                 Class :character   Class :character   1st Qu.: 4.000                          
 Mode  :character   Median :16.50   Median :10.50                 Mode  :character   Mode  :character   Median : 6.000                          
                    Mean   :16.47   Mean   :11.16                                                       Mean   : 7.156                          
                    3rd Qu.:24.00   3rd Qu.:14.00                                                       3rd Qu.: 8.000                          
                    Max.   :32.00   Max.   :24.00                                                       Max.   :30.000                          
 cantidad_aproximada_de_implantes_instalados m1_grosor_v_p   m1_distacia_md   m1_altura_osea  m2_grosor_v_p   m2_distancia_m_d m2_altura_osea 
 Min.   :  20.0                              Min.   :3.500   Min.   : 8.280   Min.   :11.06   Min.   :4.150   Min.   : 7.81    Min.   :11.14  
 1st Qu.:  50.0                              1st Qu.:4.378   1st Qu.: 9.848   1st Qu.:13.96   1st Qu.:4.388   1st Qu.:10.04    1st Qu.:13.54  
 Median : 150.0                              Median :4.565   Median :10.955   Median :14.53   Median :4.540   Median :11.13    Median :14.52  
 Mean   : 363.4                              Mean   :4.578   Mean   :10.959   Mean   :14.55   Mean   :4.575   Mean   :11.09    Mean   :14.35  
 3rd Qu.: 400.0                              3rd Qu.:4.827   3rd Qu.:12.098   3rd Qu.:15.22   3rd Qu.:4.670   3rd Qu.:12.24    3rd Qu.:15.07  
 Max.   :4000.0                              Max.   :5.650   Max.   :13.860   Max.   :17.25   Max.   :5.600   Max.   :13.78    Max.   :17.31  
concordancia %>% 
  ggplot(aes(x = sexo)) + 
  geom_bar()

concordancia %>% 
  ggplot(aes(x = anos_de_ejercicio_profesional)) + 
  geom_histogram(bins = 5)

concordancia %>% 
  ggplot(aes(x = nivel_de_estudios)) + 
  geom_bar()

Bland altman plots

install.packages("BlandAltmanLeh")
Installing package into ‘/home/sergio/R/x86_64-pc-linux-gnu-library/3.4’
(as ‘lib’ is unspecified)
probando la URL 'https://cloud.r-project.org/src/contrib/BlandAltmanLeh_0.3.1.tar.gz'
Content type 'application/x-gzip' length 387698 bytes (378 KB)
==================================================
downloaded 378 KB

* installing *source* package ‘BlandAltmanLeh’ ...
** package ‘BlandAltmanLeh’ successfully unpacked and MD5 sums checked
** R
** inst
** preparing package for lazy loading
** help
*** installing help indices
** building package indices
** installing vignettes
** testing if installed package can be loaded
* DONE (BlandAltmanLeh)

The downloaded source packages are in
    ‘/tmp/RtmpAZWOwl/downloaded_packages’
library(BlandAltmanLeh)

m1_grosor_v_p

bland.altman.plot(concordancia$m1_grosor_v_p, concordancia$m2_grosor_v_p, 
                  graph.sys = "ggplot2")

NA

distancia md

bland.altman.plot(concordancia$m1_distacia_md , concordancia$m2_distancia_m_d , 
                  graph.sys = "ggplot2")

altura ósea

bland.altman.plot(concordancia$m1_altura_osea , concordancia$m2_altura_osea , 
                  graph.sys = "ggplot2")

Nuevas variables

concordancia <- concordancia %>% 
  mutate(grosor = m1_grosor_v_p - m2_grosor_v_p) %>% 
  mutate(distancia = m1_distacia_md - m2_distancia_m_d) %>% 
  mutate(altura = m1_altura_osea - m2_altura_osea)
concordancia %>% 
  gather(key = "variable", value = "valor", grosor:altura) %>% 
  ggplot(aes(x = variable, y = valor)) + 
  geom_boxplot() 

concordancia %>% 
  gather(key = "variable", value = "valor", grosor:altura) %>% 
  ggplot(aes(x = cantidad_promedio_de_implantes_mensuales, y = valor, 
             color = variable)) + 
  geom_point() +
  geom_smooth() + 
  scale_x_log10() 

concordancia %>% 
  gather(key = "variable", value = "valor", grosor:altura) %>% 
  ggplot(aes(x = valor)) + 
  geom_histogram(bins = 7) + 
  facet_grid(variable~sexo)

concordancia %>% 
  ggplot(aes(x = anos_de_ejercicio_profesional, y = cantidad_promedio_de_implantes_mensuales)) + 
  geom_point() + 
  geom_smooth() + 
  scale_y_log10()

concordancia %>% 
  gather(key = "variable", value = "valor", grosor:altura) %>% 
  ggplot(aes(x = cantidad_promedio_de_implantes_mensuales , 
             y = valor, 
             color = variable))  + 
  geom_jitter(alpha = 0.6)

Long

concordancia_long <- concordancia %>% 
  select(c(n_cuestionario, 
           anos_de_ejercicio_profesional, 
           sexo, 
           nivel_de_estudios, 
           cantidad_aproximada_de_implantes_instalados, 
           cantidad_promedio_de_implantes_mensuales, 
           grosor:altura)) %>% 
  gather(key = "variable", value = "valor", grosor:altura)

Agrego valor como abs

concordancia_long <- mutate(concordancia_long, valor_abs = abs(valor))
concordancia_long %>% 
  ggplot(aes(x = valor)) + 
  geom_histogram(bins = 5) + 
  facet_grid(variable~sexo)

names(concordancia_long)
[1] "n_cuestionario"                              "anos_de_ejercicio_profesional"               "sexo"                                       
[4] "nivel_de_estudios"                           "cantidad_aproximada_de_implantes_instalados" "cantidad_promedio_de_implantes_mensuales"   
[7] "variable"                                    "valor"                                       "valor_abs"                                  
m1 <- lm(valor ~ variable +
     sexo + 
     anos_de_ejercicio_profesional + 
     nivel_de_estudios + 
     cantidad_aproximada_de_implantes_instalados + 
     cantidad_promedio_de_implantes_mensuales, 
   data = concordancia_long)
summary(m1)

Call:
lm(formula = valor ~ variable + sexo + anos_de_ejercicio_profesional + 
    nivel_de_estudios + cantidad_aproximada_de_implantes_instalados + 
    cantidad_promedio_de_implantes_mensuales, data = concordancia_long)

Residuals:
    Min      1Q  Median      3Q     Max 
-1.8129 -0.3337 -0.1123  0.2001  5.1325 

Coefficients:
                                              Estimate Std. Error t value Pr(>|t|)    
(Intercept)                                  0.3268457  0.5322723   0.614 0.540780    
variabledistancia                           -0.3225000  0.1971614  -1.636 0.105512    
variablegrosor                              -0.1934375  0.1971614  -0.981 0.329258    
sexoM                                        0.1601921  0.2268620   0.706 0.481999    
anos_de_ejercicio_profesional                0.0044556  0.0223253   0.200 0.842278    
nivel_de_estudiosDiplomado                   0.0749264  0.4794972   0.156 0.876190    
nivel_de_estudiosEspecialidad                0.3785446  0.5059371   0.748 0.456354    
cantidad_aproximada_de_implantes_instalados -0.0003938  0.0001453  -2.709 0.008118 ** 
cantidad_promedio_de_implantes_mensuales    -0.0593747  0.0168639  -3.521 0.000687 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.7886 on 87 degrees of freedom
Multiple R-squared:  0.257, Adjusted R-squared:  0.1886 
F-statistic: 3.761 on 8 and 87 DF,  p-value: 0.0007963
m2 <- lm(valor_abs ~ variable +
     sexo + 
     anos_de_ejercicio_profesional + 
     nivel_de_estudios + 
     cantidad_aproximada_de_implantes_instalados + 
     cantidad_promedio_de_implantes_mensuales, 
   data = concordancia_long)
summary(m2)

Call:
lm(formula = valor_abs ~ variable + sexo + anos_de_ejercicio_profesional + 
    nivel_de_estudios + cantidad_aproximada_de_implantes_instalados + 
    cantidad_promedio_de_implantes_mensuales, data = concordancia_long)

Residuals:
    Min      1Q  Median      3Q     Max 
-0.9211 -0.3119 -0.1322  0.0264  5.1191 

Coefficients:
                                              Estimate Std. Error t value Pr(>|t|)  
(Intercept)                                  0.2301372  0.5260851   0.437   0.6629  
variabledistancia                            0.0231250  0.1948696   0.119   0.9058  
variablegrosor                              -0.2796875  0.1948696  -1.435   0.1548  
sexoM                                        0.2748686  0.2242250   1.226   0.2236  
anos_de_ejercicio_profesional               -0.0194449  0.0220658  -0.881   0.3806  
nivel_de_estudiosDiplomado                  -0.0227322  0.4739235  -0.048   0.9619  
nivel_de_estudiosEspecialidad                0.0523586  0.5000561   0.105   0.9169  
cantidad_aproximada_de_implantes_instalados  0.0003004  0.0001436   2.092   0.0394 *
cantidad_promedio_de_implantes_mensuales     0.0118330  0.0166679   0.710   0.4796  
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.7795 on 87 degrees of freedom
Multiple R-squared:  0.1087,    Adjusted R-squared:  0.02674 
F-statistic: 1.326 on 8 and 87 DF,  p-value: 0.2413
LS0tCnRpdGxlOiAiQ29uY29yZGFuY2lhIG1lZGljaW9uZXMiCm91dHB1dDogaHRtbF9ub3RlYm9vawotLS0KRmVsaXBlIE1hbGRvbmFkbwoKYGBge3J9CmxpYnJhcnkodGlkeXZlcnNlKQpgYGAKCiMgRGF0YXNldApgYGB7ciBkYXRhc2V0fQpjb25jb3JkYW5jaWEgPC0gcmVhZF9jc3YoImh0dHBzOi8vZG9jcy5nb29nbGUuY29tL3NwcmVhZHNoZWV0cy9kL2UvMlBBQ1gtMXZSeDdDaVJvT3V1eUxjQ25nRkFEc2tzXzFfUW44SHlyamRydXozWG9CNGpKMG9vZ2RqSnU5aUpQcmpfUjVCNWE1OGRRRnJlR3ZPdG15M2gvcHViP2dpZD0xODk0MDA5ODQ2JnNpbmdsZT10cnVlJm91dHB1dD1jc3YiKQpgYGAKCmBgYHtyIGNsZWFuIG5hbWVzfQpjb25jb3JkYW5jaWEgPC0gamFuaXRvcjo6Y2xlYW5fbmFtZXMoY29uY29yZGFuY2lhKQpgYGAKCmBgYHtyfQpzdW1tYXJ5KGNvbmNvcmRhbmNpYSkKYGBgCgoKYGBge3J9CmNvbmNvcmRhbmNpYSAlPiUgCiAgZ2dwbG90KGFlcyh4ID0gc2V4bykpICsgCiAgZ2VvbV9iYXIoKQpgYGAKYGBge3J9CmNvbmNvcmRhbmNpYSAlPiUgCiAgZ2dwbG90KGFlcyh4ID0gYW5vc19kZV9lamVyY2ljaW9fcHJvZmVzaW9uYWwpKSArIAogIGdlb21faGlzdG9ncmFtKGJpbnMgPSA1KQpgYGAKYGBge3J9CmNvbmNvcmRhbmNpYSAlPiUgCiAgZ2dwbG90KGFlcyh4ID0gbml2ZWxfZGVfZXN0dWRpb3MpKSArIAogIGdlb21fYmFyKCkKYGBgCgojIEJsYW5kIGFsdG1hbiBwbG90cwoKCmBgYHtyfQppbnN0YWxsLnBhY2thZ2VzKCJCbGFuZEFsdG1hbkxlaCIpCmxpYnJhcnkoQmxhbmRBbHRtYW5MZWgpCmBgYAoKIyMgbTFfZ3Jvc29yX3ZfcAoKCmBgYHtyfQpibGFuZC5hbHRtYW4ucGxvdChjb25jb3JkYW5jaWEkbTFfZ3Jvc29yX3ZfcCwgY29uY29yZGFuY2lhJG0yX2dyb3Nvcl92X3AsIAogICAgICAgICAgICAgICAgICBncmFwaC5zeXMgPSAiZ2dwbG90MiIpCiAgCmBgYAojIyBkaXN0YW5jaWEgbWQKYGBge3J9CmJsYW5kLmFsdG1hbi5wbG90KGNvbmNvcmRhbmNpYSRtMV9kaXN0YWNpYV9tZCAsIGNvbmNvcmRhbmNpYSRtMl9kaXN0YW5jaWFfbV9kICwgCiAgICAgICAgICAgICAgICAgIGdyYXBoLnN5cyA9ICJnZ3Bsb3QyIikKYGBgCgojIyBhbHR1cmEgw7NzZWEKYGBge3J9CmJsYW5kLmFsdG1hbi5wbG90KGNvbmNvcmRhbmNpYSRtMV9hbHR1cmFfb3NlYSAsIGNvbmNvcmRhbmNpYSRtMl9hbHR1cmFfb3NlYSAsIAogICAgICAgICAgICAgICAgICBncmFwaC5zeXMgPSAiZ2dwbG90MiIpCmBgYAoKIyBOdWV2YXMgdmFyaWFibGVzCgpgYGB7cn0KY29uY29yZGFuY2lhIDwtIGNvbmNvcmRhbmNpYSAlPiUgCiAgbXV0YXRlKGdyb3NvciA9IG0xX2dyb3Nvcl92X3AgLSBtMl9ncm9zb3Jfdl9wKSAlPiUgCiAgbXV0YXRlKGRpc3RhbmNpYSA9IG0xX2Rpc3RhY2lhX21kIC0gbTJfZGlzdGFuY2lhX21fZCkgJT4lIAogIG11dGF0ZShhbHR1cmEgPSBtMV9hbHR1cmFfb3NlYSAtIG0yX2FsdHVyYV9vc2VhKQpgYGAKCmBgYHtyfQpjb25jb3JkYW5jaWEgJT4lIAogIGdhdGhlcihrZXkgPSAidmFyaWFibGUiLCB2YWx1ZSA9ICJ2YWxvciIsIGdyb3NvcjphbHR1cmEpICU+JSAKICBnZ3Bsb3QoYWVzKHggPSB2YXJpYWJsZSwgeSA9IHZhbG9yKSkgKyAKICBnZW9tX2JveHBsb3QoKSAKYGBgCgpgYGB7cn0KY29uY29yZGFuY2lhICU+JSAKICBnYXRoZXIoa2V5ID0gInZhcmlhYmxlIiwgdmFsdWUgPSAidmFsb3IiLCBncm9zb3I6YWx0dXJhKSAlPiUgCiAgZ2dwbG90KGFlcyh4ID0gY2FudGlkYWRfcHJvbWVkaW9fZGVfaW1wbGFudGVzX21lbnN1YWxlcywgeSA9IHZhbG9yLCAKICAgICAgICAgICAgIGNvbG9yID0gdmFyaWFibGUpKSArIAogIGdlb21fcG9pbnQoKSArCiAgZ2VvbV9zbW9vdGgoKSArIAogIHNjYWxlX3hfbG9nMTAoKSAKYGBgCmBgYHtyfQpjb25jb3JkYW5jaWEgJT4lIAogIGdhdGhlcihrZXkgPSAidmFyaWFibGUiLCB2YWx1ZSA9ICJ2YWxvciIsIGdyb3NvcjphbHR1cmEpICU+JSAKICBnZ3Bsb3QoYWVzKHggPSB2YWxvcikpICsgCiAgZ2VvbV9oaXN0b2dyYW0oYmlucyA9IDcpICsgCiAgZmFjZXRfZ3JpZCh2YXJpYWJsZX5zZXhvKQoKYGBgCgpgYGB7cn0KY29uY29yZGFuY2lhICU+JSAKICBnZ3Bsb3QoYWVzKHggPSBhbm9zX2RlX2VqZXJjaWNpb19wcm9mZXNpb25hbCwgeSA9IGNhbnRpZGFkX3Byb21lZGlvX2RlX2ltcGxhbnRlc19tZW5zdWFsZXMpKSArIAogIGdlb21fcG9pbnQoKSArIAogIGdlb21fc21vb3RoKCkgKyAKICBzY2FsZV95X2xvZzEwKCkKYGBgCgpgYGB7cn0KY29uY29yZGFuY2lhICU+JSAKICBnYXRoZXIoa2V5ID0gInZhcmlhYmxlIiwgdmFsdWUgPSAidmFsb3IiLCBncm9zb3I6YWx0dXJhKSAlPiUgCiAgZ2dwbG90KGFlcyh4ID0gY2FudGlkYWRfcHJvbWVkaW9fZGVfaW1wbGFudGVzX21lbnN1YWxlcyAsIAogICAgICAgICAgICAgeSA9IHZhbG9yLCAKICAgICAgICAgICAgIGNvbG9yID0gdmFyaWFibGUpKSAgKyAKICBnZW9tX2ppdHRlcihhbHBoYSA9IDAuNikKYGBgCgojIExvbmcKYGBge3J9CmNvbmNvcmRhbmNpYV9sb25nIDwtIGNvbmNvcmRhbmNpYSAlPiUgCiAgc2VsZWN0KGMobl9jdWVzdGlvbmFyaW8sIAogICAgICAgICAgIGFub3NfZGVfZWplcmNpY2lvX3Byb2Zlc2lvbmFsLCAKICAgICAgICAgICBzZXhvLCAKICAgICAgICAgICBuaXZlbF9kZV9lc3R1ZGlvcywgCiAgICAgICAgICAgY2FudGlkYWRfYXByb3hpbWFkYV9kZV9pbXBsYW50ZXNfaW5zdGFsYWRvcywgCiAgICAgICAgICAgY2FudGlkYWRfcHJvbWVkaW9fZGVfaW1wbGFudGVzX21lbnN1YWxlcywgCiAgICAgICAgICAgZ3Jvc29yOmFsdHVyYSkpICU+JSAKICBnYXRoZXIoa2V5ID0gInZhcmlhYmxlIiwgdmFsdWUgPSAidmFsb3IiLCBncm9zb3I6YWx0dXJhKQpgYGAKCgpBZ3JlZ28gdmFsb3IgY29tbyBhYnMKYGBge3J9CmNvbmNvcmRhbmNpYV9sb25nIDwtIG11dGF0ZShjb25jb3JkYW5jaWFfbG9uZywgdmFsb3JfYWJzID0gYWJzKHZhbG9yKSkKYGBgCgoKYGBge3J9CmNvbmNvcmRhbmNpYV9sb25nICU+JSAKICBnZ3Bsb3QoYWVzKHggPSB2YWxvcikpICsgCiAgZ2VvbV9oaXN0b2dyYW0oYmlucyA9IDUpICsgCiAgZmFjZXRfZ3JpZCh2YXJpYWJsZX5zZXhvKQpgYGAKCmBgYHtyfQpuYW1lcyhjb25jb3JkYW5jaWFfbG9uZykKYGBgCgpgYGB7cn0KCm0xIDwtIGxtKHZhbG9yIH4gdmFyaWFibGUgKwogICAgIHNleG8gKyAKICAgICBhbm9zX2RlX2VqZXJjaWNpb19wcm9mZXNpb25hbCArIAogICAgIG5pdmVsX2RlX2VzdHVkaW9zICsgCiAgICAgY2FudGlkYWRfYXByb3hpbWFkYV9kZV9pbXBsYW50ZXNfaW5zdGFsYWRvcyArIAogICAgIGNhbnRpZGFkX3Byb21lZGlvX2RlX2ltcGxhbnRlc19tZW5zdWFsZXMsIAogICBkYXRhID0gY29uY29yZGFuY2lhX2xvbmcpCmBgYAoKYGBge3J9CnN1bW1hcnkobTEpCmBgYAoKYGBge3J9Cm0yIDwtIGxtKHZhbG9yX2FicyB+IHZhcmlhYmxlICsKICAgICBzZXhvICsgCiAgICAgYW5vc19kZV9lamVyY2ljaW9fcHJvZmVzaW9uYWwgKyAKICAgICBuaXZlbF9kZV9lc3R1ZGlvcyArIAogICAgIGNhbnRpZGFkX2Fwcm94aW1hZGFfZGVfaW1wbGFudGVzX2luc3RhbGFkb3MgKyAKICAgICBjYW50aWRhZF9wcm9tZWRpb19kZV9pbXBsYW50ZXNfbWVuc3VhbGVzLCAKICAgZGF0YSA9IGNvbmNvcmRhbmNpYV9sb25nKQpgYGAKYGBge3J9CnN1bW1hcnkobTIpCmBgYAoK