减少R中向量元素的总和

在R中，我有一个整数向量。从这个向量中，我想随机减少每个整数元素的值，以获得向量的和，即初始和的百分比

在本例中，我想将向量“x”减少为向量“y”，其中每个元素都随机减少，以获得等于初始和50%的元素和

结果向量应具有非负值且低于原始值的值

set.seed(1)
perc<-50            
x<-sample(1:5,10,replace=TRUE)
xsum<-sum(x) # sum is 33
toremove<-floor(xsum*perc*0.01)
x # 2 2 3 5 2 5 5 4 4 1

y<-magicfunction(x,perc)
y # 0 2 1 4 0 3 2 1 2 1
sum(y) # sum is 16 (rounded half of 33)

set.seed（1）
perc假设
x
足够长，我们可以依赖一些适当的大数定律（也假设
x
在某些其他方面足够规则）。为此，我们将生成另一个随机变量Z的值，取[0,1]中的值，并使用mean
perc

set.seed(1)
perc <- 50 / 100
x <- sample(1:10000, 1000)
sum(x)
# [1] 5014161
x <- round(x * rbeta(length(x), perc / 3 / (1 - perc), 1 / 3))
sum(x)
# [1] 2550901
sum(x) * 2
# [1] 5101802
sum(x) * 2 / 5014161 
# [1] 1.017479 # One percent deviation

下面是一个使用Dirichlet分布的绘图的解决方案：

set.seed(1)
x = sample(10000, 1000, replace = TRUE)

magic = function(x, perc, alpha = 1){
    # sample from the Dirichlet distribution
    # sum(p) == 1
    # lower values should reduce by less than larger values
    # larger alpha means the result will have more "randomness"
    p = rgamma(length(x), x / alpha, 1)
    p = p / sum(p)

    # scale p up an amount so we can subtract it from x
    # and get close to the desired sum
    reduce = round(p * (sum(x) - sum(round(x * perc))))
    y = x - reduce

    # No negatives
    y = c(ifelse(y < 0, 0, y))

    return (y)
    }

alpha = 500
perc = 0.7
target = sum(round(perc * x))
y = magic(x, perc, alpha)

# Hopefully close to 1
sum(y) / target
> 1.000048

# Measure of the "randomness"
sd(y / x)
> 0.1376637

set.seed（1）
x=样本（10000，1000，替换=真）
魔术=功能（x，perc，alpha=1）{
#Dirichlet分布的样本
#和（p）==1
#较低的值应小于较大的值
#较大的alpha意味着结果将具有更多的“随机性”
p=rgamma（长度（x），x/α，1）
p=p/总和（p）
#把p放大一个量，这样我们就可以从x中减去它
#并接近所需的总和
减少=四舍五入（p*（总和（x）-总和（四舍五入（x*perc）））
y=x-减少
#没有底片
y=c（如果其他（y<0,0,y））
返回（y）
}
α=500
perc=0.7
目标=总和（四舍五入（perc*x））
y=魔法（x，perc，alpha）
#希望接近1
总数（y）/目标
> 1.000048
#“随机性”的度量
标准差（y/x）
> 0.1376637

基本上，它试图计算出每个元素减少多少，同时仍然接近您想要的总和。您可以通过增加
alpha
来控制新向量的“随机”程度。另一种解决方案是使用此函数，该函数通过与向量元素大小成比例的随机分数对原始向量进行降采样。然后它检查元素是否不低于零，并迭代地接近最优解

removereads<-function(x,perc=NULL){
xsum<-sum(x)
toremove<-floor(xsum*perc)
toremove2<-toremove
irem<-1
while(toremove2>(toremove*0.01)){
    message("Downsampling iteration ",irem)
    tmp<-sample(1:length(x),toremove2,prob=x,replace=TRUE)
    tmp2<-table(tmp)
    y<-x
    common<-as.numeric(names(tmp2))
    y[common]<-x[common]-tmp2
    y[y<0]<-0
    toremove2<-toremove-(xsum-sum(y))
    irem<-irem+1
}
return(y)
}
set.seed(1)
x<-sample(1:1000,10000,replace=TRUE)
perc<-0.9
y<-removereads(x,perc)
plot(x,y,xlab="Before reduction",ylab="After reduction")
abline(0,1)

removeadsmaybe我很困惑，但我不太明白为什么根据你的描述，你不能只做
0.5*x
？还有其他一些你没有提到的标准吗？我们能假设向量是长的吗？至少有200个元素？@JuliusVainora是的，向量可以是任意的long@joran抱歉，我澄清了这一点：向量缩减不应与每个元素成比例，但我是否正确地假设您希望避免计算效率低下的解决方案，例如，采样随机整数，直到其和为和（x）/然后重复地从x中随机减去它们，直到得到一个没有负值的向量？这个解决方案给我留下了深刻的印象@FedericoGiorgi，这个Z的选择非常重要，正如我在答案中所展示的。如果您关心错误，您可能会选择一些非常集中在
perc
周围的分布，可能只在某个区间[perc-epsilon，perc+epsilon]中取值。也就是说，根据问题的细节，解决方案可以改进。当你降低beta分布的方差时，你基本上是在极限内做
x Yes。问题是实际问题需要多少这种随机性（方差）。然而，在保持期望的平均值的同时，你将无法获得超低的贝塔方差。因此，需要一些其他的分布。@FedericoGiorgi，在其他属性中，对称性、较低的方差和较窄的可能值区间有助于提高精度，而较高的方差和较宽的区间则会增加“随机性”。因此，您可以使用这些参数进行实验。目前，您的问题描述没有提供任何关于这些问题应该是什么的信息，而且这也不再是一个真正的编程问题。
removereads<-function(x,perc=NULL){
xsum<-sum(x)
toremove<-floor(xsum*perc)
toremove2<-toremove
irem<-1
while(toremove2>(toremove*0.01)){
    message("Downsampling iteration ",irem)
    tmp<-sample(1:length(x),toremove2,prob=x,replace=TRUE)
    tmp2<-table(tmp)
    y<-x
    common<-as.numeric(names(tmp2))
    y[common]<-x[common]-tmp2
    y[y<0]<-0
    toremove2<-toremove-(xsum-sum(y))
    irem<-irem+1
}
return(y)
}
set.seed(1)
x<-sample(1:1000,10000,replace=TRUE)
perc<-0.9
y<-removereads(x,perc)
plot(x,y,xlab="Before reduction",ylab="After reduction")
abline(0,1)