拼接加权指数并获得平滑值 [英] Splicing weighted index and getting a smooth value
问题描述
我不久前问了这个问题，所提供的答案令我满意.但是，现在我重新运行了代码，我遇到了一个新问题.
I asked this question a while ago, and the answer provided was satisfactory to me. However, now that I reran the code, I have a new issue.
这是数据:
a=1:50
b=14:63
c=rep(1,50)
wa=c(rep(2,5),rep(6,5),rep(5,5),rep(2,15),rep(0,10),rep(1,10))
wb=c(rep(5,5),rep(2,5),rep(1,5),rep(6,15),rep(5,10),rep(0,10))
wc=c(rep(3,5),rep(2,5),rep(4,5),rep(2,15),rep(5,10),rep(9,10))
z=data.frame(a,b,c,wa,wb,wc)
z$ind=rowSums(z[,1:3]*z[,4:6])/rowSums(z[,4:6])
然后我们运行这两个函数:
Then we run these two functions:
changeWeight<-function(x){
test <- NA
for(i in 2:NROW(z)) {
test[i] <- if(z$wa[i]-z$wa[i-1]==0) 0 else 1
}
return(test)
}
z$test<-changeWeight()
还有:
spliceValue <- function(x) {
splice <- 0
for(i in 2:NROW(z)) {
splice[i] <- if(z$test[i]==1) (rowSums(z[i,1:3]*z[i-1,4:6])/rowSums(z[i-1,4:6]))/z$ind[i] else splice[i-1]
}
return(splice)
}
z$splice<-spliceValue()
这就是问题所在.我运行这个:
So here is where it gets problematic. I run this:
z$spind=ifelse(z$splice==0,z$ind,z$splice*z$ind)
并获得以下数据框:
a b c wa wb wc ind test splice spind
1 1 14 1 2 5 3 7.5 NA 0.0000000 7.50000
2 2 15 1 2 5 3 8.2 0 0.0000000 8.20000
3 3 16 1 2 5 3 8.9 0 0.0000000 8.90000
4 4 17 1 2 5 3 9.6 0 0.0000000 9.60000
5 5 18 1 2 5 3 10.3 0 0.0000000 10.30000
6 6 19 1 6 2 2 7.6 1 1.4473684 11.00000
7 7 20 1 6 2 2 8.4 0 1.4473684 12.15789
8 8 21 1 6 2 2 9.2 0 1.4473684 13.31579
9 9 22 1 6 2 2 10.0 0 1.4473684 14.47368
10 10 23 1 6 2 2 10.8 0 1.4473684 15.63158
11 11 24 1 5 1 4 8.3 1 1.3975904 11.60000
12 12 25 1 5 1 4 8.9 0 1.3975904 12.43855
13 13 26 1 5 1 4 9.5 0 1.3975904 13.27711
14 14 27 1 5 1 4 10.1 0 1.3975904 14.11566
15 15 28 1 5 1 4 10.7 0 1.3975904 14.95422
16 16 29 1 2 6 2 20.8 1 0.5432692 11.30000
17 17 30 1 2 6 2 21.6 0 0.5432692 11.73462
18 18 31 1 2 6 2 22.4 0 0.5432692 12.16923
19 19 32 1 2 6 2 23.2 0 0.5432692 12.60385
20 20 33 1 2 6 2 24.0 0 0.5432692 13.03846
21 21 34 1 2 6 2 24.8 0 0.5432692 13.47308
22 22 35 1 2 6 2 25.6 0 0.5432692 13.90769
23 23 36 1 2 6 2 26.4 0 0.5432692 14.34231
24 24 37 1 2 6 2 27.2 0 0.5432692 14.77692
25 25 38 1 2 6 2 28.0 0 0.5432692 15.21154
26 26 39 1 2 6 2 28.8 0 0.5432692 15.64615
27 27 40 1 2 6 2 29.6 0 0.5432692 16.08077
28 28 41 1 2 6 2 30.4 0 0.5432692 16.51538
29 29 42 1 2 6 2 31.2 0 0.5432692 16.95000
30 30 43 1 2 6 2 32.0 0 0.5432692 17.38462
31 31 44 1 0 5 5 22.5 1 1.4577778 32.80000
32 32 45 1 0 5 5 23.0 0 1.4577778 33.52889
33 33 46 1 0 5 5 23.5 0 1.4577778 34.25778
34 34 47 1 0 5 5 24.0 0 1.4577778 34.98667
35 35 48 1 0 5 5 24.5 0 1.4577778 35.71556
36 36 49 1 0 5 5 25.0 0 1.4577778 36.44444
37 37 50 1 0 5 5 25.5 0 1.4577778 37.17333
38 38 51 1 0 5 5 26.0 0 1.4577778 37.90222
39 39 52 1 0 5 5 26.5 0 1.4577778 38.63111
40 40 53 1 0 5 5 27.0 0 1.4577778 39.36000
41 41 54 1 1 0 9 5.0 1 5.5000000 27.50000
42 42 55 1 1 0 9 5.1 0 5.5000000 28.05000
43 43 56 1 1 0 9 5.2 0 5.5000000 28.60000
44 44 57 1 1 0 9 5.3 0 5.5000000 29.15000
45 45 58 1 1 0 9 5.4 0 5.5000000 29.70000
46 46 59 1 1 0 9 5.5 0 5.5000000 30.25000
47 47 60 1 1 0 9 5.6 0 5.5000000 30.80000
48 48 61 1 1 0 9 5.7 0 5.5000000 31.35000
49 49 62 1 1 0 9 5.8 0 5.5000000 31.90000
50 50 63 1 1 0 9 5.9 0 5.5000000 32.45000
所以 z$spind 在第 10 条记录之前都很好，但是在第 11 条记录处，权重 (wa,wb,wc) 发生变化时没有平滑过渡.原因是因为我的 spliceValue 函数被 z$ind 分割，在记录 6 的第一个拼接之后与平滑的不匹配z$spind 的索引.因此 spliceValue 函数的任何后续运行都将返回错误的数字.我为第二个和所有随后的权重更改创建了一个解决方法.
So z$spind is fine up to the 10th record, but at record 11 there is no smooth transition where the weights (wa,wb,wc) change. The reason for that is because my spliceValue function is dividing by z$ind which after the first splice at record 6 does not match with the smoothed index of z$spind. So any subsequent running of the spliceValue function will return the wrong number. I kind of created a workaround for the second and all following changes to the weights.
splicetValue <- function(x) {
splicet <- 0
for(i in 2:NROW(z)) {
splicet[i] <- if(z$test[i]==1&z$splice[i-1]!=0) (rowSums(z[i,1:3]*z[i-1,4:6])/rowSums(z[i-1,4:6]))*z$splice[i-1] else if(z$test[i]==1&z$splice[i-1]==0) (rowSums(z[i,1:3]*z[i-1,4:6])/rowSums(z[i-1,4:6])) else z$spind[i]
}
return(splicet)
}
z$splicet<-splicetValue()
spliceiValue <- function(x) {
splice <- 0
for(i in 2:NROW(z)) {
splice[i] <- if(z$test[i]==1) (z$splicet[i])/z$ind[i] else splice[i-1]
}
return(splice)
}
z$splice<-spliceiValue()
z$spind=ifelse(z$splice==0,z$ind,z$splice*z$ind)
我现在唯一的问题是整个代码需要比 z$test==1 的次数少运行一次.
My only issue now is that this whole code needs to be run one less time than the number of times z$test==1.
所以我通过输入xx=sum(z$test,na.rm=T) 得到z$test==1 的次数.现在我不知道如何将上面的代码包装在一个迭代循环中，以便我的最终结果如下所示:
So I get the number of times z$test==1 by typing xx=sum(z$test,na.rm=T). Now I do not know how to wrap the above code in an iterative loop so that my final result will look like this:
a b c wa wb wc ind test splice spind splicet
1 1 14 1 2 5 3 7.5 NA 0.000000 7.50000 0.00000
2 2 15 1 2 5 3 8.2 0 0.000000 8.20000 8.20000
3 3 16 1 2 5 3 8.9 0 0.000000 8.90000 8.90000
4 4 17 1 2 5 3 9.6 0 0.000000 9.60000 9.60000
5 5 18 1 2 5 3 10.3 0 0.000000 10.30000 10.30000
6 6 19 1 6 2 2 7.6 1 1.447368 11.00000 11.00000
7 7 20 1 6 2 2 8.4 0 1.447368 12.15789 12.15789
8 8 21 1 6 2 2 9.2 0 1.447368 13.31579 13.31579
9 9 22 1 6 2 2 10.0 0 1.447368 14.47368 14.47368
10 10 23 1 6 2 2 10.8 0 1.447368 15.63158 15.63158
11 11 24 1 5 1 4 8.3 1 2.022828 16.78947 16.78947
12 12 25 1 5 1 4 8.9 0 2.022828 18.00317 18.00317
13 13 26 1 5 1 4 9.5 0 2.022828 19.21687 19.21687
14 14 27 1 5 1 4 10.1 0 2.022828 20.43056 20.43056
15 15 28 1 5 1 4 10.7 0 2.022828 21.64426 21.64426
16 16 29 1 2 6 2 20.8 1 1.098940 22.85796 22.85796
17 17 30 1 2 6 2 21.6 0 1.098940 23.73711 23.73711
18 18 31 1 2 6 2 22.4 0 1.098940 24.61626 24.61626
19 19 32 1 2 6 2 23.2 0 1.098940 25.49541 25.49541
20 20 33 1 2 6 2 24.0 0 1.098940 26.37457 26.37457
21 21 34 1 2 6 2 24.8 0 1.098940 27.25372 27.25372
22 22 35 1 2 6 2 25.6 0 1.098940 28.13287 28.13287
23 23 36 1 2 6 2 26.4 0 1.098940 29.01202 29.01202
24 24 37 1 2 6 2 27.2 0 1.098940 29.89118 29.89118
25 25 38 1 2 6 2 28.0 0 1.098940 30.77033 30.77033
26 26 39 1 2 6 2 28.8 0 1.098940 31.64948 31.64948
27 27 40 1 2 6 2 29.6 0 1.098940 32.52863 32.52863
28 28 41 1 2 6 2 30.4 0 1.098940 33.40778 33.40778
29 29 42 1 2 6 2 31.2 0 1.098940 34.28694 34.28694
30 30 43 1 2 6 2 32.0 0 1.098940 35.16609 35.16609
31 31 44 1 0 5 5 22.5 1 1.602011 36.04524 36.04524
32 32 45 1 0 5 5 23.0 0 1.602011 36.84625 36.84625
33 33 46 1 0 5 5 23.5 0 1.602011 37.64725 37.64725
34 34 47 1 0 5 5 24.0 0 1.602011 38.44826 38.44826
35 35 48 1 0 5 5 24.5 0 1.602011 39.24926 39.24926
36 36 49 1 0 5 5 25.0 0 1.602011 40.05027 40.05027
37 37 50 1 0 5 5 25.5 0 1.602011 40.85127 40.85127
38 38 51 1 0 5 5 26.0 0 1.602011 41.65228 41.65228
39 39 52 1 0 5 5 26.5 0 1.602011 42.45328 42.45328
40 40 53 1 0 5 5 27.0 0 1.602011 43.25429 43.25429
41 41 54 1 1 0 9 5.0 1 8.811059 44.05530 44.05530
42 42 55 1 1 0 9 5.1 0 8.811059 44.93640 31.04697
43 43 56 1 1 0 9 5.2 0 8.811059 45.81751 31.65573
44 44 57 1 1 0 9 5.3 0 8.811059 46.69861 32.26450
45 45 58 1 1 0 9 5.4 0 8.811059 47.57972 32.87326
46 46 59 1 1 0 9 5.5 0 8.811059 48.46082 33.48202
47 47 60 1 1 0 9 5.6 0 8.811059 49.34193 34.09079
48 48 61 1 1 0 9 5.7 0 8.811059 50.22304 34.69955
49 49 62 1 1 0 9 5.8 0 8.811059 51.10414 35.30832
50 50 63 1 1 0 9 5.9 0 8.811059 51.98525 35.91708
注意 z$spind 是如何在权重改变时没有巨大的尖峰的.所以这是一个正确拼接的索引.由于权重更改了 5 次，因此需要对上述代码进行 4 次迭代.我想将该代码包装在某种迭代循环中，这就是我想出的，但由于我的 R 技能有限，这是一种徒劳的尝试:
Note how z$spind has no huge spikes whenever the weights are changed. So this is a properly spliced index. This required 4 iterations of the above code since the weights were changed 5 times. I would like to wrap that code in some sort of iterative loop and this is what I came up with but it is a futile attempt as my R skills are limited:
xx=sum(z$test,na.rm=T)
fixValue = function(y) {
for(q in 1:xx-1) {
splicetValue <- function(x) {
splicet <- 0
for(i in 2:NROW(z)) {
splicet[i] <- if(z$test[i]==1&z$splice[i-1]!=0) (rowSums(z[i,1:3]*z[i-1,4:6])/rowSums(z[i-1,4:6]))*z$splice[i-1] else if(z$test[i]==1&z$splice[i-1]==0) (rowSums(z[i,1:3]*z[i-1,4:6])/rowSums(z[i-1,4:6])) else z$spind[i]
}
return(splicet)
}
z$splicet<-splicetValue()
spliceiValue <- function(x) {
splice <- 0
for(i in 2:NROW(z)) {
splice[i] <- if(z$test[i]==1) (z$splicet[i])/z$ind[i] else splice[i-1]
}
return(splice)
}
z$splice<-spliceiValue()
z$spind=ifelse(z$splice==0,z$ind,z$splice*z$ind)
}
}
我做错了什么?
推荐答案
您的代码可以进一步改进，但您错过了使其正常工作的唯一一件事:
Your code could be improved some more, but there is the only thing that you missed to make it work:
xx=sum(z$test,na.rm=T)
fixValue = function() { ## argument is not needed
for(q in 1:xx-1) {
splicetValue <- function(x) {
splicet <- 0
for(i in 2:NROW(z)) {
splicet[i] <- if(z$test[i]==1&z$splice[i-1]!=0) (rowSums(z[i,1:3]*z[i-1,4:6])/rowSums(z[i-1,4:6]))*z$splice[i-1] else if(z$test[i]==1&z$splice[i-1]==0) (rowSums(z[i,1:3]*z[i-1,4:6])/rowSums(z[i-1,4:6])) else z$spind[i]
}
return(splicet)
}
z$splicet<-splicetValue()
spliceiValue <- function(x) {
splice <- 0
for(i in 2:NROW(z)) {
splice[i] <- if(z$test[i]==1) (z$splicet[i])/z$ind[i] else splice[i-1]
}
return(splice)
}
z$splice<-spliceiValue()
z$spind=ifelse(z$splice==0,z$ind,z$splice*z$ind)
}
return(z) ## this one
}
fixValue()
这篇关于拼接加权指数并获得平滑值的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
