library(tidyverse)
weight<-c(4.528
,4.773
,4.253
,4.688
,4.21
,3.841
,4.005
,4.545
,3.825
,5.123
,4.757)
values <- c(
22.08,21.37)
# a heuristic that says I'm not going to add more than "these" number of entries to hit a target
(most_to_sum <- ceiling(max(values)/min(weight)))
#make combs
combs_to_do <- expand_grid(
set_1 = seq_len(most_to_sum),
set_2 = seq_len(most_to_sum)
) |> rowwise() |> mutate(rsum=sum(set_1,set_2)) |> filter(rsum<=length(weight)) |> ungroup()
unique_sets <- map(seq_len(most_to_sum),
~combn(weight,.x,simplify=FALSE)) |> flatten()
unique_sets_evals <- map_dbl(unique_sets,
~abs(values[[1]] - sum(.x)))
# opportunity here to trade accuracy for speed/memoirt
(set1_reduced <- quantile(unique_sets_evals,1)) # use 1 for exhaustive search; though I got the correct result reducing to 0.01 and even good approximations with less
set1_reduced_sets <- unique_sets[which(unique_sets_evals<=set1_reduced)]
do_second_set <- function(first_sets,size_of_second_set,weight,values){
second_sets <- map(first_sets,~{
available <- setdiff(weight,.x)
if(length(available) < size_of_second_set) return(Inf)
combn(available,size_of_second_set,simplify = FALSE)
})
coeval <- map2(first_sets,second_sets,
~{
x <- .x
y <- .y
xsum <- sum(x)
ysums <- map(y,sum)
evals <- map(ysums,
~sqrt((values[[1]]-xsum)^2+(values[[2]]-.x)^2))
best_y <- y[which.min(evals)]
list(best_second = best_y,
eval=evals[[which.min(evals)]])
})
map2(first_sets,coeval,~c(list(set1=.x),.y))
}
almost_ <- map(seq_len(most_to_sum),
~do_second_set(set1_reduced_sets,.x,weight=weight,values=values)) |> flatten()
all_evals <- map_dbl(almost_,~.x$eval)
(best_eval_num <- which.min(all_evals))
almost_[[best_eval_num]]
> almost_[[best_eval_num]]
$set1
[1] 4.528 4.773 4.253 4.688 3.825
$best_second
$best_second[[1]]
[1] 4.210 3.841 4.005 4.545 4.757
$eval
[1] 0.01769181
> sum( 4.528, 4.773, 4.253,4.688 ,3.825)
[1] 22.067
> sum(4.210, 3.841, 4.005,4.545, 4.757)
[1] 21.358