R 函数和 Rcpp 中的环境答案

【问题标题】：Environments in R functions and RcppR 函数和 Rcpp 中的环境
【发布时间】：2015-09-17 22:56:29
【问题描述】：

我遇到了一个奇怪的问题，我编写的函数在运行后会更改输入的值。

这是我的 R 代码：

library(entropy)
y = c(4, 2, 3, 0, 2, 4, 0, 0, 2, 1, 1)
y=rbind(y,2*(y%%2),y%%3)
y
#4    2    3    0    2    4    0    0    2     1     1
#0    0    2    0    0    0    0    0    0     2     2
#1    2    0    0    2    1    0    0    2     1     1
freqs.shrink(y)

freqs.shrinkC<-function(y,lambda.freqs,verbose=TRUE) {
  if (missing(lambda.freqs)) {
    lambda.freqs = getlambdashrinkC(y)
  }
  if (verbose==TRUE) {
    cat(paste("Specified shrinkage intensity lambda.freq (frequencies):",
              round(lambda.freqs, 4)), "\n")
  }
  ismatrix<-attributes(y)$dim
  out<-freqsshrinkC(y,lambda.freqs)
  attr(out,"lambda.freq")=lambda.freqs
  attr(out,"dim")=ismatrix
  return(out)
}

freqs.shrinkC(y)
y
    #0.05280131 0.0374932 0.04514725 0.0221851 0.0374932 0.05280131 0.0221851 0.0221851 0.0374932 0.02983915 0.02983915
  #0.02218510 0.0221851 0.03749320 0.0221851 0.0221851 0.02218510 0.0221851 0.0221851 0.0221851 0.03749320 0.03749320
  #0.02983915 0.0374932 0.02218510 0.0221851 0.0374932 0.02983915 0.0221851 0.0221851 0.0374932 0.02983915 0.02983915

运行 freqs.shrinkC 后没有理由改变 y 的值，因为我相信该函数在其自己的环境中运行。

这是我的 C++ 代码：

#include <Rcpp.h>
using namespace Rcpp;

// [[Rcpp::export]]
NumericVector freqsshrinkC(NumericVector y,double lambda) {
  int m=y.length();
  double n=0;
  for (int i=0;i<m;i++) {
    n+=y(i);
  }
  y=y/n;

NumericVector add(m,lambda/m);
   y=y*(1-lambda);

  y+=add;
  return y;
}

// [[Rcpp::export]]
double getlambdashrinkC(NumericVector y) {
  double n=0;
  int m=y.length();
  double lambda;
  for (int i=0;i<m;i++) {
    n+=y[i];
  }
  NumericVector u=y/n;


  NumericVector temp(m,1.0);
  NumericVector varu=u*(temp-u)/(n-1);

  double msp=0;
  for (int i=0;i<m;i++) {
    msp+=pow(u[i]-(1.0/m),2);
  }
  if (msp==0) {
    lambda=1;
  } else {
    lambda=0;
    for (int i=0;i<m;i++) {
    lambda+=varu[i];
    }
    lambda=lambda/msp;
  }
  if (lambda>1) {
    lambda=1;
  }
  if (lambda<0) {
    lambda=0;
  }
  return lambda;
}

我是 C++ 和 Rcpp 的新手，所以如果我的代码不优雅，我深表歉意。如果有人好奇，我正在使用 Rcpp 作为练习重写熵包。我很难理解为什么 y 在我运行我的函数时会改变值，因此感谢您的帮助。

问候，

卡尔

【问题讨论】：

标签： c++ r rcpp entropy

【解决方案1】：

这很可能与您的freqsshrinkC 函数直接对其y 参数进行（修改）操作有关。由于Rcpp::Vectors 是代理对象，这会影响您传入的原始对象。尝试使用Rcpp::clone 对您传入的向量进行深层复制，如下所示：

// [[Rcpp::export]]
NumericVector freqsshrinkC2(NumericVector y_, double lambda) {
  Rcpp::NumericVector y = Rcpp::clone(y_);
  int m = y.length();
  double n = 0;
  for (int i = 0; i < m; i++) {
    n += y(i);
  }
  y = y/n;

  NumericVector add(m,lambda/m);
  y = y*(1-lambda);

  y += add;
  return y;
}

/*** R

y1 <- c(4, 2, 3, 0, 2, 4, 0, 0, 2, 1, 1)
y1 <- rbind(y1, 2*(y1%%2), y1%%3)
x1 <- freqsshrinkC(y1, 1.5)

y2 <- c(4, 2, 3, 0, 2, 4, 0, 0, 2, 1, 1)
y2 <- rbind(y2, 2*(y2%%2), y2%%3)
x2 <- freqsshrinkC2(y2, 1.5)


all.equal(y1, x1)
R> all.equal(y1, x1)
#[1] TRUE       # y1 was modified

all.equal(y2, x2)
R> all.equal(y2, x2)
#[1] "Mean relative difference: 1.01039"  # y2 was not

*/

freqsshrinkC 是您问题中的版本，freqsshrinkC2 在（现在重命名为y_）输入向量上使用Rcpp::clone。

【讨论】：