Question

我试图使用由PHP循环执行的R脚本来绘制二项式曲线。这些脚本需要很长时间才能运行，我希望改进算法以便更快地运行。

输入值为：

$xmax = 360;
$p = 0.975;
$prvn = 1;
$b = 1.7;
$c = 0.995;

为每个循环调用的PHP函数是：

function cg_graphs_get_binomial($xmax, $p, $prvn = 1, $b = 1.7, $c = 0.99){

  $Alert = array();
  /*run the Rscript file located in the module root*/
  $Rgennloc = "/home/rcstest/www/".drupal_get_path('module', 'cg_graphs')."/Rbinomgenn.R"; //Rscript file location
  $Rbinomloc = "/home/rcstest/www/".drupal_get_path('module', 'cg_graphs')."/Rbinomnew.R"; //Rscript file location

  for($i = 0; $i <= $xmax; $i++){
    exec("Rscript --slave ".$Rgennloc." ".$prvn." ".$i." ".$b, $n);
    $ne = explode('[1]', $n[$i]);
    $prvn = $ne[1];
    exec("Rscript --slave ".$Rbinomloc." ".$prvn." ".$p." ".$c, $alert);
    $at = explode('[1]', $alert[$i]);
    $Alert[] = trim($at[1]);
  }

  return $Alert; //return the data array

第一个调用的R脚本（$ Rgennloc）根据前一个循环的n值生成n值，如果是第一个循环，则生成1。增量如下（等）：

1 6 16 32 53 80

第一个r脚本看起来像这样并在相对较短的时间内运行：

#!/usr/bin/Rscript
#grab args as passed into via CLI
args <- commandArgs(trailingOnly = TRUE)

#R script to generate n value

#implimentation of excel ROUNDDOWN function
ROUNDDOWN <- function(.number, .num_digits){
    return(as.integer(.number*10^.num_digits)/(10^.num_digits))
}

#generate n
n <- function(.prvn, .xaxis, .B){
    return(.prvn + ROUNDDOWN(.xaxis * exp(1)^.B, 0))
}

#wrapper function
n(as.integer(args[1]), as.integer(args[2]), as.double(args[3]))

当调用第二个脚本时，它会快速运行前20个调用（其中n到1000左右，x轴为20），但随后开始变慢。

第二个脚本：

#!/usr/bin/Rscript
# replace '/usr/bin' with actual R executable 
args <- commandArgs(trailingOnly = TRUE)

#Critbinom - R implimentation of the excel function
CRITBINOM <- function(.trials, .probability_s, .alpha){
    i <- 0
    while(sum(dbinom(0:i, .trials, .probability_s)) < .alpha){
        i <- i + 1
    }
    return(i)
}

# Binomdist - R implimentation of the excel function
BINOMDIST <- function(.number_s, .trials, .probability_s, .cumulative){
    if(.cumulative){
        return(sum(dbinom(0:.number_s, .trials, .probability_s)))
    }else{
        return(choose(.trials,.number_s)*.probability_s^.number_s*(1-.probability_s)^(.trials-.number_s))
    }
}

# Iserror - R version of this, no need for all excel functionality.
ISERROR <- function(.value){
    return(is.infinite(.value))
}

# Generate the alert
generate_Alert <- function(.n, .probability_s, .alpha){
    critB <- CRITBINOM(.n, .probability_s, .alpha)
    adj <- critB-(BINOMDIST(critB, .n, .probability_s,TRUE)-.alpha)/(BINOMDIST(critB, .n, .probability_s,TRUE)-BINOMDIST(critB-1, .n, .probability_s,TRUE))
    if(ISERROR(100 * adj / .n)){
        return(0)
    }else{
        adj_value <- (adj / .n)
        return(adj_value)
    }
}

# Generate the alert for current xaxis position
generate_data <- function(.n, .probability_s, .alpha){
    Alert <- generate_Alert(.n, .probability_s, .alpha)
    return(Alert)
}

# Call wrapper function generate_data(n, p, alpha)
generate_data(as.integer(args[1]), as.double(args[2]), as.double(args[3]))

xaxis值可能高达360，但脚本在xaxis达到30之前开始减速。到xaxis为100时，完成每个循环需要大约30秒，从那里开始变得更糟。 / p>

优化此功能的最佳方法是什么？我认为目前它只使用1个核心。我有2个可用，但我不确定第二个核心在长期内会有多大差异。

我使用的是最新版本的R。

Answer 1

稍微扩展我的评论，所以这个问题得到答案：

R中的while循环是一个非常不常见的构造（我在严肃的代码中每年只看到一次或两次）。这通常表明代码不遵循R的精神，而是由具有其他语言经验的人（例如，来自C家族）编写。在R中，while循环在性能方面非常昂贵，如果确实需要，应该用C语言写得更好。

幸运的是，CRITBINOM函数只是qbinom（二项分布的分位数函数）的天真重新实现，可以替代使用。唯一的区别在于如何处理多个成功概率（qbinom完全矢量化）。

我相信R中的完全重新实现（避免显式循环）可以将其降低到几秒或更短，但我不知道PHP。

优化R脚本执行二项式计算

1 个答案: