Question

我正在尝试在R中编写一段优化代码，以计算关于果蝇蝇的生物学问题的一组未知值。

数据帧由13列（为清晰起见，下面的代码仅显示9列）组成，行数不同。前三列包含收集的数据，其余各列使用各种公式计算。最初，两个列Missing_C和Missing_D填充了空数据，并且在优化问题中代表初始值。

  Time.min. Prob_C Prob_D Miss_C Miss_D Event_C Event_D Risk_C Risk_D
1         0   1.00   1.00         0         0    0.00    0.00  86.00  78.00
2         5   0.98   0.97         0         0    1.93    1.98  84.07  76.02
3        16   0.84   0.95         0         0   10.67    1.90  73.40  74.12
4        17   0.50   0.75         0         0   21.02   12.85  52.38  61.27
5        20   0.30   0.50         0         0   14.97   15.32  37.42  45.95

作为所用某些公式的示例，Event_C和Risk_C的for循环计算如下：

#define values for events_c and risk_c with for loops`

temp_events_c <-vector()
temp_risk_c <-vector()


for (i in 2:no_rows) {
  temp_events_c <- ((prob_c[i] * risk_c[i-1]) - (prob_c[i] * miss_c[i-1]) - (prob_c[i-1] * risk_c[i-1]) + (prob_c[i-1] * miss_c[i-1])) / (prob_c[i] - (2 * prob_c[i-1]))
  events_c[i] <- temp_events_c
  temp_risk_c <- risk_c[i-1] - miss_c[i-1] - events_c[i]
  risk_c[i] <- temp_risk_c
}

从这些数据中，我还有一个单独的，收集的值（在本例中为9.1），它与表中的值相关。以下函数在Event_C，Event_D列和上面未显示的两列Expected_C和Expected_D中定义了与该值的关系，其中这些列的总和由x [1]，x [2]，x [3]表示， x [4]：

fn <- function(x) ((x[1]-x[2])^2)/x[2] + ((x[3]-x[4])^2)/x[4]

然后，我想使用一个最小化算法，即slsqp中的nloptr来计算Miss_C和Miss_D中最终满足该单个值的值。优化的额外代码如下所示：

x0 <- c(Miss_C,Miss_D)

heq <- function(x) (((x[1]-x[2])^2)/x[2] + ((x[3]-x[4])^2)/x[4]) - 9.1  # heq == 0

slsqp(x0, fn, gr = NULL, 
      hin = NULL, heq = heq)

很显然，这是行不通的，因为初始值没有直接包含在需要解决的函数中，这就是我要坚持的重点！我不确定这是否是一个优化问题或更多的一般R编码问题-无论哪种方式，任何帮助将不胜感激。

干杯，安德鲁

*编辑-根据请求添加完整的代码*

#input variables

time_vector <- c(0,5,16,17,20)

prob_c <- c(1,0.977,0.835,0.5,0.30)

prob_d <- c(1,0.974,0.949,0.75,0.50)

miss_c <- c(0,0,0,0,0)

miss_d <- c(0,0,0,0,0)

#get number of rows

no_rows <- length(time_vector)

#fill events columns with dummy data

events_c <- c(0:(no_rows - 1))
events_d <- c(0:(no_rows - 1))

#define starting number at risk

risk_c_t0 <- 86
risk_d_t0 <- 78


#add t0 risk to each column

risk_c <- risk_c_t0
risk_d <-risk_d_t0

#fill risk columns with dummy data

risk_c[2:no_rows] <- c(2:no_rows)
risk_d[2:no_rows] <- c(2:no_rows)


#re-define values for events_c and risk_c with for loops

temp_events_c <-vector()
temp_risk_c <-vector()


for (i in 2:no_rows) {
  temp_events_c <- ((prob_c[i] * risk_c[i-1]) - (prob_c[i] * miss_c[i-1]) - (prob_c[i-1] * risk_c[i-1]) + (prob_c[i-1] * miss_c[i-1])) / (prob_c[i] - (2 * prob_c[i-1]))
  events_c[i] <- temp_events_c
  temp_risk_c <- risk_c[i-1] - miss_c[i-1] - events_c[i]
  risk_c[i] <- temp_risk_c
}

#re-define values for events_t with for loops

temp_events_d <-vector()
temp_risk_d <-vector()

for (j in 2:no_rows) {
  temp_events_d <- ((prob_d[j] * risk_d[j-1]) - (prob_d[j] * miss_d[j-1]) - (prob_d[j-1] * risk_d[j-1]) + (prob_d[j-1] * miss_d[j-1])) / (prob_d[j] - (2 * prob_d[j-1]))
  events_d[j] <- temp_events_d
  temp_risk_d <- risk_d[j-1] - miss_d[j-1] - events_d[j]
  risk_d[j] <- temp_risk_d
}

#calculate total risk, events and expected
total_risk <- risk_c + risk_d

total_events <- events_c + events_d

expected_c <- (risk_c * (total_events/total_risk))

expected_d <- (risk_d * (total_events/total_risk))

#place values into dataframe

df1 <- data.frame(time_vector,prob_c,prob_d, miss_c, miss_d, events_c, events_d, risk_c, risk_d, total_risk, total_events, expected_c, expected_d)

#sum of values
sum_events_C <- sum(events_c)

sum_events_d <- sum(events_d)

sum_expected_c <- sum(expected_c)

sum_expected_d <- sum(expected_d)

#chi_sq formula
chi_sq_combo <- (((sum_events_C - sum_expected_c)^2)/sum_expected_c) + (((sum_events_d - sum_expected_d)^2)/sum_expected_d)


#### end of table calculations before sim

#x <- c(sum_events_C, sum_expected_c, sum_events_d, sum_expected_d)

#x0 <- c(miss_c,miss_d) #inital values


#fn <- function(x) ((x[1]-x[2])^2)/x[2] + ((x[3]-x[4])^2)/x[4]

#heq <- function(x) (((x[1]-x[2])^2)/x[2] + ((x[3]-x[4])^2)/x[4]) - 6.5  # heq == 0


#slsqp(x0, fn, gr = NULL, 
 #     hin = NULL, heq = heq)

Answer 1

改写上面的评论，我相信问题在于使用优化来查找产生目标卡方值的两个值。一个可能引起问题的麻烦是，可能有许多解决方案可以达到目标，因此可能有必要添加其他要求以使答案唯一。

为此，您需要一个具有两个变量的函数，该函数使用这些变量和目标值计算卡方值与目标值之间的差的平方，然后将其最小化。

例如，

fn2 <- function(x) {
  c <- x[1]
  d <- x[2]
  chisq <- (((c - sum_expected_c)^2)/sum_expected_c) + 
           (((d - sum_expected_d)^2)/sum_expected_d)
  (chisq - 6.5)^2
}
for (i in 1:no_rows) {
  x0 <- c(df1$miss_c[i],df1$miss_d[i]) #initial values
  res <- nloptr::slsqp(x0, fn2)
  miss_c[i] <- res$par[1]
  miss_d[i] <- res$par[2]
}

这5次都给出相同的值，所以我可能不完全了解您。

当初始值未直接包含在目标函数中时，如何在R中编写优化代码？

1 个答案: