r - トランザクション (カウント) と割り当ての制約による最適化

Question

苦労している最適化問題のサンプル コードをいくつか作成しました。アイデアは、さまざまなアセットを表す長さ 100 のベクトルがあるということです。各アセットには、関連する要素があります。保有する流動資産とその配分率のベクトルがあります。これはより大きな予算の一部であるため、この割り当ての合計は 100% 未満の値になります。目的は、配分 (この問題では 70%) が同じままで、目標の加重平均係数値にできるだけ近くなるように資産を移動することです。追加の制約として、最大 5 つのトランザクションを行うことができます。これは、1 つの資産を削減して別の資産を追加できることを意味し、それは 2 つのトランザクションになります。

問題は、この最適化を実行すると、最初の重みが生成されることです。変更が行われるとすぐに value_constraint に違反するためだと思います。この問題にアプローチする方法について、誰かに推奨事項はありますか?

これは、モデルを実行するために使用できるコードです。2 つの資産が 2 つの異なる資産と交換されるシナリオ (テスト ケース) を含めました。役に立たない場合は無視してかまいませんが、このシナリオは両方を満たしています。また、seed(1) を使用すると、さらに悪い結果が生じます。

set.seed(1)

number_of_assets <- 100
max_transactions <- 5
sum_of_assets_value <- 0.70

factors <- runif(number_of_assets, 0, 10)

current_weights <- c(rep(sum_of_assets_value/5, 5), rep(0, number_of_assets-5))
current_factor <- current_weights %*% factors

lower_bound <- -current_weights
upper_bound <- rep(sum_of_assets_value, number_of_assets)


#test model manually with simple scenario
weights <- c(rep(0, 2), rep(sum_of_assets_value/5, 5), rep(0, number_of_assets-7)) #test case for functionality
change_count_constraint <- sum((current_weights^2 - weights^2)^2 > 0) <= max_transactions #constraint should be met with only 4 assets changed
total_value_constraint <- sum(weights) == sum_of_assets_value # constraint is met since weights sum to desired amount
new_factor <- weights %*% factors #new factor from the test case
target_factor <- 1.5 #target factor for testing
difference <- (target_factor - new_factor)^2 #square the difference, since we are attempting to minimize the absolute value of the difference
#end test case


 #this is the function for the optimization, includes the two constraints and assigns a penalty if violated
evalFunc <- function(optweights){
  new_factor <- optweights %*% factors

  count_constraint <- sum((current_weights^2 - optweights^2)^2 > 0) <= max_transactions
  value_constraint <- sum(optweights) == sum_of_assets_value
  if(count_constraint == FALSE | value_constraint == FALSE){penalty <- 100000}

  result <- (target_factor - new_factor)^2 + penalty
  result
}


optimization <- optim(current_weights, #starting weights
                      evalFunc, 
                      lower=lower_bound, upper=upper_bound, 
                      method="L-BFGS-B", 
                      control= list(maxit=5000))