2

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

($Rgennloc) と呼ばれる最初の R スクリプトは、前のループの 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]))

2 番目のスクリプトが呼び出されると、最初の約 20 回の呼び出し (n が約 1000 になり、xaxis が 20 になる) の間は高速に実行されますが、その後速度が低下し始めます。

2 番目のスクリプト:

#!/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 秒かかり、そこからさらに悪化します。

これを最適化する最良の方法は何ですか? 現時点では1コアしか使用していないと思います。2 つ利用できますが、2 つ目のコアが長期的にどの程度の違いを生むかはわかりません。

Rの最新バージョンを使用しています。

4

1 に答える 1