R x 1 r:R:x'probs'外[0 1]

关于R x 1 r的问题,在probs中经常遇到, 我使用 R 编程语言。

我使用 R 编程语言。

我正在尝试按照 R(https://cran.r-project.org/web/packages/optimization/optimization.pdf)中的“优化”包中的说明进行操作,并在特定功能上使用此包中的功能。

对于这个例子,我首先生成一些随机数据:

#load libraries
library(dplyr)
# create some data for this example
a1 = rnorm(1000,100,10)
b1 = rnorm(1000,100,5)
c1 = sample.int(1000, 1000, replace = TRUE)
train_data = data.frame(a1,b1,c1)

从这里,我定义了我想要优化的函数 (“适应度”)。这个函数需要 7 个输入,并计算一个“总”均值 (单个标量值)。这个函数所需的输入是:

“random_1”(介于 80 和 120 之间)

“random_2”(介于“random_1”和 120 之间)

“random_3”(介于 85 和 120 之间)

“random_4”(介于 random_2 和 120 之间)

“split_1”(介于 0 和 1 之间)

“split_2”(介于 0 和 1 之间)

“split_3”(介于 0 和 1 之间)

要优化的函数定义如下:

library(optimization)
fitness <- function(x) {
  #bin data according to random criteria
  train_data <- train_data %>% 
                 mutate(cat = ifelse(a1 <= x[1] & b1 <= x[3], "a", 
                               ifelse(a1 <= x[2] & b1 <= x[4], "b", "c")))
 train_data$cat = as.factor(train_data$cat)
    
    #new splits
    a_table = train_data %>%
        filter(cat == "a") %>%
        select(a1, b1, c1, cat)
    
    b_table = train_data %>%
        filter(cat == "b") %>%
        select(a1, b1, c1, cat)
    
    c_table = train_data %>%
        filter(cat == "c") %>%
        select(a1, b1, c1, cat)
    
   
    
    #calculate  quantile ("quant") for each bin
    
    table_a = data.frame(a_table%>% group_by(cat) %>%
                             mutate(quant = quantile(c1, prob = x[5])))
    
    table_b = data.frame(b_table%>% group_by(cat) %>%
                             mutate(quant = quantile(c1, prob = x[6])))
    
    table_c = data.frame(c_table%>% group_by(cat) %>%
                             mutate(quant = quantile(c1, prob = x[7])))
    
    
    
    
    #create a new variable ("diff") that measures if the quantile is bigger tha the value of "c1"
    table_a$diff = ifelse(table_a$quant > table_a$c1,1,0)
    table_b$diff = ifelse(table_b$quant > table_b$c1,1,0)
    table_c$diff = ifelse(table_c$quant > table_c$c1,1,0)
    
    #group all tables
    
    final_table = rbind(table_a, table_b, table_c)
# calculate the total mean : this is what needs to be optimized
    mean = mean(final_table$diff)
    
    
}

从这里,我试图运行以下优化功能:

Output <- optim_nm(fitness, k = 7, trace = TRUE)
plot(output)
 plot(Output, 'contour')

但这些返回以下错误:

 Error: Problem with `mutate()` column `quant`.
i `quant = quantile(c1, prob = x[6])`.
x 'probs' outside [0,1]
Run `rlang::last_error()` to see where the error occurred. 
Error in plot(Output) : object 'Output' not found

我认为错误是“split_1”,“split_2”和“split_3”变量被分配 0 和 1 之外的值:由于函数使用这些变量用于计算百分位数(例如quant = quantile(c1, prob = x[5]),这自然会导致错误?

我试图使用这个包中的另一个优化算法,其中明确定义了这 7 个输入的范围,但这也产生了相同的错误:

ro_sa <- optim_sa(fun = fitness,
start = c(runif(7, min = -1, max = 1)),
lower = c(80,80,80,80,0,0,0),
upper = c(120,120,120,120,1,1,1),
trace = TRUE,
control = list(t0 = 100,
nlimit = 550,
t_min = 0.1,
dyn_rf = FALSE,
rf = 1,
r = 0.7
)
)
 Error: Problem with `mutate()` column `quant`.
i `quant = quantile(c1, prob = x[6])`.
x 'probs' outside [0,1]

如果您提供初始起点,这也不起作用:

optim_nm(fitness, start = c(80,80,80,80,0.5,0.6,0.7))
 Error: Problem with `mutate()` column `quant`.
i `quant = quantile(c1, prob = x[5])`.
x 'probs' outside [0,1]
i The error occurred in group 1: cat = a.

问题:有人可以告诉我如何解决这个问题,以便我可以运行优化功能?

#desired functions to run:
Output <- optim_nm(fitness, k = 7, trace = TRUE)
plot(output)
 plot(Output, 'contour')
ro_sa <- optim_sa(fun = fitness,
start = c(runif(7, min = -1, max = 1)),
lower = c(80,80,80,80,0,0,0),
upper = c(120,120,120,120,1,1,1),
trace = TRUE,
control = list(t0 = 100,
nlimit = 550,
t_min = 0.1,
dyn_rf = FALSE,
rf = 1,
r = 0.7
)
)
optim_nm(fitness, start = c(80,80,80,80,0.5,0.6,0.7))

谢谢

1

生成的x值是随机的,它们可以是正的或负的。quantileprobs参数需要具有 0 到 1 之间的值。一种方法是采用x[5:7]的绝对值,然后使用prop.table将它们转换为比率。

x[5:7] <- prop.table(abs(x[5:7]))

完整功能-

library(optimization)
fitness <- function(x) {
  #bin data according to random criteria
  train_data <- train_data %>% 
    mutate(cat = ifelse(a1 <= x[1] & b1 <= x[3], "a", 
                        ifelse(a1 <= x[2] & b1 <= x[4], "b", "c")))
  
  train_data$cat = as.factor(train_data$cat)
  
  #new splits
  a_table = train_data %>%
    filter(cat == "a") %>%
    select(a1, b1, c1, cat)
  
  b_table = train_data %>%
    filter(cat == "b") %>%
    select(a1, b1, c1, cat)
  
  c_table = train_data %>%
    filter(cat == "c") %>%
    select(a1, b1, c1, cat)
  
  
  x[5:7] <- prop.table(abs(x[5:7]))
  
  #calculate  quantile ("quant") for each bin
  
  table_a = data.frame(a_table%>% group_by(cat) %>%
                         mutate(quant = quantile(c1, prob = x[5])))
  
  table_b = data.frame(b_table%>% group_by(cat) %>%
                         mutate(quant = quantile(c1, prob = x[6])))
  
  table_c = data.frame(c_table%>% group_by(cat) %>%
                         mutate(quant = quantile(c1, prob = x[7])))
  
  
  #create a new variable ("diff") that measures if the quantile is bigger tha the value of "c1"
  table_a$diff = ifelse(table_a$quant > table_a$c1,1,0)
  table_b$diff = ifelse(table_b$quant > table_b$c1,1,0)
  table_c$diff = ifelse(table_c$quant > table_c$c1,1,0)
  
  #group all tables
  
  final_table = rbind(table_a, table_b, table_c)
  # calculate the total mean : this is what needs to be optimized
  mean = mean(final_table$diff) 
}

您可以应用和绘制此函数-

Output <- optim_nm(fitness, k = 7, trace = TRUE)
plot(Output)

enter image description here

本站系公益性非盈利分享网址,本文来自用户投稿,不代表码文网立场,如若转载,请注明出处

(761)
纯手工女士毛衣的样式:手工制作的英雄.emacs文件(handmade hero)
上一篇
Cst是什么期刊:为什么R不将“CST”识别为有效时区(what is the ct time zone)
下一篇

相关推荐

发表评论

登录 后才能评论

评论列表(61条)