r How do I rescale a range of numbers with these constraints?

Viewed 73

I need to rescale a series of numbers with certain constraints.

Let's say I have a vector like this:

x <- c(0.5, 0.3, 0.6, 0.4, 0.9, 0.1, 0.2, 0.3, 0.6)

  1. The sum of x must be 6. Right now the sum of x = 3.9.
  2. The numbers cannot be lower than 0
  3. The numbers cannot be higher than 1

I know how to do 1 and 2+3 separately, but not together. How do I rescale this?

EDIT: As was tried by r2evans, preferably the relative relationships of the numbers is preserved

2 Answers

I don't know that this can be done with a simple expression, but we can optimize our way through it:

opt <- optimize(function(z) abs(6 - sum( z + (1-z) * (x - min(x)) / diff(range(x)) )),
                lower=0, upper=1)
opt
# $minimum
# [1] 0.2380955
# $objective
# [1] 1.257898e-06
out <- ( opt$minimum + (1-opt$minimum) * (x - min(x)) / diff(range(x)) )
out
#  [1] 0.6190477 0.4285716 0.7142858 0.5238097 1.0000000 0.2380955 0.3333335 0.4285716 0.7142858 1.0000000
sum(out)
# [1] 6.000001

Because that is note perfectly 6, we can do one more step to safeguard it:

out <- out * 6/sum(out)
out
# [1] 0.6190476 0.4285715 0.7142857 0.5238096 0.9999998 0.2380954 0.3333335 0.4285715 0.7142857 0.9999998
sum(out)
# [1] 6

This process preserves the relative relationships of the numbers. If there are more "low" numbers than "high" numbers, scaling so that the sum is 6 will bring the higher numbers above 1. To compensate for that, we shift the lower-end (z in my code), so that all numbers are nudged up a little (but the lower numbers will be nudged up proportionately more).

The results should always be that the numbers are in [opt$minimum,1], and the sum will be 6.

Should be possible with a while loop to increase the values of x (to an upper limit of 1)

x <- c(0.5, 0.3, 0.6, 0.4, 0.9, 0.1, 0.2, 0.3, 0.6)

current_sum = sum(x)

target_sum = 6

while (!current_sum == target_sum) {
  print(current_sum)

  perc_diff <- (target_sum - current_sum) / target_sum
  
  x <- x * (1 + perc_diff)
  
  x[which(x > 1)] <- 1
  
  current_sum = sum(x)
}

x <- c(0.833333333333333, 0.5, 1, 0.666666666666667, 1, 0.166666666666667, 
0.333333333333333, 0.5, 1)

There is likely a more mathematical way

Related