Функция оптимизации по нескольким факторам

Question

Я пытаюсь определить подходящие пороговые значения для двух видов деятельности, которые дают наибольшую вероятность успеха.

Ниже приведен пример того, чего я пытаюсь достичь. Для каждого местоположения я пытаюсь определить пороговые значения, которые следует использовать для действий 1 и 2, так что, если какой-либо критерий будет удовлетворен, мы догадаемся «да» (1). Затем мне нужно убедиться, что мы угадываем «да» только для определенного процента от общего объема для каждого местоположения, и что мы максимизируем нашу точность (наше предположение о да = «результат» 1).

location <- c(1,2,3)    
testFile <- data.frame(location = rep.int(location, 20),
                          activity1 = round(rnorm(20, mean = 10, sd = 3)),
                          activity2 = round(rnorm(20, mean = 20, sd = 3)),
                          outcome = rbinom(20,1,0.5)
                       )
    set.seed(145)
    act_1_thresholds <- seq(7,12,1)
    act_2_thresholds <- seq(19,24,1)

Мне удалось это сделать, создав таблицу, содержащую все возможные уникальные комбинации порогов для действий 1 и 2, а затем объединив ее с каждым наблюдением в наборе данных выборки. Однако с ~ 200 точками в фактическом наборе данных, в каждом из которых с тысячами наблюдений я быстро исчерпал пространство.

Я хотел бы создать функцию, которая принимает идентификатор местоположения, набор возможных порогов для действия 1, а также для действия 2, а затем вычисляет, как часто мы бы угадали «да» (то есть значения в «Деятельности1» или « активность2 'превышает соответствующие им пороговые значения, которые мы тестируем), чтобы убедиться, что наш уровень применения остается в желаемом диапазоне (50% - 75%). Затем для каждого набора порогов, которые производят норму внесения в пределах нашего желаемого диапазона, мы хотели бы сохранить только тот набор, который максимизирует точность, вместе с их соответствующим идентификатором местоположения, скоростью внесения и степенью точности. Желаемый результат указан ниже.

      location act_1_thresh act_2_thresh application_rate accuracy_rate
1        1           13           19             0.52          0.45
2        2           11           24             0.57          0.53
3        3           14           21             0.67          0.42

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

Ниже приведен пример того, как рассчитать применение и коэффициент точности для одного набора порогов.

### Create yard IDs
location <- c(1,2,3)

### Create a single set of thresholds
single_act_1_threshold <- 12
single_act_2_threshold <- 20

### Calculate the simulated application, and success rate of thresholds mentioned above using historical data
as.data.table(testFile)[,
                        list(
                        application_rate = round(sum(ifelse(single_act_1_threshold <= activity1 | single_act_2_threshold <= activity2, 1, 0))/
                                                   nrow(testFile),2),
                        accuracy_rate = round(sum(ifelse((single_act_1_threshold <= activity1 | single_act_2_threshold <= activity2) & (outcome == 1), 1, 0))/
                                                sum(ifelse(single_act_1_threshold <= activity1 | single_act_2_threshold <= activity2, 1, 0)),2)
                        ),
                        by = location]

Answer 1

Рассмотрим expand.grid, который строит фрейм данных всех комбинаций между обоими пороговыми значениями. Затем используйте Map для поэтапной итерации между обоими столбцами фрейма данных, чтобы построить список таблиц данных (из которых теперь есть столбцы для каждого порогового индикатора).

act_1_thresholds <- seq(7,12,1)
act_2_thresholds <- seq(19,24,1)

# ALL COMBINATIONS
thresholds_df <- expand.grid(th1=act_1_thresholds, th2=act_2_thresholds)

# USER-DEFINED FUNCTION
calc <- function(th1, th2)
     as.data.table(testFile)[, list(
                                  act_1_thresholds = th1,     # NEW COLUMN
                                  act_2_thresholds = th2,     # NEW COLUMN                      
                                  application_rate = round(sum(ifelse(th1 <= activity1 | th2 <= activity2, 1, 0)) /
                                                           nrow(testFile),2),
                                  accuracy_rate = round(sum(ifelse((th1 <= activity1 | th2 <= activity2) & (outcome == 1), 1, 0)) /
                                                        sum(ifelse(th1 <= activity1 | th2 <= activity2, 1, 0)),2)
                                ), by = location]    
# LIST OF DATA TABLES
dt_list <- Map(calc, thresholds_df$th1, thresholds_df$th2)

# NAME ELEMENTS OF LIST
names(dt_list) <- paste(thresholds_df$th1, thresholds_df$th2, sep="_")

# SAME RESULT AS POSTED EXAMPLE
dt_list$`12_20`  
#    location act_1_thresholds act_2_thresholds application_rate accuracy_rate
# 1:        1               12               20             0.23           0.5
# 2:        2               12               20             0.23           0.5
# 3:        3               12               20             0.23           0.5

А если вам нужно добавить все элементы, используйте data.table's rbindlist:

final_dt <- rbindlist(dt_list)
final_dt

#      location act_1_thresholds act_2_thresholds application_rate accuracy_rate
#   1:        1                7               19             0.32          0.47
#   2:        2                7               19             0.32          0.47
#   3:        3                7               19             0.32          0.47
#   4:        1                8               19             0.32          0.47
#   5:        2                8               19             0.32          0.47
#  ---                                                                          
# 104:        2               11               24             0.20          0.42
# 105:        3               11               24             0.20          0.42
# 106:        1               12               24             0.15          0.56
# 107:        2               12               24             0.15          0.56
# 108:        3               12               24             0.15          0.56