Question

问题很简单。我有协变量x和一些结局y，我想根据y找到x的Nadarya-Watson估计。但是，我想找到一个满足以下条件的函数：

除了估计它还会返回权重
它不仅处理提供估计的均匀分布点。
速度相当快。

我可以自己实现。我天真的估算函数看起来像这样：

mNW <- function(x, X, Y, h, K = dnorm) {

  # Arguments
  # x: evaluation points
  # X: covariates
  # Y: outcome
  # h: bandwidth
  # K: kernel

  Kx <- sapply(X, function(Xi) K((x - Xi) / h))

  # Weights
  W <- Kx / rowSums(Kx) 

  # NW estimate
  m <- W %*% Y

  return(list(m = m, W = W))
}

set.seed(123)
X <- rnorm(1000)
Y <- 1 + X - 2*X^2 + rnorm(1000)
x <- c(-3, -2.1, -0.7, 0, 0.3, 0.8, 1, 1.9, 3.2)

mNW(x, X, Y, h = 0.5)

它工作正常，但速度较慢。所以我试图找到已经实现的东西。首选是kernsmooth：

ksmooth(X, Y, kernel = "normal", bandwidth = 0.5, x.points = x)

这个更快，但是不返回权重。此外，它仅使用"box"和"normal"内核。

我还尝试了locpoly包中的KernSmooth：

locpoly(X, Y, drv = 0, kernel = "normal", bandwidth = 0.5, 
        gridsize = 9, range.x = c(-3, 3.2))

除了不返回权重之外，我无法为自己的x规范运行函数，并且必须使用在某些指定范围内的等距值。

所以我想知道这些函数中是否缺少某些内容，或者R中是否存在针对NW估计的另一种解决方案。

Answer 1

我在Rcpp中编码了您的示例，它比R函数要快得多，但比ksmooth要慢。无论如何，它将返回您想要的2个元素。我不能让内核作为输入，因为在Rcpp中很难像在R中那样进行操作，但是您可以根据所使用的内核在Rcpp代码中编写简单的if else要使用（[这里] [1]是R中可用分布的列表）。

以下是应保存在.cpp文件中并与R一起保存到Rcpp::sourceCpp()中的C ++代码

#include <RcppArmadillo.h>
using namespace Rcpp;
using namespace arma;

// [[Rcpp::depends(RcppArmadillo)]]

// [[Rcpp::export]]
std::vector<arma::mat>  mNWCpp(Rcpp::NumericVector x, Rcpp::NumericVector X,Rcpp::NumericMatrix Y,
           double h){

  int number_loop = X.size();
  int number_x    = x.size();

  Rcpp::NumericMatrix Kx(number_x,number_loop);

  for(int i =0; i<number_loop;++i){
    Kx(_,i) = dnorm((x-X[i])/h);
  }

  Rcpp::NumericVector row_sums = rowSums(Kx);
  Rcpp::NumericMatrix W = Kx*0;
  for(int i =0; i<number_loop;++i){
    W(_,i) = Kx(_,i)/row_sums;
  }


  arma::mat weights = Rcpp::as<arma::mat>(W);
  arma::mat Ymat = Rcpp::as<arma::mat>(Y);

  arma::mat m = weights * Ymat;

  std::vector< arma::mat> res(2);
  res[0] = weights;
  res[1] = m;
  return res;
}

我使用软件包microbenchmark来比较这三个函数，结果如下：

Unit: microseconds
 expr    min      lq     mean median      uq    max neval
    R 1991.9 2040.25 2117.656 2070.9 2123.50 3492.5   100
 Rcpp  490.5  502.10  512.318  510.8  517.35  598.0   100
   KS  196.8  205.40  215.598  211.4  219.15  282.2   100

Answer 2

这可以使用locpol软件包来完成，该软件包比用C ++手工实现要快得多：

library(locpol)
# weights
W <- locCteWeightsC(x = X, xeval = x, kernel = gaussK, bw = 0.5)$locWeig
# kernel estimate
m <- locWeightsEval(lpweig = W, y = Y)

在R中寻找理想的内核NW估计

2 个答案: