Как итеративно изменять значение переменной, пока все прогнозируемые вероятности не станут выше .5 - PullRequest
0 голосов
/ 05 января 2019

Я пытаюсь написать код, который вычитает заданное значение из переменной, пока каждая строка не имеет прогнозируемую вероятность на уровне или выше 0,05.

train <- data.frame('cost'= c(120, 3, 2, 4, 10, 110, 200, 43, 1, 51, 22, 14),
                    'price' = c(120, 20, 10, 4, 3, 4, 30, 43, 56, 88, 75, 44),
                    'dich' = c(0, 0, 0, 1, 1, 1, 1, 0, 0, 1, 0, 0))

train$dich <- as.factor(train$dich)

test <- data.frame('cost'= c(13, 5, 32, 22, 14, 145, 54, 134, 11, 14, 33, 21),
                   'price' = c(32, 11, 210, 6, 3, 7, 22, 423, 19, 99, 192, 32)
            )

model <- glm(dich ~ cost + price,
             data = train, 
             family = "binomial")

pred  <-   predict(model, test, type = "response")

           1            2            3            4 
3.001821e-01 4.442316e-01 4.507495e-04 6.310900e-01 
           5            6            7            8 
5.995459e-01 9.888085e-01 7.114101e-01 1.606681e-06 
           9           10           11           12 
4.096450e-01 2.590474e-02 9.908167e-04 3.572890e-01

Таким образом, в вышеприведенном выводе случаи 4, 5, 6 и 7 остались бы такими же, потому что они уже выше 0,05, но в остальных случаях я хотел бы вычесть 1 из столбца цены и затем запустить повторить прогноз и повторять до тех пор, пока вероятность всех случаев не станет равной 0,05.

Ответы [ 3 ]

0 голосов
/ 05 января 2019

Если вы хотите вычесть 1 для каждой строки (или «клиента») отдельно, а не 1 по всем показателям:

test$pred_prob <- NA
for (n in 1:nrow(test)) {
  print("-----------------------------")
  print(n)
  while (TRUE) {
    pred <- predict(model, test[n,], type = "response")
    print(pred)
    test$pred_prob[n] <- pred
    if (sum(pred > 0.05) == length(pred)) { 
      print(test$price[n])
      break 
    }
    test$price[n] <- test$price[n] - 1
  }
print(test)
}

# cost price  pred_prob
# 1    13    32 0.30018209
# 2     5    11 0.44423163
# 3    32    96 0.05128337
# 4    22     6 0.63109001
# 5    14     3 0.59954586
# 6   145     7 0.98880854
# 7    54    22 0.71141007
# 8   134   175 0.05074762
# 9    11    19 0.40964501
# 10   14    82 0.05149897
# 11   33    97 0.05081947
# 12   21    32 0.35728897
0 голосов
/ 09 января 2019

На случай, если кто-то еще захочет запустить то же самое с моделью xgboost.

train <- data.frame('cost'= c(120, 3, 2, 4, 10, 110, 200, 43, 1, 51, 22, 14),
                    'price' = c(120, 20, 10, 4, 3, 4, 30, 43, 56, 88, 75, 44))

label <- data.frame('dich' = c(0, 0, 0, 1, 1, 1, 1, 0, 0, 1, 0, 0))

train <- as.matrix(train)

label <- as.matrix(label)

model <- xgboost(data = train,
                 label = label,
                 max.depth = 3, 
                 nround = 1, 
                 objective = "binary:logistic") 

test <- data.frame('cost'= c(13, 5, 32, 22, 14, 145, 54, 134, 11, 14, 33, 21),
                   'price' = c(32, 11, 210, 6, 3, 7, 22, 423, 19, 99, 192, 32)
)

test <- as.matrix(test)

#FOR A MATRIX

test <- cbind(test, rep(NA, nrow(test)))
colnames(test)[3] <- c("pred_prob")

for (n in 1:nrow(test)) {
  print("-----------------------------")
  print(n)
  while (TRUE) {
    pred <- predict(model, t(test[n,]), type = "response")
    print(pred)
    test[,"pred_prob"][n] <- pred
    if (sum(pred > 0.5) == length(pred)) { 
      print(test[,"pred_prob"][n])
      break 
    }
    test[,"price"][n] <- test[,"price"][n] - .01
  }
  print(test)
}

Кажется, что нужно пройти 12 рядов. Мне нужно немного подумать о порогах древовидной модели и о том, как это повлияет на диапазон различных изменений цены, чтобы получить с вероятностью 0,5 или выше, что я имел в виду в своем первом вопросе, но написал 0,05 ха-ха. ,

0 голосов
/ 05 января 2019

Я вижу, что вы пытаетесь сделать, но результаты довольно веселые. Это если вы хотите вычитать 1 из всех элементов цены каждый раз:

x <- 1
while (TRUE) {
  print("----------------------------------------")
  print(x)
  test$price <- test$price - 1
  pred <- predict(model, test, type = "response")
  print(pred)
  x <- x + 1
  if (sum(pred > 0.05) == length(pred)) { 
    print(test)
    break 
  }
}
# ... loops 247 times
# [1] "----------------------------------------"
# [1] 248
# 1          2          3          4          5          6          7          8          9         10         11         12 
# 0.99992994 0.99996240 0.93751936 0.99998243 0.99997993 0.99999966 0.99998781 0.05074762 0.99995669 0.99887117 0.97058913 0.99994594 
# cost price
# 1    13  -216
# 2     5  -237
# 3    32   -38
# 4    22  -242
# 5    14  -245
# 6   145  -241
# 7    54  -226
# 8   134   175
# 9    11  -229
# 10   14  -149
# 11   33   -56
# 12   21  -216
...