diff options
| -rw-r--r-- | R/interpweights.R | 35 |
1 files changed, 35 insertions, 0 deletions
diff --git a/R/interpweights.R b/R/interpweights.R index 03de58d7..1e9d50c5 100644 --- a/R/interpweights.R +++ b/R/interpweights.R @@ -7,6 +7,41 @@ interpweights <- function(w, v1, v2){ return(interpweights)
}
+interpvalues <- function(w, v, neww){
+ cumw <- cumsum(w)
+ test <- splinefun(v, cumw, method="monoH.FC")
+ eps <- 1e-3
+ newv <- rep(0, length(neww))
+ cumneww <- cumsum(neww)
+ mid <- 0
+ for(i in 1:length(neww)){
+ iter <- 0
+ ## do binary search
+ hi <- test(1)
+ lo <- mid
+ if(hi < cumneww[i]){
+ newv[i] <- hi
+ next
+ }
+ if(test(lo) > cumneww[i]){
+ newv[i] <- lo
+ next
+ }
+ mid <- (lo+hi)/2
+ iter <- 0
+ while(abs(test(mid)-cumneww[i])>eps){
+ if(test(mid)>cumneww[i]){
+ hi <- mid
+ }else{
+ lo <- mid
+ }
+ mid <- (lo+hi)/2
+ }
+ newv[i] <- mid
+ }
+ return(newv)
+}
+
adjust_scenario <- function(scenario, epsilon){
1-(1-scenario)^(1/(1+epsilon))
}
|