Question

У меня есть модель, написанная как для l oop, которая включает в себя ряд параметров, которые я указываю:

## functions needed to run the model
learn <- function(prior, sensi, speci, e){
  out <- ifelse(e == 1, (sensi*prior) / ((sensi*prior) + (1-speci)*(1-prior)),
                ((1-sensi)*prior) / (((1-sensi)*prior) + (speci*(1-prior))))
  out
}

feed <- function(vec){
  prior <- 0.5
  for (i in vec){
    res <- learn(prior, sensi, speci, i)
    prior <- res
  }
  return(prior)
}

## specify parameters
iterations <- 100
N <- 10
BR <- 0.66
sensi <- 0.75
speci <- 0.45

## initialize results object
res <- NULL

## loop for number of iterations
for (j in 1:iterations){
  
  X <- as.numeric(rbinom(1, 1, BR))
  
  if (X == 1){ # if X is 1...
    agents <- c(1:N) 
    evidence <- vector("list", length(agents)) 
    for (i in agents) {
      n <- sample(10, 1, replace = TRUE) 
      evidence[[i]] <- rbinom(n, 1, sensi) 
    }
  } else { # if X is 0... 
    agents <- c(1:N)
    evidence <- vector("list", length(agents)) 
    for (i in agents) {
      n <- sample(10, 1, replace = TRUE) 
      evidence[[i]] <- rbinom(n, 1, sensi) 
      evidence[[i]] <- ifelse(evidence[[i]]==1, 0, 1) # flip evidence 
    }
  }
  
  # feed vectors of evidence through learn function
  t0 <- sapply(evidence, feed)
  
  # save dataframe 
  df <- data.frame("i" = j, 
                   "ID" = c(1:N), 
                   "E" = t0, 
                   "X" = X,
                   "N" = N, 
                   "BR" = BR,
                   "sensi" = sensi,
                   "speci" = speci)

  res <- rbind(res, df)
  
}

Это отлично работает для одной параметризации, но теперь я хочу автоматизировать процесс указания различных значений параметров и повторного запуска модели. Поэтому вместо определения каждого параметра как отдельного значения я определяю их как вектор значений и сохраняю все возможные параметризации в кадре данных (paramspace), где каждая строка содержит значения для одной параметризации, которую я хочу запустить:

## set up for multiple parameterizations 
iterations <- 100
N_vec <- c(10, 50)
BR_vec <- c(0.25, 0.50, 0.75) 
sensi_vec <- c(0.45, 0.75)
speci_vec <- c(0.45, 0.75)

paramspace <- expand.grid(iterations = iterations, N = N_vec, BR = BR_vec, sensi = sensi_vec, speci = speci_vec)

> paramspace
   iterations  N   BR sensi speci
1         100 10 0.25  0.45  0.45
2         100 50 0.25  0.45  0.45
3         100 10 0.50  0.45  0.45
4         100 50 0.50  0.45  0.45
5         100 10 0.75  0.45  0.45
6         100 50 0.75  0.45  0.45
7         100 10 0.25  0.75  0.45
8         100 50 0.25  0.75  0.45
9         100 10 0.50  0.75  0.45
10        100 50 0.50  0.75  0.45
11        100 10 0.75  0.75  0.45
12        100 50 0.75  0.75  0.45
13        100 10 0.25  0.45  0.75
14        100 50 0.25  0.45  0.75
15        100 10 0.50  0.45  0.75
16        100 50 0.50  0.45  0.75
17        100 10 0.75  0.45  0.75
18        100 50 0.75  0.45  0.75
19        100 10 0.25  0.75  0.75
20        100 50 0.25  0.75  0.75
21        100 10 0.50  0.75  0.75
22        100 50 0.50  0.75  0.75
23        100 10 0.75  0.75  0.75
24        100 50 0.75  0.75  0.75

Как я могу передать каждую строку значений параметров моей модели и автоматически пройти через все параметризации, указанные в paramspace?

Waldi · Answer 1 · 12 июля 2020

Как предложено в комментариях, вы можете создать функцию, а затем использовать от apply до l oop вместо комбинаций параметров:


## functions needed to run the model
learn <- function(prior, sensi, speci, e){
  out <- ifelse(e == 1, (sensi*prior) / ((sensi*prior) + (1-speci)*(1-prior)),
                ((1-sensi)*prior) / (((1-sensi)*prior) + (speci*(1-prior))))
  out
}

feed <- function(vec,sensi,speci){
  prior <- 0.5
  for (i in vec){
    res <- learn(prior, sensi, speci, i)
    prior <- res
  }
  return(prior)
}

runModel <- function(iterations = 100,
                     N = 10,
                     BR = 0.66,
                     sensi = 0.75,
                     speci = 0.45 ) {
  ## initialize results object
  res <- NULL
  
  ## loop for number of iterations
  for (j in 1:iterations){
    
    X <- as.numeric(rbinom(1, 1, BR))
    
    if (X == 1){ # if X is 1...
      agents <- c(1:N) 
      evidence <- vector("list", length(agents)) 
      for (i in agents) {
        n <- sample(10, 1, replace = TRUE) 
        evidence[[i]] <- rbinom(n, 1, sensi) 
      }
    } else { # if X is 0... 
      agents <- c(1:N)
      evidence <- vector("list", length(agents)) 
      for (i in agents) {
        n <- sample(10, 1, replace = TRUE) 
        evidence[[i]] <- rbinom(n, 1, sensi) 
        evidence[[i]] <- ifelse(evidence[[i]]==1, 0, 1) # flip evidence 
      }
    }
    
    # feed vectors of evidence through learn function
    #t0 <- sapply(evidence, feed)
    t0 <- sapply(evidence,function(e){feed(e,sensi,speci)})
    
    # save dataframe 
    df <- list("i" = iterations, 
               "ID" = c(1:N), 
               "E" = t0, 
               "X" = X,
               "N" = N, 
               "BR" = BR,
               "sensi" = sensi,
               "speci" = speci)
    
    res <- rbind(res, df)
    
  }
  res
}

# Define parameter space
iterations <- 100
N_vec <- c(10, 50)
BR_vec <- c(0.25, 0.50, 0.75) 
sensi_vec <- c(0.45, 0.75)
speci_vec <- c(0.45, 0.75)

paramspace <- expand.grid(iterations = iterations, N = N_vec, BR = BR_vec, sensi = sensi_vec, speci = speci_vec)

# Loop over parameter space :
res <- apply(paramspace,1,function(paramset) {
  iterations = paramset[1]
  N = paramset[2]
  BR = paramset[3]
  sensi = paramset[4]
  speci = paramset[5]
  runModel(iterations = iterations, N = N, BR = BR , sensi = sensi, speci = speci )
})

lulions · Answer 2 · 18 июля 2020

Вы также можете использовать пакет foreach, который используется с соответствующим сервером, предлагает возможности распараллеливания, если ваша задача становится более интенсивной. Вот простой пример, чтобы понять, как это работает.

foreach(a=1:3, b=4:6) %do% (a + b)

Затем я попытался встроить ваш код в foreach


require(foreach)

## functions needed to run the model
learn <- function(prior, sensi, speci, e){
  out <- ifelse(e == 1, (sensi*prior) / ((sensi*prior) + (1-speci)*(1-prior)),
                ((1-sensi)*prior) / (((1-sensi)*prior) + (speci*(1-prior))))
  out
}

feed <- function(vec){
  prior <- 0.5
  for (i in vec){
    res <- learn(prior, sensi, speci, i)
    prior <- res
  }
  return(prior)
}


## set up for multiple parameterizations 
iterations <- 100
N_vec <- c(10, 50)
BR_vec <- c(0.25, 0.50, 0.75) 
sensi_vec <- c(0.45, 0.75)
speci_vec <- c(0.45, 0.75)

paramspace <- expand.grid(iterations = iterations, N = N_vec, BR = BR_vec, sensi = sensi_vec, speci = speci_vec)

res <- foreach(iterations = paramspace$iterations, 
               N = paramspace$N, 
               BR = paramspace$BR, 
               sensi = paramspace$sensi, 
               speci = paramspace$speci) %do% {
                 
                 ## initialize results object
                 res <- NULL
                 
                 ## loop for number of iterations
                 for (j in 1:iterations){
                   
                   X <- as.numeric(rbinom(1, 1, BR))
                   
                   if (X == 1){ # if X is 1...
                     agents <- c(1:N) 
                     evidence <- vector("list", length(agents)) 
                     for (i in agents) {
                       n <- sample(10, 1, replace = TRUE) 
                       evidence[[i]] <- rbinom(n, 1, sensi) 
                     }
                   } else { # if X is 0... 
                     agents <- c(1:N)
                     evidence <- vector("list", length(agents)) 
                     for (i in agents) {
                       n <- sample(10, 1, replace = TRUE) 
                       evidence[[i]] <- rbinom(n, 1, sensi) 
                       evidence[[i]] <- ifelse(evidence[[i]]==1, 0, 1) # flip evidence 
                     }
                   }
                   
                   # feed vectors of evidence through learn function
                   t0 <- sapply(evidence, feed)
                   
                   # save dataframe 
                   df <- data.frame("i" = j, 
                                    "ID" = c(1:N), 
                                    "E" = t0, 
                                    "X" = X,
                                    "N" = N, 
                                    "BR" = BR,
                                    "sensi" = sensi,
                                    "speci" = speci)
                   
                   res <- rbind(res, df)
                   
                 }
                 
                 res
                 
               }

Cole · Answer 3 · 18 июля 2020

Другой подход - создать функцию и использовать Map(...). Преимущество Map состоит в том, что ваш paramspace не будет преобразован в матрицу, которая сделает все одного типа (например, numeri c, character, et c.).

Там были также некоторые другие изменения, которые я сделал, чтобы позволить R вести учет за нас. В первую очередь:

X теперь является логическим, поэтому мы можем упростить наши инструкции if. Кроме того, распределение выполняется сразу, а не в цикле.
Мы изменяем функцию feed(), чтобы она также генерировала evidence. Это позволяет нам ...
Используйте replicate для повторения циклов.

learn2 <- function(prior, sensi, speci, e){
    out <- ifelse(e, (sensi*prior) / ((sensi*prior) + (1-speci)*(1-prior)),
                  ((1-sensi)*prior) / (((1-sensi)*prior) + (speci*(1-prior))))
    out
}


feed2  = function(x, N, samp_n = 10L, sensi, speci) {
    evidence = rbinom(sample(samp_n, 1L, replace = TRUE), 
                      1,
                      if (x) sensi else 1 - sensi)
    
    prior = 0.5
    for (i in evidence) {
        res = learn2(prior, sensi, speci, i)
        prior = res
    }
    return(prior)
}

runModel2 <- function(iterations = 2,
                     N = 10,
                     BR = 0.66,
                     sensi = 0.75,
                     speci = 0.45 ) {
    
    X = sample(c(TRUE, FALSE), N, BR)
    
    ## this is done now so that the columns will be ordered nicer
    ans = list(ID = 1:N,
                N = N,
               BR = BR,
               sensi = sensi,
               speci = speci,
               X = X)
    
    t0s = replicate(iterations,
                    vapply(X, feed2, FUN.VALUE = 0, N, 10L, sensi, speci, USE.NAMES = FALSE), 
                    simplify = FALSE)
    
    names(t0s) = paste0("E_", 1:iterations)
    
    return(as.data.frame(c(ans, t0s)))
}

runModel2()
#>    ID  N   BR sensi speci     X        E_1         E_2
#> 1   1 10 0.66  0.75  0.45  TRUE 0.82967106 0.657648599
#> 2   2 10 0.66  0.75  0.45 FALSE 0.43103448 0.006827641
#> 3   3 10 0.66  0.75  0.45  TRUE 0.43103448 0.775671866
#> 4   4 10 0.66  0.75  0.45  TRUE 0.71716957 0.431034483
#> 5   5 10 0.66  0.75  0.45 FALSE 0.24176079 0.016593958
#> 6   6 10 0.66  0.75  0.45 FALSE 0.30303324 0.008992838
#> 7   7 10 0.66  0.75  0.45  TRUE 0.82967106 0.865405260
#> 8   8 10 0.66  0.75  0.45 FALSE 0.43103448 0.439027817
#> 9   9 10 0.66  0.75  0.45 FALSE 0.57692308 0.050262167
#> 10 10 10 0.66  0.75  0.45 FALSE 0.02178833 0.296208531

Этот вывод немного шире, чем ваш исходный подход. Мы всегда можем изменить форму столбцов E_#, но это может оказаться лучше для вашего фактического использования.

Наконец, вот Map() в действии:

iterations <- 100
N_vec <- c(10, 50)
BR_vec <- c(0.25, 0.50, 0.75) 
sensi_vec <- c(0.45, 0.75)
speci_vec <- c(0.45, 0.75)

paramspace <- expand.grid(iterations = iterations, N = N_vec, BR = BR_vec, sensi = sensi_vec, speci = speci_vec)

res = Map(runModel2, paramspace$iterations, paramspace$N, paramspace$BR, paramspace$sensi, paramspace$speci)

res[[24L]][1:10, 1:8] ## only first 10 rows for demonstration
##   ID  N   BR sensi speci     X         E_1         E_2
##1   1 50 0.75  0.75  0.75  TRUE 0.500000000 0.500000000
##2   2 50 0.75  0.75  0.75 FALSE 0.001369863 0.035714286
##3   3 50 0.75  0.75  0.75 FALSE 0.250000000 0.900000000
##4   4 50 0.75  0.75  0.75  TRUE 0.750000000 0.250000000
##5   5 50 0.75  0.75  0.75  TRUE 0.987804878 0.500000000
##6   6 50 0.75  0.75  0.75  TRUE 0.964285714 0.250000000
##7   7 50 0.75  0.75  0.75  TRUE 0.750000000 0.750000000
##8   8 50 0.75  0.75  0.75 FALSE 0.012195122 0.035714286
##9   9 50 0.75  0.75  0.75  TRUE 0.750000000 0.500000000
##10 10 50 0.75  0.75  0.75 FALSE 0.250000000 0.001369863

Как перебирать параметры в цикле for

Пожалуйста, войдите или зарегистрируйтесь чтобы ответить на этот вопрос.

Ответы [ 3 ]

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Как перебирать параметры в цикле for

Пожалуйста, войдите или зарегистрируйтесь чтобы ответить на этот вопрос.

Ответы [ 3 ]

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Похожие темы