[Distr-commits] r952 - in branches/distr-2.6/pkg/distrEx: R inst src

[noreply at r-forge.r-project.org]

Author: ruckdeschel
Date: 2014-08-10 16:10:08 +0200 (Sun, 10 Aug 2014)
New Revision: 952

Modified:
   branches/distr-2.6/pkg/distrEx/R/distrExIntegrate.R
   branches/distr-2.6/pkg/distrEx/R/moved2RobExtremes.R
   branches/distr-2.6/pkg/distrEx/inst/NEWS
   branches/distr-2.6/pkg/distrEx/inst/TOBEDONE
   branches/distr-2.6/pkg/distrEx/src/GLaw.c
Log:
[distrEx]:
+ use particular S3-class "moved2RobExtremeClass" for
  former package internal constants EULERMASCHERONICONSTANT and
  APERYCONSTANT
+ stubs prepared for usage of .Call-Interface in files GLaw.c and distrExIntegrate.R

Modified: branches/distr-2.6/pkg/distrEx/R/distrExIntegrate.R
===================================================================
--- branches/distr-2.6/pkg/distrEx/R/distrExIntegrate.R	2014-08-10 13:02:30 UTC (rev 951)
+++ branches/distr-2.6/pkg/distrEx/R/distrExIntegrate.R	2014-08-10 14:10:08 UTC (rev 952)
@@ -44,6 +44,12 @@
              A = as.double(A),W = as.double(W), PACKAGE = "distrEx") 
               ### PACKAGE ARGUMENT added P.R. 270507
 #    dyn.unload("G:/rtest/GLaw.dll")
+#
+# P.R. 20140810: .Call interface instead of .C interface
+#
+#   erg0 <- .Call("Gauleg", n, eps, PACKAGE="distrEx")
+#   erg <- matrix(erg0,n,2); colnames(erg) <- c("A","W")
+#
     cbind(A=erg$A, W=erg$W)         
 }
 

Modified: branches/distr-2.6/pkg/distrEx/R/moved2RobExtremes.R
===================================================================
--- branches/distr-2.6/pkg/distrEx/R/moved2RobExtremes.R	2014-08-10 13:02:30 UTC (rev 951)
+++ branches/distr-2.6/pkg/distrEx/R/moved2RobExtremes.R	2014-08-10 14:10:08 UTC (rev 952)
@@ -1,13 +1,18 @@
 ################ commands that have moved to RobExtremes
 
-.mv2RobExtremes <- function(){
-  cat("\n\n This functionality has moved to package RobExtremes.\n\n")
+.mv2RobExtremes <- function(what){
+  cat("\n\n", what, gettext(" has moved to package RobExtremes."),
+      "\n\n")
 }
 
-kMAD <- function(x,k) .mv2RobExtremes()
-Pareto <- function(shape, Min) .mv2RobExtremes()
-Pareto <- function(shape, Min) .mv2RobExtremes()
-GPareto <- function(loc, scale, shape, location) .mv2RobExtremes()
-GEV <- function(loc, scale, shape, location) .mv2RobExtremes()
-EULERMASCHERONICONSTANT  <- .mv2RobExtremes()
-APERYCONSTANT <- .mv2RobExtremes()
\ No newline at end of file
+kMAD <- function(x,k) .mv2RobExtremes("kMAD")
+Pareto <- function(shape, Min) .mv2RobExtremes("Pareto")
+GPareto <- function(loc, scale, shape, location) .mv2RobExtremes("GPareto")
+GEV <- function(loc, scale, shape, location) .mv2RobExtremes("GEV")
+
+EULERMASCHERONICONSTANT <- list(NULL)
+class(EULERMASCHERONICONSTANT) <- "moved2RobExtremeClass"
+APERYCONSTANT <- list(NULL)
+class(APERYCONSTANT) <- "moved2RobExtremeClass"
+print.moved2RobExtremeClass <- function(x,...)
+   .mv2RobExtremes("Constants 'EULERMASCHERONICONSTANT' and 'APERYCONSTANT'")

Modified: branches/distr-2.6/pkg/distrEx/inst/NEWS
===================================================================
--- branches/distr-2.6/pkg/distrEx/inst/NEWS	2014-08-10 13:02:30 UTC (rev 951)
+++ branches/distr-2.6/pkg/distrEx/inst/NEWS	2014-08-10 14:10:08 UTC (rev 952)
@@ -12,9 +12,9 @@
 ##############
 
 under the hood:
-+ used delayedAssign() for assignment of .mv2RobExtremes() to 
++ use particular S3-class "moved2RobExtremeClass" for
   former package internal constants EULERMASCHERONICONSTANT and
-  APERYCONSTANT)
+  APERYCONSTANT
 
  
 ##############

Modified: branches/distr-2.6/pkg/distrEx/inst/TOBEDONE
===================================================================
--- branches/distr-2.6/pkg/distrEx/inst/TOBEDONE	2014-08-10 13:02:30 UTC (rev 951)
+++ branches/distr-2.6/pkg/distrEx/inst/TOBEDONE	2014-08-10 14:10:08 UTC (rev 952)
@@ -2,4 +2,6 @@
 to be done in package distrEx
 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
-+ control class for controlling the accuracy / methods for integration
\ No newline at end of file
++ control class for controlling the accuracy / methods for integration
++ re-do the C-code in folder src using the Call interface
+  (stubs prepared already in files GLaw.c and distrExIntegrate.R)
\ No newline at end of file

Modified: branches/distr-2.6/pkg/distrEx/src/GLaw.c
===================================================================
--- branches/distr-2.6/pkg/distrEx/src/GLaw.c	2014-08-10 13:02:30 UTC (rev 951)
+++ branches/distr-2.6/pkg/distrEx/src/GLaw.c	2014-08-10 14:10:08 UTC (rev 952)
@@ -1,5 +1,8 @@
 #include <math.h>
 #define PI 3.141592653589793
+#include <R.h>
+#include <Rinternals.h>
+#include <Rmath.h>		/* constants */
 
 void gauleg(int *n, double *eps, double *A, double *W)
 { int i,j, m=((*n)+1)/2; double z1,z,pp,p1,p2,p3;
@@ -22,3 +25,25 @@
         W[(*n)-i]=W[i-1];
     }
 }
+
+/* P.R. 20140810: Yet to be tested: preparation for .Call - interface
+
+SEXP Gauleg(SEXP nFromR, SEXP epsFromR)
+{
+    int i, nx = asInteger(nFromR);
+    double epsx = asReal(epsFromR);
+    SEXP A = allocVector(REALSXP, nx);
+    SEXP W = allocVector(REALSXP, nx);
+    SEXP AW = PROTECT(allocVector(REALSXP, 2*nx));
+    gauleg(nx,epsx,REAL(A),REAL(W))
+	for(i=1;i<=n;i++){
+	    AW[i-1] <- A[i-1]
+	}	
+    for(i=1;i<=n;i++){
+	    AW[n+i-1] <- W[i-1]
+	}	
+	UNPROTECT(1)
+	return AW;
+}
+
+*/
\ No newline at end of file