Функция aproxfun из пакета binsmooth, найти значение x из значения y

Question

Я создал функцию approxfun из пакета Binsmooth для поиска средств по двоичным данным.

binedges <- c(10000,15000,20000,25000,30000,35000,40000,45000,
              50000,60000,75000,100000,125000,150000,200000,NA)
bincounts <- c(157532,97369,102673,100888,90835,94191,87688,90481,
               79816,153581,195430,240948,155139,9452,92166,103217)
splb <- splinebins(binedges, bincounts, 76091)

, набрав splb$splineCDF(x) вернет y, но я хочу найти среднее значение.

Я понимаю, что эта функция предназначена для достижения этой цели, но она не работает для функций, созданных с помощью пакета Binsmooth.

получить значение x по заданному значению y: общий корень для функции линейной / нелинейной интерполяции

Я собрал простой способ, который найдет приблизительное значение, но он не очень удовлетворителен и очень требователен к компьютеру:

splb$splineCDF(50000)

fn(1000)

probability<- 0
income<- 0
while(probability< 0.5){
  probability<- splb$splineCDF(income)
  income<- income+ 10
}

Есть идеи?

Answer 1

Сначала я бы попробовал использовать числовой оптимизатор, чтобы найти медиану для меня, посмотреть, работает ли она достаточно хорошо. Проверить в этом случае легко, проверив, насколько близко splb$splineCDF к .5. Вы можете добавить тест, например если abs(splb$splineCDF(solution) - .5) > .001, тогда остановите скрипт и отладьте.

В решении используется optimize из пакета stats base R

# manual step version
manual_version <- function(splb){
  probability<- 0
  income<- 0
  while(probability< 0.5){
    probability<- splb$splineCDF(income)
    income<- income+ 10
  }
  return(income)
}

# try using a one dimensional optimiser - see ?optimize
optim_version <- function(splb, plot=TRUE){
  # requires a continuous function to optimise, with the minimum at the median
  objfun <- function(x){
    (.5-splb$splineCDF(x))^2
  }

  # visualise the objective function
  if(plot==TRUE){
    x_range <- seq(min(binedges, na.rm=T), max(binedges, na.rm=T), length.out = 100)
    z <- objfun(x_range)
    plot(x_range, z, type="l", main="objective function to minimise")
  }

  # one dimensional optimisation to get point closest to .5 cdf
  out <- optimize(f=objfun, interval = range(binedges, na.rm=TRUE))

  return(out$minimum)
}

# test them out
v1 <- manual_version(splb)
v2 <- optim_version(splb, plot=TRUE)
splb$splineCDF(v1)
splb$splineCDF(v2)

# time them
library(microbenchmark)
microbenchmark("manual"={
  manual_version(splb)
}, "optim"={
  optim_version(splb, plot=FALSE)
}, times=50)