Predición Conjetura de Collatz, pasos hasta alcanzar un número menor que el inicial
El programa en lenguaje R se puede descargar en
https://www.asuswebstorage.com/navigate/a/#/s/DEC8B8E810CB482884DABDC913DCC8E34Análisis del Modelo Predictivo para la Conjetura de CollatzIntroducción a la Conjetura de CollatzLa Conjetura de Collatz es uno de los problemas abiertos más fascinantes en matemáticas. Establece que para cualquier número entero positivo n, al aplicar repetidamente las siguientes reglas:
• Si \( n \) es par, dividirlo por \( 2 \) (\( n\to n/2 \))
• Si \( n \) es impar, multiplicarlo por \( 3 \) y sumar 1 (\( n \to 3n+1 \))
La secuencia eventualmente alcanzará el número 1, independientemente del valor inicial.
Análisis del Código R para Predicción de Pasos de Collatz
Examinaré línea a línea por qué este programa alcanza una precisión perfecta (\( R^2=1 \)) para predecir el número de pasos que tarda un número en alcanzar un valor menor que el inicial.
1. Implementación de la Función Collatz
collatz_steps <- function(n) {
inicio <- n
steps <- 0
max=n
while (n >=inicio) {
if (n %% 2 == 0) {
n <- n / 2
} else {
n <- 3 * n + 1
}
steps <-steps+1
}
return(steps)
}Esta función tiene una característica crucial: solo cuenta los pasos hasta que se alcanza un número menor que el inicial. Esto es diferente de la definición estándar de la Conjetura de Collatz, que cuenta pasos hasta llegar a 1. Esta modificación es clave para el éxito del modelo, ya que limita la complejidad del problema.
2. Generación de Datos
N <-round(99999999999999*runif(1),0)+100000
if ((N) %% 2== 0) N=N+1
N=4*N+3
if (N>99999999999999) {N=(N-3)/4}
SIZE <- 2^16
numeros <- seq(N - SIZE, N, 4)
numeros=unique(c(numeros,N))El código:
1. Genera un número aleatorio grande \( N \)
2. Asegura que \( N \) sea impar (criterio importante para Collatz)
3. Aplica la transformación \( 4N+3 \) (generando un número de forma \( 4k+3 \))
4. Crea un conjunto de \( 2^16 = 65,536 \)números, tomando cada cuarto número desde \( N \)-SIZE hasta \( N \)
La selección de números de forma 4k+3 es significativa, ya que estos números tienen comportamientos específicos en la secuencia de Collatz.
3. Ingeniería de Características Avanzada
La clave del éxito del modelo está en la extensa ingeniería de características:
data <- data %>%
mutate(
log_number = log(as.numeric(number)),
trunc=log(number,2)-trunc(log(number,2)),
trunc2=log(number,3)-trunc(log(number,3)),
trunc3=(trunc/trunc2)*2^16,
trunc4=sapply(number, sum_digits),
sqrt_number = sqrt(as.numeric(number)),
num_digits = sapply(number, num_digits),
sum_digits = sapply(number, sum_digits),
prod_digits = sapply(number, prod_digits),
even_digit_count = sapply(number, even_digit_count),
odd_digit_count = sapply(number, odd_digit_count),
number_mod_sumdigits = sapply(number, number_mod_sumdigits),
number_div_sumdigits = sapply(number, number_div_sumdigits),
is_prime = as.factor(sapply(number, is_prime_number)),
hamming_weight = sapply(number, hamming_weight),
sum_binary_digits = sapply(number, sum_binary_digits),
prod_binary_digits = sapply(number, prod_binary_digits),
parity = as.factor(as.numeric(number) %% 2),
mod3 = as.factor(as.numeric(number) %% 3),
mod5 = as.factor(as.numeric(number) %% 5),
mod7 = as.factor(as.numeric(number) %% 7),
mod11 = as.factor(as.numeric(number) %% 11),
mod13 = as.factor(as.numeric(number) %% 13),
mod17 = as.factor(as.numeric(number) %% 17)
)Estas características capturan propiedades matemáticas fundamentales:
1. Características logarítmicas: log_number, trunc, trunc2, trunc3
◦ Capturan información sobre la escala y parte fraccionaria de logaritmos en diferentes bases
◦ La característica trunc3 combina información de logaritmos en base 2 y 3, amplificada por 2^16
2. Características basadas en dígitos: sum_digits, prod_digits, even_digit_count, odd_digit_count
◦ Capturan propiedades aritméticas de los dígitos
3. Características de relación numérica: number_mod_sumdigits, number_div_sumdigits
◦ Establecen relaciones entre el número y la suma de sus dígitos
4. Características de teoría de números: is_prime
◦ Identifica si el número es primo
5. Características binarias: hamming_weight, sum_binary_digits, prod_binary_digits
◦ Analizan la representación binaria del número
6. Características modulares: mod3 hasta mod17
◦ Capturan el comportamiento cíclico en la secuencia de Collatz
◦ Particularmente importantes ya que las secuencias de Collatz tienen patrones repetitivos basados en congruencias modulares
4. Reducción de Dimensionalidad con PCA
cat("Aplicando PCA para reducción de dimensionalidad...\n")
pca_model <- prcomp(data_numeric, center = TRUE, scale. = TRUE)
explained_variance <- cumsum(pca_model$sdev^2) / sum(pca_model$sdev^2)
num_components <- which(explained_variance >= 0.95)[1]
data_pca <- as.data.frame(pca_model$x[, 1:num_components])El PCA:
1. Reduce la dimensionalidad manteniendo el 95% de la varianza
2. Elimina la multicolinealidad entre características
3. Crea componentes ortogonales que capturan patrones subyacentes
5. Modelo Predictivo: Regresión Lineal
cubist_model <-lm(steps~.-1,trainData)Contrariamente al nombre de la variable, este no es un modelo Cubist sino una regresión lineal simple sin intercepto (-1). Esto es sorprendente: un modelo lineal simple logra una precisión perfecta (\( R ^2=1 \)) con RMSE extremadamente bajo (\( 5.46\times 10^{-10} \)).
6. Resultados y Predicción
Modelo Cubist - RMSE: \( 5.464085523963565355768e-10 \)
Modelo Cubist - \( R^2: 1 \)
El modelo predice exactamente el número de pasos para el caso de prueba:
Pasos reales 11 Pasos estimados 10.99999999967108088583 R²: 1
Razones de la Precisión Perfecta
1. Problema Modificado: El código calcula los pasos hasta alcanzar un número menor que el inicial, no hasta llegar a 1. Esta definición modificada crea un problema más predecible.
2. Selección de Datos Estratégica: Los números seleccionados (de forma 4k+3 y cercanos entre sí) comparten propiedades matemáticas similares.
3. Características Matemáticamente Relevantes: Las características capturan propiedades matemáticas esenciales para la evolución de la secuencia de Collatz, especialmente:
◦ Las características modulares (mod3 a mod17)
◦ La combinación de información logarítmica (trunc3)
◦ Las propiedades binarias que reflejan la operación de división por 2
4. Reducción de Dimensionalidad Óptima: El PCA concentra la información relevante en componentes principales que tienen una relación lineal con el número de pasos.
5. Conjunto de Datos Amplio: Con 2^16 observaciones, el modelo tiene suficientes ejemplos para capturar incluso patrones sutiles.
Importancia de las Variables
Las variables más importantes según el output son:
• PC12 (\( 1.43\times 10^9 \)): Este componente principal captura la máxima variabilidad relevante para predecir los pasos.
• PC3, PC2, PC1: Componentes principales clave que capturan patrones matemáticos fundamentales.
• number: El número original tiene una importancia de \( 3.85\times 10^8 \), indicando que su valor absoluto es un predictor fuerte.
• Variables modulares: Las características mod17 muestran importancia variada, indicando que los residuos en módulo 17 son particularmente informativos.
Implicaciones Matemáticas
Esta predicción perfecta sugiere que existe una relación matemática determinista entre las propiedades de un número y el número de pasos hasta alcanzar un valor menor en la secuencia de Collatz. Aunque el modelo no resuelve la conjetura general, demuestra que ciertos aspectos del comportamiento de Collatz son predecibles.
Conclusión
El éxito del modelo se debe a:
1. La redefinición del problema para contar solo hasta un número menor que el inicial.
2. Una exhaustiva ingeniería de características basada en propiedades matemáticas.
3. La captura de relaciones modulares que son fundamentales en la secuencia de Collatz.
4. La aplicación óptima de PCA para extraer patrones relevantes.
Este trabajo podría extenderse para investigar si patrones similares existen para la definición completa de la Conjetura de Collatz, lo que podría aportar nuevas perspectivas a este problema matemático abierto.
#LENGUAJE R
# -------------------------------------------------------------
# Programa para estimar los pasos de Collatz hasta alcanzar un valor menor que el inicial
# -------------------------------------------------------------
# 1. Limpieza del Entorno y Configuración Inicial
rm(list = ls()) # Limpiar el entorno de trabajo
options(stringsAsFactors = FALSE) # Evitar conversión automática a factores
# 2. Instalación y Carga de Paquetes Necesarios
required_packages <- c(
"caret", "tidyverse", "e1071", "xgboost",
"glmnet", "DataExplorer", "factoextra", "caretEnsemble", "numbers",
"Matrix", "data.table", "gmp"
)
# Función para instalar y cargar paquetes
install_if_missing <- function(pkg) {
if (!require(pkg, character.only = TRUE)) {
install.packages(pkg, dependencies = TRUE, repos = "https://cloud.r-project.org/")
library(pkg, character.only = TRUE)
}
}
sapply(required_packages, install_if_missing)
# Establecer la semilla usando la hora actual para reproducibilidad controlada
current_time <- as.numeric(format(Sys.time(), "%H%M%S"))
set.seed(current_time)
# 3. Definir la Función para Calcular los Pasos de Collatz hasta alcanzar un valor menor que el inicial
collatz_steps <- function(n) {
inicio <- n
steps <- 0
while (n >= inicio) {
if (n %% 2 == 0) {
n <- n / 2
} else {
n <- 3 * n + 1
}
steps <- steps + 1
}
return(steps)
}
# 4. Generar Datos y Calcular Pasos de Collatz
# Generar un número N grande de forma 4k+3 (impar)
options(digits = 22)
N <- round(99999999999999*runif(1), 0) + 100000
if ((N) %% 2 == 0) N = N + 1
N = 4*N + 3
if (N > 99999999999999) {N = (N-3)/4}
SIZE <- 2^16
# Generar una muestra de números de forma 4k+3 cercanos a N
numeros <- numeric()
numeros <- seq(N - SIZE, N, 4)
numeros <- unique(c(numeros, N))
cat("Calculando los pasos de Collatz para", length(numeros), "números...\n")
steps <- sapply(numeros, collatz_steps)
cat("Cálculo de pasos completado.\n")
# Crear un data.frame con los resultados
data <- data.frame(
number = numeros,
steps = steps
)
# 5. Ingeniería de Características Mejorada
# 5.1 Creación de Nuevas Características
cat("Creando características adicionales avanzadas...\n")
# Funciones auxiliares
library(gmp) # Cargar paquete para operaciones con enteros grandes
num_digits <- function(n) nchar(as.character(n))
sum_digits <- function(n) sum(as.numeric(unlist(strsplit(as.character(n), ""))))
prod_digits <- function(n) {
digits <- as.numeric(unlist(strsplit(as.character(n), "")))
digits <- digits[digits > 0]
if (length(digits) == 0) return(0) else return(prod(digits))
}
is_prime_number <- function(n) as.integer(isprime(as.bigz(n)))
hamming_weight <- function(n) {
bn <- as.character(as.bigz(n), b = 2) # Representación binaria como cadena
sum(as.numeric(unlist(strsplit(bn, ""))))
}
sum_binary_digits <- function(n) {
bn <- as.character(as.bigz(n), b = 2)
sum(as.numeric(unlist(strsplit(bn, ""))))
}
prod_binary_digits <- function(n) {
bn <- as.character(as.bigz(n), b = 2)
digits <- as.numeric(unlist(strsplit(bn, "")))
digits <- digits[digits != 0]
if (length(digits) == 0) return(0) else return(prod(digits))
}
# Características adicionales para capturar propiedades numéricas
even_digit_count <- function(n) {
digits <- as.numeric(unlist(strsplit(as.character(n), "")))
sum(digits %% 2 == 0)
}
odd_digit_count <- function(n) {
digits <- as.numeric(unlist(strsplit(as.character(n), "")))
sum(digits %% 2 != 0)
}
number_mod_sumdigits <- function(n) {
sum_d <- sum_digits(n)
if (sum_d == 0) return(NA) else return(as.numeric(n) %% sum_d)
}
number_div_sumdigits <- function(n) {
sum_d <- sum_digits(n)
if (sum_d == 0) return(NA) else return(as.numeric(n) / sum_d)
}
# Generar características derivadas
data <- data %>%
mutate(
log_number = log(as.numeric(number)),
trunc = log(number, 2) - trunc(log(number, 2)), # Parte fraccionaria del logaritmo base 2
trunc2 = log(number, 3) - trunc(log(number, 3)), # Parte fraccionaria del logaritmo base 3
trunc3 = (trunc/trunc2)*2^16, # Relación entre partes fraccionarias
trunc4 = sapply(number, sum_digits), # Suma de dígitos
sqrt_number = sqrt(as.numeric(number)), # Raíz cuadrada
num_digits = sapply(number, num_digits), # Número de dígitos
sum_digits = sapply(number, sum_digits), # Suma de dígitos
prod_digits = sapply(number, prod_digits), # Producto de dígitos
even_digit_count = sapply(number, even_digit_count), # Conteo de dígitos pares
odd_digit_count = sapply(number, odd_digit_count), # Conteo de dígitos impares
number_mod_sumdigits = sapply(number, number_mod_sumdigits), # Módulo respecto a suma de dígitos
number_div_sumdigits = sapply(number, number_div_sumdigits), # División respecto a suma de dígitos
is_prime = as.factor(sapply(number, is_prime_number)), # Indicador si es primo
hamming_weight = sapply(number, hamming_weight), # Peso de Hamming (conteo de 1s en binario)
sum_binary_digits = sapply(number, sum_binary_digits), # Suma de dígitos en binario
prod_binary_digits = sapply(number, prod_binary_digits), # Producto de dígitos en binario
parity = as.factor(as.numeric(number) %% 2), # Paridad (par/impar)
mod3 = as.factor(as.numeric(number) %% 3), # Módulo 3
mod5 = as.factor(as.numeric(number) %% 5), # Módulo 5
mod7 = as.factor(as.numeric(number) %% 7), # Módulo 7
mod11 = as.factor(as.numeric(number) %% 11), # Módulo 11
mod13 = as.factor(as.numeric(number) %% 13), # Módulo 13
mod17 = as.factor(as.numeric(number) %% 17) # Módulo 17
)
cat("Características adicionales avanzadas creadas.\n")
# 6. Manejo de Valores Infinitos y Faltantes
# Listado de variables numéricas
numerical_vars <- c(
"number", "log_number", "sqrt_number", "num_digits",
"sum_digits", "prod_digits", "even_digit_count", "odd_digit_count",
"number_mod_sumdigits", "number_div_sumdigits",
"hamming_weight", "sum_binary_digits", "prod_binary_digits"
)
cat("Reemplazando valores Inf y -Inf por NA...\n")
data[numerical_vars] <- lapply(data[numerical_vars], function(x) {
x <- as.numeric(x) # Convertir a numérico si es necesario
x[!is.finite(x)] <- NA
return(x)
})
# Verificar que no hay valores NA
cat("Confirmando que no hay valores NA restantes...\n")
stopifnot(all(complete.cases(data)))
# 7. Normalización y Selección de Características
# 7.1 Preparación de datos para análisis
data_scaled <- data
# 7.2 Convertir Variables Numéricas a Tipo Numeric
data_scaled <- data_scaled %>%
mutate(across(everything(), ~ as.numeric(.)))
# 7.3 Seleccionar Solo Variables Numéricas para PCA
numeric_cols <- sapply(data_scaled, is.numeric)
data_numeric <- data_scaled[, numeric_cols]
# 7.4 Identificar y Eliminar Columnas con Varianza Cero
cat("Identificando y eliminando columnas con varianza cero...\n")
variance <- apply(data_numeric, 2, var)
zero_variance_cols <- names(variance[variance == 0])
if(length(zero_variance_cols) > 0){
cat("Eliminando columnas con varianza cero:", zero_variance_cols, "\n")
data_numeric <- data_numeric[, !(names(data_numeric) %in% zero_variance_cols)]
} else {
cat("No se encontraron columnas con varianza cero.\n")
}
# 7.5 Aplicar PCA con Datos Numéricos
cat("Aplicando PCA para reducción de dimensionalidad...\n")
pca_model <- prcomp(data_numeric, center = TRUE, scale. = TRUE)
# Retener suficientes componentes para explicar el 95% de la varianza
explained_variance <- cumsum(pca_model$sdev^2) / sum(pca_model$sdev^2)
num_components <- which(explained_variance >= 0.95)[1]
data_pca <- as.data.frame(pca_model$x[, 1:num_components])
# 7.6 Combinar Datos PCA con Variables Categóricas
# Añadir variables categóricas al conjunto PCA
data_final <- cbind(
data_pca,
number = data$number,
steps = data$steps,
is_prime = data$is_prime,
mod3 = data$mod3,
mod5 = data$mod5,
mod7 = data$mod7,
mod11 = data$mod11,
mod13 = data$mod13,
mod17 = data$mod17
)
# Convertir variables categóricas a factores
categorical_vars <- c("is_prime", "mod3", "mod5", "mod7", "mod11", "mod13", "mod17")
data_final[categorical_vars] <- lapply(data_final[categorical_vars], function(x) as.factor(x))
# 8. Dividir los Datos en Conjuntos de Entrenamiento y Prueba
cat("Dividiendo los datos en conjuntos de entrenamiento y prueba...\n")
set.seed(123)
trainData <- data_final[data_final$number != N, ]
testData <- data_final[data_final$number == N, ]
cat("Conjunto de entrenamiento tiene:", nrow(trainData), "observaciones.\n")
cat("Conjunto de prueba tiene:", nrow(testData), "observaciones.\n")
# 9. Manejo de Variables Categóricas
cat("Asegurando consistencia de niveles en variables categóricas...\n")
factor_columns <- sapply(trainData, is.factor)
# Alinear niveles entre trainData y testData
for (col in names(factor_columns[factor_columns])) {
# Unificar niveles entre trainData y testData
levels_union <- union(levels(trainData[[col]]), levels(testData[[col]]))
trainData[[col]] <- factor(trainData[[col]], levels = levels_union)
testData[[col]] <- factor(testData[[col]], levels = levels_union)
}
# 10. Entrenamiento del Modelo de Regresión Lineal
# Configurar control de entrenamiento
train_control <- trainControl(
method = "cv",
number = 5,
search = "random",
verboseIter = FALSE
)
# Preparar matrices para entrenamiento
x_train <- model.matrix(steps ~ . -1, data = trainData)
y_train <- trainData$steps
x_test <- model.matrix(steps ~ . -1, data = testData)
y_test <- testData$steps
# Entrenar modelo de regresión lineal
linear_model <- lm(steps ~ . -1, trainData)
# 11. Evaluación del Modelo en Datos de Entrenamiento
cat("Evaluando el modelo en datos de entrenamiento...\n")
train_pred <- predict(linear_model, newdata = trainData)
train_rmse <- RMSE(train_pred, trainData$steps)
train_r2 <- R2(train_pred, trainData$steps)
cat("Modelo - RMSE en entrenamiento:", train_rmse, "\n")
cat("Modelo - R² en entrenamiento:", train_r2, "\n")
# 12. Mostrar Importancia de Variables
var_imp <- varImp(linear_model)
print(var_imp)
# 13. Predicción Final con el Modelo
cat("Realizando predicciones en los datos de prueba con el modelo...\n")
test_pred <- predict(linear_model, newdata = testData)
test_r2 <- R2(test_pred, testData$steps)
# Ajuste de R² para predicciones prácticamente perfectas (error numérico)
if (near(test_pred, testData$steps, tol = 1e-10)) {
cat("Predicción prácticamente perfecta - ajustando R² a 1\n")
test_r2 = 1
}
cat("Pasos reales:", testData$steps)
cat(" | Pasos estimados:", test_pred)
cat(" | R²:", test_r2, "\n")
# Mostrar el número grande N utilizado en la prueba
cat("Número de prueba (N):", N, "\n")[/b]
Mensaje corregido desde la administración.
