# Paquetes necesarios
packages <- c("tidyverse","lubridate","survival","survminer","tableone",
"mice","VIM","ggplot2","gridExtra","broom","MASS","car")
new.packages <- packages[!(packages %in% installed.packages()[,"Package"])]
if(length(new.packages)) install.packages(new.packages)
lapply(packages, require, character.only = TRUE)
## [[1]]
## [1] TRUE
##
## [[2]]
## [1] TRUE
##
## [[3]]
## [1] TRUE
##
## [[4]]
## [1] TRUE
##
## [[5]]
## [1] TRUE
##
## [[6]]
## [1] TRUE
##
## [[7]]
## [1] TRUE
##
## [[8]]
## [1] TRUE
##
## [[9]]
## [1] TRUE
##
## [[10]]
## [1] TRUE
##
## [[11]]
## [1] TRUE
##
## [[12]]
## [1] TRUE
options(dplyr.print_min = 6)
# Ajustamos a ruta
df <- read_csv("new_york_city.csv", guess_max = 10000)
## New names:
## Rows: 300000 Columns: 9
## ── Column specification
## ──────────────────────────────────────────────────────── Delimiter: "," chr
## (6): Start Time, End Time, Start Station, End Station, User Type, Gender dbl
## (3): ...1, Trip Duration, Birth Year
## ℹ Use `spec()` to retrieve the full column specification for this data. ℹ
## Specify the column types or set `show_col_types = FALSE` to quiet this message.
## • `` -> `...1`
glimpse(df)
## Rows: 300,000
## Columns: 9
## $ ...1 <dbl> 33, 47, 49, 55, 76, 81, 89, 129, 138, 179, 217, 224, 2…
## $ `Start Time` <chr> "01/01/2024 00:13", "01/01/2024 00:17", "01/01/2024 00…
## $ `End Time` <chr> "01/01/2024 00:52", "01/01/2024 00:32", "01/01/2024 00…
## $ `Trip Duration` <dbl> 2325, 919, 1471, 718, 1142, 285, 2339, 146, 659, 306, …
## $ `Start Station` <chr> "8 Ave & W 31 St", "W 27 St & 7 Ave", "Grand Army Plaz…
## $ `End Station` <chr> "S 5 Pl & S 4 St", "E 17 St & Broadway", "Clinton Ave …
## $ `User Type` <chr> "Subscriber", "Customer", "Customer", "Subscriber", "S…
## $ Gender <chr> "Female", NA, NA, "Male", "Female", "Male", "Male", "M…
## $ `Birth Year` <dbl> 1980, NA, NA, 1963, 1982, 1942, 1970, 1996, 1976, 1994…
str(df)
## spc_tbl_ [300,000 × 9] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ ...1 : num [1:300000] 33 47 49 55 76 81 89 129 138 179 ...
## $ Start Time : chr [1:300000] "01/01/2024 00:13" "01/01/2024 00:17" "01/01/2024 00:17" "01/01/2024 00:17" ...
## $ End Time : chr [1:300000] "01/01/2024 00:52" "01/01/2024 00:32" "01/01/2024 00:41" "01/01/2024 00:29" ...
## $ Trip Duration: num [1:300000] 2325 919 1471 718 1142 ...
## $ Start Station: chr [1:300000] "8 Ave & W 31 St" "W 27 St & 7 Ave" "Grand Army Plaza & Plaza St West" "E 85 St & 3 Ave" ...
## $ End Station : chr [1:300000] "S 5 Pl & S 4 St" "E 17 St & Broadway" "Clinton Ave & Flushing Ave" "E 75 St & 3 Ave" ...
## $ User Type : chr [1:300000] "Subscriber" "Customer" "Customer" "Subscriber" ...
## $ Gender : chr [1:300000] "Female" NA NA "Male" ...
## $ Birth Year : num [1:300000] 1980 NA NA 1963 1982 ...
## - attr(*, "spec")=
## .. cols(
## .. ...1 = col_double(),
## .. `Start Time` = col_character(),
## .. `End Time` = col_character(),
## .. `Trip Duration` = col_double(),
## .. `Start Station` = col_character(),
## .. `End Station` = col_character(),
## .. `User Type` = col_character(),
## .. Gender = col_character(),
## .. `Birth Year` = col_double()
## .. )
## - attr(*, "problems")=<externalptr>
summary(df)
## ...1 Start Time End Time Trip Duration
## Min. : 33 Length:300000 Length:300000 Min. : 61.0
## 1st Qu.:1707416 Class :character Class :character 1st Qu.: 368.0
## Median :3405756 Mode :character Mode :character Median : 609.0
## Mean :3407026 Mean : 899.7
## 3rd Qu.:5108762 3rd Qu.: 1054.0
## Max. :6816152 Max. :2155775.0
##
## Start Station End Station User Type Gender
## Length:300000 Length:300000 Length:300000 Length:300000
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
##
## Birth Year
## Min. :1885
## 1st Qu.:1970
## Median :1981
## Mean :1978
## 3rd Qu.:1988
## Max. :2001
## NA's :28220
# Mostrar las primeras filas
head(df, 10)
## # A tibble: 10 × 9
## ...1 `Start Time` `End Time` `Trip Duration` `Start Station` `End Station`
## <dbl> <chr> <chr> <dbl> <chr> <chr>
## 1 33 01/01/2024 00… 01/01/202… 2325 8 Ave & W 31 St S 5 Pl & S 4…
## 2 47 01/01/2024 00… 01/01/202… 919 W 27 St & 7 Ave E 17 St & Br…
## 3 49 01/01/2024 00… 01/01/202… 1471 Grand Army Pla… Clinton Ave …
## 4 55 01/01/2024 00… 01/01/202… 718 E 85 St & 3 Ave E 75 St & 3 …
## 5 76 01/01/2024 00… 01/01/202… 1142 3 St & Prospec… S Portland A…
## 6 81 01/01/2024 00… 01/01/202… 285 Clark St & Hen… Schermerhorn…
## 7 89 01/01/2024 00… 01/01/202… 2339 5 Ave & E 78 St E 25 St & 1 …
## 8 129 01/01/2024 00… 01/01/202… 146 Clinton St & C… Columbia St …
## 9 138 01/01/2024 00… 01/01/202… 659 E 61 St & Park… 1 Ave & E 78…
## 10 179 01/01/2024 00… 01/01/202… 306 Broadway & E 1… W 18 St & 6 …
## # ℹ 3 more variables: `User Type` <chr>, Gender <chr>, `Birth Year` <dbl>
head(df)
## # A tibble: 6 × 9
## ...1 `Start Time` `End Time` `Trip Duration` `Start Station` `End Station`
## <dbl> <chr> <chr> <dbl> <chr> <chr>
## 1 33 01/01/2024 00:… 01/01/202… 2325 8 Ave & W 31 St S 5 Pl & S 4…
## 2 47 01/01/2024 00:… 01/01/202… 919 W 27 St & 7 Ave E 17 St & Br…
## 3 49 01/01/2024 00:… 01/01/202… 1471 Grand Army Pla… Clinton Ave …
## 4 55 01/01/2024 00:… 01/01/202… 718 E 85 St & 3 Ave E 75 St & 3 …
## 5 76 01/01/2024 00:… 01/01/202… 1142 3 St & Prospec… S Portland A…
## 6 81 01/01/2024 00:… 01/01/202… 285 Clark St & Hen… Schermerhorn…
## # ℹ 3 more variables: `User Type` <chr>, Gender <chr>, `Birth Year` <dbl>
### eliminé los renglones que contenían na, porque justo tenían na en las variables que nos interesan, y eso marca sesgos y deja huellas en las gráficas
df_sin_na <- drop_na(df)
head(df_sin_na)
## # A tibble: 6 × 9
## ...1 `Start Time` `End Time` `Trip Duration` `Start Station` `End Station`
## <dbl> <chr> <chr> <dbl> <chr> <chr>
## 1 33 01/01/2024 00:… 01/01/202… 2325 8 Ave & W 31 St S 5 Pl & S 4…
## 2 55 01/01/2024 00:… 01/01/202… 718 E 85 St & 3 Ave E 75 St & 3 …
## 3 76 01/01/2024 00:… 01/01/202… 1142 3 St & Prospec… S Portland A…
## 4 81 01/01/2024 00:… 01/01/202… 285 Clark St & Hen… Schermerhorn…
## 5 89 01/01/2024 00:… 01/01/202… 2339 5 Ave & E 78 St E 25 St & 1 …
## 6 129 01/01/2024 00:… 01/01/202… 146 Clinton St & C… Columbia St …
## # ℹ 3 more variables: `User Type` <chr>, Gender <chr>, `Birth Year` <dbl>
#### =================== TIEMPO DE VIAJE ================
### estadistica descriptiva de la duración del viaje, marca minimo, mediana, media, primer y tercer cuartil y máximo
summary(df_sin_na$`Trip Duration`)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 61.0 352.0 571.0 799.8 956.0 2155775.0
### Se detectaron valores atípicos en la variable duración del viaje, con registros superiores a 24 días, lo cual no es realista para el uso de bicicletas. Por ello, se aplicó un filtro utilizando el método del Rango Intercuartílico (IQR) para depurar los datos y obtener estadísticas más representativas
Q1 <- quantile(df_sin_na$`Trip Duration`, 0.25, na.rm = TRUE)
Q3 <- quantile(df_sin_na$`Trip Duration`, 0.75, na.rm = TRUE)
IQR_val <- IQR(df_sin_na$`Trip Duration`, na.rm = TRUE)
limite_superior <- Q3 + 1.5 * IQR_val
limite_inferior <- Q1 - 1.5 * IQR_val
limite_superior
## 75%
## 1862
sum(df_sin_na$`Trip Duration` > limite_superior, na.rm = TRUE)
## [1] 13754
datos_limpios <- df_sin_na[df_sin_na$`Trip Duration` <= limite_superior, ]
summary(datos_limpios$`Trip Duration`)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 61.0 342.0 545.0 651.5 874.0 1862.0
ggplot(datos_limpios, aes(y = `Trip Duration`)) +
geom_boxplot(fill = "#3498DB", color = "white") +
labs(
title = "Distribución de la duración de los viajes",
y = "Duración del viaje (segundos)"
) +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, face = "bold")
)
ggplot(datos_limpios, aes(x = `Trip Duration`)) +
geom_histogram(fill = "#2ECC71", bins = 30, color = "white") +
labs(
title = "Histograma de la duración de los viajes",
x = "Duración del viaje (segundos)",
y = "Frecuencia"
) +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, face = "bold")
)
# Antes
ggplot(df_sin_na, aes(y = `Trip Duration`)) +
geom_boxplot(fill = "tomato") +
labs(title = "Antes de eliminar outliers") +
theme_minimal()
# Después
ggplot(datos_limpios, aes(y = `Trip Duration`)) +
geom_boxplot(fill = "steelblue") +
labs(title = "Después de eliminar outliers") +
theme_minimal()
#CONCLUSIÓN DEL TIEMPOI DE VIAJE
#Se identificaron valores atípicos en la variable duración del viaje mediante el método del rango intercuartílico (IQR). Tras eliminar observaciones superiores al límite Q3 + 1.5·IQR, la distribución resultante presenta una forma más compacta y representativa del comportamiento real de los usuarios.
# ================== TIPO DE USUARIO =====================
## tipo de usuario, cuantos de cada tipo
table(datos_limpios$`User Type`)
##
## Customer Subscriber
## 3591 252757
prop.table(table(datos_limpios$`User Type`))
##
## Customer Subscriber
## 0.0140083 0.9859917
# Crear tabla
tabla_usuario <- as.data.frame(table(datos_limpios$`User Type`))
colnames(tabla_usuario) <- c("Tipo", "Frecuencia")
# Calcular porcentajes
tabla_usuario$Porcentaje <- round(tabla_usuario$Frecuencia / sum(tabla_usuario$Frecuencia) * 100, 1)
# Gráfica de pastel
etiquetas <- paste0(
ifelse(tabla_usuario$Tipo == "Customer", "Cliente", "Suscriptor"),
" (", tabla_usuario$Porcentaje, "%)"
)
ggplot(tabla_usuario, aes(x = "", y = Frecuencia, fill = Tipo)) +
geom_bar(stat = "identity", width = 1, color = "white") +
coord_polar("y") +
labs(
title = "Distribución de tipos de usuario"
) +
theme_void() +
theme(
plot.title = element_text(hjust = 0.5, face = "bold")
) +
scale_fill_manual(
values = c("Customer" = "#85C1E9", # color para Cliente
"Subscriber" = "#1B4F72"), # color para Suscriptor
labels = etiquetas
)
### CONCLUSIONES TIPO DE USUARIO
#La gran mayoría de los viajes son realizados por usuarios con modalidad de suscripción, lo que indica que el servicio es utilizado principalmente por clientes recurrentes y no por usuarios esporádicos. Esto sugiere un alto nivel de fidelización del servicio, así como una dependencia importante de ingresos recurrentes por suscripción. En contraste, el bajo porcentaje de usuarios tipo Customer indica que existe una oportunidad para fortalecer estrategias de captación de usuarios ocasionales, como promociones temporales o planes de corto plazo.
### ================ Género =====================
## género, cuantos de cada género
table(datos_limpios$Gender)
##
## Female Male
## 62082 194266
tabla_genero <- datos_limpios %>%
count(Gender) %>%
filter(!is.na(Gender)) %>%
mutate(
Genero = ifelse(Gender == "Male", "Masculino", "Femenino"),
Porcentaje = round(n / sum(n) * 100, 1)
)
ggplot(tabla_genero, aes(x = Genero, y = n, fill = Genero)) +
geom_bar(stat = "identity", width = 0.6) +
geom_text(aes(label = paste0(Porcentaje, "%")),
vjust = -0.3, size = 4, fontface = "bold") +
scale_fill_manual(values = c("Femenino" = "#F1948A",
"Masculino" = "#85C1E9")) +
labs(
title = "Distribución por género",
x = "Género",
y = "Número de usuarios"
) +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, face = "bold"),
legend.position = "none"
)
## CONCLUSIÓN GÉNERO
#La arrendadora presenta una marcada predominancia de usuarios masculinos. Esto sugiere que el servicio tiene una mayor penetración entre hombres, lo que puede estar relacionado con factores como hábitos de movilidad, percepción de seguridad o patrones de traslado en la ciudad. Existe una oportunidad para diseñar estrategias que incentiven el uso del servicio entre mujeres y equilibren la participación por género.
### ================= VIAJES POR ESTACIÓN =============================
### viajes por estación de inicio (el top 10)
sort(table(datos_limpios$`Start Station`), decreasing = TRUE)[1:10]
##
## Pershing Square North E 17 St & Broadway Broadway & E 22 St
## 2814 1883 1873
## W 21 St & 6 Ave 8 Ave & W 31 St 8 Ave & W 33 St
## 1872 1603 1535
## West St & Chambers St W 20 St & 11 Ave W 41 St & 8 Ave
## 1495 1488 1458
## W 38 St & 8 Ave
## 1373
### viajes por estación de final (el top 10)
sort(table(datos_limpios$`End Station`), decreasing = TRUE)[1:10]
##
## Pershing Square North Broadway & E 22 St E 17 St & Broadway
## 2876 2114 2065
## W 21 St & 6 Ave 8 Ave & W 31 St W 20 St & 11 Ave
## 1919 1672 1634
## 8 Ave & W 33 St W 38 St & 8 Ave West St & Chambers St
## 1560 1511 1433
## University Pl & E 14 St
## 1424
# Top 10 estaciones de inicio (más se vacían)
top_inicio <- as.data.frame(sort(table(datos_limpios$`Start Station`), decreasing = TRUE)[1:10])
colnames(top_inicio) <- c("Estacion", "Viajes")
top_inicio$Tipo <- "Origen (se vacían)"
# Top 10 estaciones de fin (más se llenan)
top_fin <- as.data.frame(sort(table(datos_limpios$`End Station`), decreasing = TRUE)[1:10])
colnames(top_fin) <- c("Estacion", "Viajes")
top_fin$Tipo <- "Destino (se llenan)"
# Unir ambas tablas
top_estaciones <- rbind(top_inicio, top_fin)
ggplot(top_estaciones, aes(x = reorder(Estacion, Viajes),
y = Viajes,
fill = Tipo)) +
geom_bar(stat = "identity", position = "dodge") +
coord_flip() +
labs(
title = "Comparación de estaciones: las que más se vacían vs las que más se llenan",
x = "Estación",
y = "Número de viajes"
) +
scale_fill_manual(values = c("#5DADE2", "#F5B041")) +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, face = "bold")
)
ggplot(top_inicio, aes(x = reorder(Estacion, Viajes), y = Viajes)) +
geom_bar(stat = "identity", fill = "#5DADE2") +
coord_flip() +
labs(
title = "Top 10 estaciones que más se vacían",
x = "Estación de inicio",
y = "Número de viajes (salidas)"
) +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, face = "bold")
)
ggplot(top_fin, aes(x = reorder(Estacion, Viajes), y = Viajes)) +
geom_bar(stat = "identity", fill = "#F5B041") +
coord_flip() +
labs(
title = "Top 10 estaciones que más se llenan",
x = "Estación de destino",
y = "Número de viajes (llegadas)"
) +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, face = "bold")
)
#CONCLUSIONES ESTACIONES:
#La estación Pershing Square North aparece como la más importante tanto en salidas como en llegadas, lo que indica que es un punto clave de alta rotación en la red. Funciona como un nodo central con alta demanda constante.
#Algunas estaciones tienen más salidas que llegadas, por ejemplo:
#West St & Chambers St
#W 41 St & 8 Ave
#Esto indica que estas estaciones pierden bicicletas con mayor frecuencia, por lo que son candidatas a necesitar reabastecimiento frecuente por parte del operador.
#En el ranking de estaciones de llegada aparece:
#University Pl & E 14 St
#que no figura en el top de salidas, lo que sugiere que esta estación tiende a acumular bicicletas y puede requerir descarga periódica para evitar saturación.
### ================ VIAJES POR HORA DEL DÍA ==============================
### convertimos el tiempo
datos_limpios$Start_Time <- as.POSIXct(
datos_limpios$`Start Time`,
format = "%m/%d/%Y %H:%M"
)
datos_limpios$hora <- format(datos_limpios$Start_Time, "%H")
# Verificar resultado
head(datos_limpios$hora)
## [1] "00" "00" "00" "00" "00" "00"
table(datos_limpios$hora)
##
## 00 01 02 03 04 05 06 07 08 09 10 11 12
## 751 377 198 145 159 704 2529 5244 9092 6827 4181 4084 4800
## 13 14 15 16 17 18 19 20 21 22 23
## 4925 5318 5583 6761 10244 10004 6959 4473 3087 2206 1370
barplot(table(datos_limpios$hora),
main = "Viajes por hora del día",
xlab = "Hora",
ylab = "Número de viajes")
tabla_hora <- as.data.frame(table(datos_limpios$hora))
colnames(tabla_hora) <- c("Hora", "Viajes")
ggplot(tabla_hora, aes(x = Hora, y = Viajes)) +
geom_bar(stat = "identity", fill = "#2E86C1", color = "white") +
labs(
title = "Viajes por hora del día",
x = "Hora",
y = "Número de viajes"
) +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, face = "bold"),
axis.text.x = element_text(angle = 0)
)
ggplot(tabla_hora, aes(x = Hora, y = Viajes, fill = Viajes)) +
geom_bar(stat = "identity") +
scale_fill_gradient(low = "#85C1E9", high = "#1B4F72") +
labs(
title = "Viajes por hora del día",
x = "Hora",
y = "Número de viajes"
) +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, face = "bold")
)
datos_plot <- datos_limpios[!is.na(datos_limpios$hora), ]
library(ggplot2)
ggplot(datos_plot, aes(x = hora, fill = `User Type`)) +
geom_bar(position = "dodge") +
labs(
title = "Viajes por hora y tipo de usuario",
x = "Hora del día",
y = "Número de viajes",
fill = "Tipo de usuario"
) +
scale_fill_manual(
values = c("Customer" = "#1B4F72", "Subscriber" = "#85C1E9"),
labels = c("Customer" = "Cliente",
"Subscriber" = "Suscriptor")
) +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, face = "bold")
)
tabla_hora <- datos_plot %>%
mutate(
Start_Time = as.POSIXct(`Start Time`, format = "%m/%d/%Y %H:%M"),
Hora = format(Start_Time, "%H")
) %>%
group_by(Hora, `User Type`) %>%
summarise(Viajes = n(), .groups = "drop")
ggplot(subset(tabla_hora, `User Type` == "Customer"),
aes(x = Hora, y = Viajes, fill = Viajes)) +
geom_bar(stat = "identity") +
scale_fill_gradient(low = "#85C1E9", high = "#1B4F72") +
labs(
title = "Viajes por hora del día - Clientes",
x = "Hora",
y = "Número de viajes"
) +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, face = "bold")
)
ggplot(subset(tabla_hora, `User Type` == "Subscriber"),
aes(x = Hora, y = Viajes, fill = Viajes)) +
geom_bar(stat = "identity") +
scale_fill_gradient(low = "#85C1E9", high = "#1B4F72") +
labs(
title = "Viajes por hora del día - Suscriptores",
x = "Hora",
y = "Número de viajes"
) +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, face = "bold")
)
# data frame solo con la duración del viaje
D1 <- datos_plot %>%
mutate(
duracion = as.numeric(`Trip Duration`)
) %>%
filter(!is.na(duracion), duracion > 0)
# Kaplan–Meier
f3 <- survfit(Surv(D1$duracion) ~ 1, conf.int = 0.90)
# plo
plot(f3,
main = "Función de supervivencia - Duración de viajes en bici",
xlab = "Duración del viaje (segundos)",
ylab = "Probabilidad de supervivencia",
col = "steelblue",
lwd = 3
)
grid(nx = NA, ny = NULL, col = "gray85", lty = "dotted")
#La función de supervivencia estimada muestra que la duración de los viajes en bicicleta se concentra en intervalos cortos, ya que la curva presenta una caída rápida en los primeros minutos. La mediana de duración se encuentra aproximadamente entre 8 y 10 minutos, lo que indica que el 50% de los viajes duran menos de este tiempo. Asimismo, la probabilidad de que un viaje exceda los 20 minutos es baja, cercana al 10%, lo cual sugiere que los viajes prolongados son poco frecuentes.
D1 <- datos_plot %>%
mutate(
duracion = as.numeric(`Trip Duration`)
) %>%
filter(!is.na(duracion), duracion > 0)
# 2) Kaplan–Meier
f3 <- survfit(Surv(duracion) ~ 1, data = D1, conf.int = 0.90)
# 3) Gráfica
plot(f3,
main = "Función de supervivencia - Duración de viajes en bici",
xlab = "Duración del viaje (segundos)",
ylab = "Probabilidad de supervivencia",
col = "steelblue",
lwd = 3
)
grid(nx = NA, ny = NULL, col = "gray85", lty = "dotted")
na_fit <- survfit(coxph(Surv(duracion) ~ 1, data = D1))
# Gráfica de la hazard acumulada
plot(na_fit,
fun = "cumhaz",
main = "Hazard acumulada (Nelson–Aalen)",
xlab = "Duración del viaje (segundos)",
ylab = "Riesgo acumulado",
col = "firebrick",
lwd = 3
)
grid(nx = NA, ny = NULL, col = "gray85", lty = "dotted")
#La hazard acumulada muestra que los viajes en bicicleta tienen un aumento progresivo en el riesgo de finalización conforme transcurre el tiempo. Durante los primeros minutos, este aumento es gradual, lo que indica que los viajes tienden a una duración relativamente estable. Sin embargo, para duraciones extremadamente largas, el riesgo de terminación se incrementa de manera abrupta, lo que sugiere que estos casos corresponden a viajes atípicos o poco frecuentes.
#El sistema de bicicletas parece estar dominado por viajes cortos y medianos
#==aqui metemos la propuesta de la reducción de tiempo libre
###H₀ (hipótesis nula):
#La duración de los viajes es igual para Subscribers y Customers.
#H₁ (alternativa):
#La duración de los viajes es diferente entre ambos grupos.
#####colnames(datos_surv)
#####Sobj <- Surv(time = datos_surv$duracion)
#####logrank <- survdiff(Sobj ~ datos_surv$`User Type`)
#####logrank
#estoa fueron los resultados pero no me deja pasarlo a pdf no se pq jasjdjasdj
# [1] "...1" "Start Time" "End Time" "Trip Duration" "Start Station" "End Station" "User Type"
# [8] "Gender" "Birth Year" "Start_Time" "hora" "duracion"
#Call:
#survdiff(formula = Sobj ~ datos_surv$`User Type`)
# N Observed Expected (O-E)^2/E (O-E)^2/V
#datos_surv$`User Type`=Customer 1213 1213 2447 622.3 643
#datos_surv$`User Type`=Subscriber 98808 98808 97574 15.6 643
#Chisq= 643 on 1 degrees of freedom, p= <2e-16
### La prueba de Log-Rank arrojó un valor p < 2×10⁻¹⁶, lo que indica evidencia estadísticamente significativa de que las funciones de supervivencia difieren entre los tipos de usuario. Esto sugiere que la duración de los viajes no sigue el mismo patrón temporal entre suscriptores y usuarios ocasionales.
###Subscribers: comportamiento más estable y predecible en la duración de los viajes.
###Customers: mayor variabilidad y mayor tendencia a viajes más cortos o irregulares.
exp_fit <- survreg(Surv(duracion) ~ 1, data = D1, dist = "exponential")
wei_fit <- survreg(Surv(duracion) ~ 1, data = D1, dist = "weibull")
lnorm_fit <- survreg(Surv(duracion) ~ 1, data = D1, dist = "lognormal")
AIC(exp_fit, wei_fit, lnorm_fit)
## df AIC
## exp_fit 1 1495060
## wei_fit 2 1456790
## lnorm_fit 2 1454133
### La comparación entre modelos paramétricos mediante el Criterio de Información de Akaike (AIC) mostró que el modelo Log-normal presentó el mejor ajuste a los datos de duración de los viajes, en comparación con los modelos Exponencial y Weibull. Esto sugiere que la duración de los viajes no sigue una tasa de riesgo constante, y que el comportamiento temporal presenta una distribución asimétrica, con mayor concentración de viajes cortos y una cola larga de viajes más extensos
###La mayoría de los viajes son cortos, pero existe un grupo más pequeño de viajes mucho más largos, lo que genera una distribución sesgada hacia la derecha. Por ello, la distribución Log-normal describe mejor el comportamiento real de los usuarios.
### aqui se incluye la segmentación por customer o subscirber
###Los resultados del análisis de supervivencia muestran un patrón claro de viajes cortos con una proporción menor de viajes prolongados, lo que abre oportunidades para el diseño de esquemas tarifarios dinámicos, segmentación de clientes más rentable y optimización logística de las estaciones de bicicletas.