Configuración del problema de optimización en el problema de la neurona conexionista

Me gustaría configurar un procedimiento de optimización que identifique la precisión de predicción más alta seleccionando el valor $\theta_{óptimo} \in [-3, 3]$ de acuerdo con un modelo de neurona conexionista con identificador binario. Como no hay forma de incluir el código de látex, proporciono una imagen del modelo/fórmula en su lugar:

ingrese la descripción de la imagen aquí

Supongamos que ya identifiqué un determinado vector de peso $w=(w_1 w_2)^T. Por lo tanto, puedo escribir el cálculo como

w <- c(0.9396926, 0.3420201)
X <- as.matrix(t(ex[,1:2])) 

# with theta = 0
result <- as.data.frame(sign(t(w %*% X)))
result[result == -1] <- 0
# where result is a df with dimension 15x1, and df$V1 are the predicted y labels 

Para acortar el código del ejemplo, puedo elaborar la distancia euclidiana entre las etiquetas verdaderas y las etiquetas predichas (valores) en lugar de calcular la precisión de la predicción:

euclidean <- function(a, b){
  sqrt(sum((a - b)^2))
} 
euclidean(as.integer(ex$y) ,result$V1)

Como nunca antes había hecho algo como esto, no tengo idea de cómo configurar un procedimiento de optimización tan iterativo de

  • primero calculando los valores pronosticados ypara todos los valores posibles de theta,
  • y luego, para cada vector de resultados pronosticados, rescalcule la distancia euclidiana,
  • y finalmente elija el thetaque proporcione la mayor precisión/la distancia euclidiana más baja.

Agradecería si alguien pudiera darme sugerencias, enlaces a configuraciones comparables o guiarme a través de algunos pasos.


Datos de ejemplo: dput(data[1:15])

ex <- structure(list(x.1 = c(0.365, 0.543, -0.401, 0.866, -0.386, -0.443, 
-0.519, 0.332, 0.211, -0.208), x.2 = c(0.708, -0.268, 0.643, 
-0.796, 0.742, 0.615, 0.818, -0.211, -0.237, -0.656), y = structure(c(1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), .Label = c("0", "1"), class = "factor")), row.names = c(NA, 
10L), class = "data.frame")

x.1y y.1son las coordenadas respectivas y yes la etiqueta verdadera conocida.

Answer

Podemos probar el siguiente código usando optimize

f <- function(theta) sqrt(sum((as.integer(ex$y) - (t(w %*% X) >= theta))^2))
xmin <- optimize(f, c(-3, 3))

lo que da

> xmin
$minimum
[1] -1.583516

$objective
[1] 0