Оптимизировать выбор столбцов, которые максимизируют корреляцию в R - PullRequest
Новая
       22

Оптимизировать выбор столбцов, которые максимизируют корреляцию в R

2 голосов
/ 11 декабря 2019

Я борюсь с проблемой программирования. Цель состоит в том, чтобы найти оптимальную среднюю совокупность нескольких столбцов, чтобы этот столбец агрегирования максимизировал корреляцию с другим столбцом.

В качестве игрушечного примера рассмотрим следующие данные: 

set.seed(123)

df <- cbind(data.frame(FIRM = rnorm(36, 0, 0.05)),
              data.frame(matrix(rnorm(36 * 50, 0, 0.05), 36, 50)))

Таким образом: цель состоит в том, чтобы найти оптимальную комбинацию из 50 «X» столбцов, чтобы при взятии средних значений этих столбцов корреляция со столбцом «FIRM» была максимальной. Однако, хотя это лишь небольшой пример, уже существует 50 возможных факторных комбинаций.

Часть проблемы заключается в том, что реальный набор данных намного больше (т.е. около 20 000 оптимизаций "FIRM", с более чем 5000 возможных столбцов "X" для агрегации на оптимизацию). До сих пор я начинал с поэтапной оптимизации, но, учитывая размер набора данных, это очень неэффективно. Я надеялся получить некоторое представление о лучшем способе кодирования этой проблемы.

До сих пор я написал некоторый код, который принимает любую линейную комбинацию и максимизирует эту корреляцию с исходным столбцом. Однако теперь я хотел бы отрегулировать это так, чтобы код не взвешивал столбцы с любыми другими весами, отличными от 1 или 0.

Код, который у меня есть на данный момент: 

set.seed(123)

firm <- rnorm(36, 0, 0.05)
peers <- matrix(rnorm(36 * 50, 0, 0.05), 36, 50)

#Function to maximize
cor.model <- function(w = rep(1 / ncol(peers), ncol(peers))){
  f_score <- peers %*% (w / sum(w))
  x <- f_score
  y <- firm
  correl <- cor(x,y)
  return(correl)
}

#Output
out <- optim(par = rep(1 / ncol(peers), ncol(peers)),
             fn = cor.model,
             method = "L-BFGS-B",
             lower = rep(0, ncol(peers)), # W_i >= 0 for all i
             upper = rep(1, ncol(peers)), # W_i <= 1 for all i)
             control = list(fnscale = -1))

out$par/sum(out$par)

cor(firm, rowSums(peers))
cor(firm, rowSums(t(as.vector(out$par/sum(out$par))*t(peers))))

Большое спасибо!

1 Ответ

3 голосов
/ 11 декабря 2019

Я бы попробовал локальный поиск (как описано в этом учебнике ).

Вот эскиз в R. 

FIRM <- as.matrix(df[[1]])
M <- as.matrix(df[, -1])

library("neighbours")  ## https://github.com/enricoschumann/neighbours
library("NMOF")        ## https://github.com/enricoschumann/NMOF

N <- neighbourfun(type = "logical", kmin = 1, kmax = 50)

Первоначальное решение. 

x <- logical(50)
x[1:5] <- TRUE

Целевая функция. Функция, которую мы будем использовать позже, сводит к минимуму, поэтому я ставлю минус перед вычислением. 

of_cor <- function(x, FIRM, M) {
    -c(cor(FIRM, rowMeans(M[, x])))
}

Тест: выберите все 50 столбцов. 

-of_cor(!logical(50), FIRM, M)
## [1] -0.1727944

Тест: используйте исходное решение. 

-of_cor(x, FIRM, M)
## [1] -0.2261783

Запустите фактическое вычисление с использованием Threshold Accepting (основанного на локальном поиске). 

sol <- TAopt(of_cor,
             list(x0 = x,
                  neighbour = N,
                  nI = 50000),
             M = M,
             FIRM = FIRM)
## Threshold Accepting
## [....]
##   Finished.
##   Best solution overall: -0.6206239

Решение имеет корреляцию 0,62. 

-of_cor(sol$xbest, FIRM, M)
## [1] 0.6206239

(Раскрытие информации: я поддерживаю пакеты, которые я использовал.)

...