Encontrar el punto de inflexión en una relación bivariada

Question

Estoy investigando qué métodos se utilizan generalmente para dicotomizar una variable ordinal Y de manera que se maximicen las diferencias entre grupos en los valores de X y se minimicen las diferencias dentro de los grupos en los valores de X. Básicamente, quiero algún tipo de clasificación óptima (binaria) de mi variable Y (ordinal, que va, digamos, de 0 a 8) según los valores de la variable X (una variable continua).

He creado unos datos en los que yo diría que la línea óptima está en el 3: la agrupación principal respecto a X está entre los que tienen una puntuación Y de 0 a 3 y los que tienen una puntuación de 4 a 6. Obviamente, los datos reales contendrían mucho más ruido, pero los datos siguientes deberían ser útiles para aclarar con qué estoy trabajando y, en particular, la relación no lineal que encuentro entre mi X y mi Y. Básicamente, se trata de encontrar el punto de inflexión en la relación bivariada, o donde la relación alcanza una meseta (véase el gráfico):

Código R

     D<-data.frame(rbind(cbind(rep(0,600),rnorm(600,mean=2000,sd=2)),
                            cbind(rep(1,600),rnorm(600,mean=1000,sd=2)),
                            cbind(rep(2,300),rnorm(300,mean=500,sd=2)),
                            cbind(rep(3,200),rnorm(200,mean=200,sd=2)),
                            cbind(rep(4,99),rnorm(99,mean=50,sd=2)),
                            cbind(rep(5,98),rnorm(98,mean=45,sd=2)),
                            cbind(rep(6,90),rnorm(90,mean=43,sd=2)),
                            cbind(rep(7,90),rnorm(90,mean=44,sd=2)),
                            cbind(rep(8,85),rnorm(85,mean=41,sd=2))
                            ))
#And a couple of other datasets but with slightly different distribution (but same kink)

    n<-600
    D2<-data.frame(rbind(cbind(rep(0,600),rnorm(600,mean=2000,sd=2)),
    cbind(rep(1,n),rnorm(n,mean=1000,sd=2)),cbind(rep(2,n),rnorm(n,mean=500,sd=2)),
    cbind(rep(3,n),rnorm(n,mean=200,sd=2)),cbind(rep(4,n),rnorm(n,mean=50,sd=2)),
    cbind(rep(5,n),rnorm(n,mean=45,sd=2)),cbind(rep(6,n),rnorm(n,mean=43,sd=2)),
    cbind(rep(7,n),rnorm(n,mean=44,sd=2)),cbind(rep(8,n),rnorm(n,mean=41,sd=2))))

D3<-data.frame(rbind(cbind(rep(0,600),rnorm(600,mean=2000,sd=2)),
cbind(rep(1,600),rnorm(600,mean=1000,sd=2)),cbind(rep(2,300),rnorm(300,mean=500,sd=2)),
cbind(rep(3,200),rnorm(200,mean=200,sd=2)), cbind(rep(4,200),rnorm(200,mean=50,sd=2)),
cbind(rep(5,200),rnorm(200,mean=45,sd=2)),cbind(rep(6,200),rnorm(200,mean=43,sd=2)),
cbind(rep(7,200),rnorm(200,mean=44,sd=2)),cbind(rep(8,300),rnorm(300,mean=41,sd=2))))

  colnames(D)<-colnames(D2)<-colnames(D3)<-c("Y","X")   
      plot(D)

No estoy interesado en aproximaciones gráficas, trazando líneas secantes o splines, sino en técnicas robustas que realicen pruebas estadísticas formales para encontrar el mejor binning binario, y te agradecería mucho que me dieras tu opinión al respecto y, si tienes una solución, proporcionaras un código para aplicarlo a los datos anteriores.

Gracias de antemano

Answer 1

He aquí una forma sencilla de resolverlo.

a) encontrar la línea que une los dos extremos (a lo largo de D$X) de su muestra. b) calcula la distancia ortogonal de todos los puntos a esta línea. c) el punto más bajo de esta línea es donde está el pliegue.

A continuación se muestra un sencillo código R para ilustrar esto.

plot(D$X,D$Y)
#the two extrem points
a1<-which.min(D$X)     
a2<-which.max(D$X)
a1<-c(D$X[a1],D$Y[a1])
a2<-c(D$X[a2],D$Y[a2])
a0<-rbind(a1,a2)
points(a0,col="red",pch=16)
#find the line joining them.
a3<-lm(a0[,2]~a0[,1])$coef
a4<-c(-a3[2],1)
a4<-a4/sqrt(sum(a4**2))
#find the point furthest below (orthogonaly) to this line:
a5<-which.min(cbind(D$X,D$Y)%*%a4)
#the kink:
points(t(c(D$X[a5],D$Y[a5])),col="green",pch=16)