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:

library(readxl)
fede <- read_excel("fede.xlsx", sheet = "R")
## New names:
## • `` -> `...17`
## • `` -> `...23`
View(fede)

fede <- fede %>% mutate_if(is.character, as.factor)

Edad y días de evolución

mean(fede$EDAD)
## [1] 49.4
summary(fede$EDAD)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    38.0    43.5    49.0    49.4    55.5    62.0
describe(fede$EDAD)
##    vars  n mean   sd median trimmed  mad min max range skew kurtosis   se
## X1    1 15 49.4 8.02     49    49.3 10.4  38  62    24 0.06    -1.37 2.07
describe(fede$DIASEVOL)
##    vars  n mean  sd median trimmed  mad min  max range skew kurtosis   se
## X1    1 15  198 281     92     143 29.6  45 1072  1027  2.2     3.67 72.5
summary(fede$DIASEVOL)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##      45      82      92     198     116    1072
fede$MET <- as.numeric(as.character(fede$METATARSIANO))
fede$MET<-as.factor(fede$MET)

Localizació de las lesiones y sexo

summary(fede$MET)
## 1 2 3 4 5 
## 2 3 3 5 2
summary(fede$sexo)
##  f  m 
##  4 11
prop.table(table(fede$MET)) * 100
## 
##    1    2    3    4    5 
## 13.3 20.0 20.0 33.3 13.3
prop.table(table(fede$sexo)) * 100
## 
##    f    m 
## 26.7 73.3

Días de evolucióin y HbA1c

describe(fede$DIASEVOL)
##    vars  n mean  sd median trimmed  mad min  max range skew kurtosis   se
## X1    1 15  198 281     92     143 29.6  45 1072  1027  2.2     3.67 72.5
quantile(fede$DIASEVOL,0.25,0.75)
##  25% 
## 81.5
quantile(fede$DIASEVOL,0.75)
## 75% 
## 116
describe(fede$HBA1C)
##    vars  n mean   sd median trimmed  mad min  max range skew kurtosis   se
## X1    1 15 9.07 1.86      9    8.96 1.63 6.4 13.2   6.8 0.52    -0.47 0.48
quantile(fede$HBA1C,0.25,0.75)
## 25% 
##   8
quantile(fede$HBA1C,0.75)
## 75% 
## 9.9

Gráfico de HbA1C

library(ggplot2)

ggplot(fede, aes(x = HBA1C)) +
geom_density(fill = "skyblue", alpha = 0.5) +
labs(title = "Distribución de HBA1C",
x = "HBA1C",
y = "Densidad") +
theme_minimal()

ITB

describe(fede$ITB)
##    vars  n mean   sd median trimmed  mad  min  max range  skew kurtosis   se
## X1    1 11 1.12 0.22    1.2    1.14 0.19 0.61 1.43  0.82 -0.78     -0.1 0.07

Temperatura de los pies pos cirugía

describe(fede$`TERMO PIE AFECTADO`)
##    vars  n mean   sd median trimmed  mad  min  max range  skew kurtosis   se
## X1    1 14 28.9 2.88   30.4    29.1 1.48 23.9 31.6   7.7 -0.66    -1.35 0.77
describe(fede$`TERMO PIE CONTRA`)
##    vars  n mean   sd median trimmed  mad  min  max range skew kurtosis   se
## X1    1 13 26.9 2.37   26.3    26.9 1.63 22.8 31.2   8.4 0.22    -0.96 0.66

Comparación de temperaturas

termoa = fede$`TERMO PIE AFECTADO`
termoc=fede$`TERMO PIE CONTRA`
termo<-c(termoa,termoc)
describe(termoa)
##    vars  n mean   sd median trimmed  mad  min  max range  skew kurtosis   se
## X1    1 14 28.9 2.88   30.4    29.1 1.48 23.9 31.6   7.7 -0.66    -1.35 0.77
describe(termoc)
##    vars  n mean   sd median trimmed  mad  min  max range skew kurtosis   se
## X1    1 13 26.9 2.37   26.3    26.9 1.63 22.8 31.2   8.4 0.22    -0.96 0.66
shapiro.test(termoa)
## 
##  Shapiro-Wilk normality test
## 
## data:  termoa
## W = 0.8, p-value = 0.007
shapiro.test(termoc)
## 
##  Shapiro-Wilk normality test
## 
## data:  termoc
## W = 1, p-value = 0.9
# los vectores tienen igual longitud
valores <- c(termoa, termoc)
grupo <- c(rep("termoa", length(termoa)), rep("termoc", length(termoc)))

datos <- data.frame(grupo = grupo, temperatura = valores)

# T test
t.test(temperatura ~ grupo, data = datos)
## 
##  Welch Two Sample t-test
## 
## data:  temperatura by grupo
## t = 2, df = 25, p-value = 0.07
## alternative hypothesis: true difference in means between group termoa and group termoc is not equal to 0
## 95 percent confidence interval:
##  -0.139  4.033
## sample estimates:
## mean in group termoa mean in group termoc 
##                 28.9                 26.9
library(ggbeeswarm)
## Warning: package 'ggbeeswarm' was built under R version 4.4.3
library(ggplot2)

ggplot(datos, aes(x = grupo, y = temperatura, color = grupo)) +
  geom_beeswarm(size = 2.5, alpha = 0.8) +
  theme_minimal() +
  labs(title = "Beeswarm plot de temperatura por grupo",
       x = "Grupo", y = "Temperatura")
## Warning: Removed 3 rows containing missing values or values outside the scale range
## (`geom_point()`).

#violin
library(ggplot2)
library(ggpubr)
library(dplyr)

ggplot(datos, aes(x = grupo, y = valores, fill = grupo)) +
  geom_violin()    # Los NA en 'valor' se omiten
## Warning: Removed 3 rows containing non-finite outside the scale range
## (`stat_ydensity()`).

#curva de sobrevida/tiempoa la cicatrización
#mediana de cicatrización
describe(fede$`dias al cierre`)
##    vars  n mean   sd median trimmed  mad min max range skew kurtosis   se
## X1    1 15 50.9 40.7     43    44.6 23.7   9 174   165 1.71      2.8 10.5
fede$dias_cierre=fede$`dias al cierre`

quantile(fede$dias_cierre,0.25,0.75)
##  25% 
## 26.5
quantile(fede$dias_cierre,0.75)
## 75% 
##  59

Dias de seguimiento

describe(fede$`DIAS SEGUIMIENTO`)
##    vars  n mean  sd median trimmed mad min max range skew kurtosis   se
## X1    1 15  192 130    193     181 145  30 492   462 0.64     -0.5 33.6
fede$dias_seg=fede$`DIAS SEGUIMIENTO`
quantile(fede$dias_seg,0.25,0.75)
## 25% 
##  89
quantile(fede$dias_seg,0.75)
## 75% 
## 266
fede$dias_seg
##  [1] 193 254 207 346 316 159 492  58 279  98  95 214  83  51  30
fede$cicat<-c(rep(1,15))
#sobrevida

library(survival)
library(survminer)

# Objeto de supervivencia
surv_obj <- Surv(time = fede$dias_cierre, event = fede$cicat)

# Ajustar modelo de Kaplan-Meier
km_fit <- survfit(surv_obj ~ 1)

ggsurvplot(km_fit,
           data = fede,
           conf.int = TRUE,               # Intervalos de confianza
           pval = FALSE,                  # No muestra valor p porque no hay grupos
           risk.table = TRUE,            # Tabla de pacientes en riesgo
           xlab = "Días hasta cicatrización",
           ylab = "Probabilidad de no cicatrizar",
           title = "Curva de sobrevida (Kaplan-Meier)",
           palette = "blue",
           break.time.by = 10)           # Ajustá según tu escala de tiempo

#ascendente
ggsurvplot(km_fit,
           data = fede,
           conf.int = TRUE,
           fun = "event",                # Muestra 1 - S(t), es decir, eventos acumulados
           risk.table = TRUE,
           xlab = "Días hasta cicatrización",
           ylab = "Proporción de pacientes cicatrizados",
           title = "Curva de cicatrización acumulada",
           palette = "darkgreen")

Outcome

fede$outcome=fede$...23
summary(fede$outcome)
## CERRADO   REULC 
##      12       3