[Rcpp-commits] r4117 - in pkg/Rcpp: . inst/include/Rcpp src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Dec 9 16:09:14 CET 2012
Author: romain
Date: 2012-12-09 16:09:14 +0100 (Sun, 09 Dec 2012)
New Revision: 4117
Removed:
pkg/Rcpp/src/random.cpp
Modified:
pkg/Rcpp/ChangeLog
pkg/Rcpp/inst/include/Rcpp/exceptions.h
pkg/Rcpp/src/api.cpp
pkg/Rcpp/src/exceptions.cpp
Log:
drop forward_uncaught_exceptions_to_r
Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog 2012-12-09 14:52:30 UTC (rev 4116)
+++ pkg/Rcpp/ChangeLog 2012-12-09 15:09:14 UTC (rev 4117)
@@ -2,6 +2,8 @@
* src/api.cpp: merge many .cpp files here to reduce compile time
* src/barrier.cpp: merge with cache.cpp to reduce compile time
+ * include/Rcpp/exceptions.h: drop forward_uncaught_exceptions_to_r
+ * src/exceptions.cpp: drop forward_uncaught_exceptions_to_r
2012-12-08 Romain Francois <romain at r-enthusiasts.com>
Modified: pkg/Rcpp/inst/include/Rcpp/exceptions.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/exceptions.h 2012-12-09 14:52:30 UTC (rev 4116)
+++ pkg/Rcpp/inst/include/Rcpp/exceptions.h 2012-12-09 15:09:14 UTC (rev 4117)
@@ -127,7 +127,6 @@
} // namesapce Rcpp
-void forward_uncaught_exceptions_to_r() ;
void forward_exception_to_r( const std::exception& ) ;
SEXP exception_to_try_error( const std::exception& ) ;
SEXP string_to_try_error( const std::string& ) ;
Modified: pkg/Rcpp/src/api.cpp
===================================================================
--- pkg/Rcpp/src/api.cpp 2012-12-09 14:52:30 UTC (rev 4116)
+++ pkg/Rcpp/src/api.cpp 2012-12-09 15:09:14 UTC (rev 4117)
@@ -1093,3 +1093,417 @@
}
// }}}
+// {{{ random number generators
+// these files are no longer part of Rcpp.h since they are only needed here
+#include <Rcpp/stats/random/rnorm.h>
+#include <Rcpp/stats/random/runif.h>
+#include <Rcpp/stats/random/rgamma.h>
+#include <Rcpp/stats/random/rbeta.h>
+#include <Rcpp/stats/random/rlnorm.h>
+#include <Rcpp/stats/random/rchisq.h>
+#include <Rcpp/stats/random/rnchisq.h>
+#include <Rcpp/stats/random/rf.h>
+#include <Rcpp/stats/random/rt.h>
+#include <Rcpp/stats/random/rbinom.h>
+#include <Rcpp/stats/random/rcauchy.h>
+#include <Rcpp/stats/random/rexp.h>
+#include <Rcpp/stats/random/rgeom.h>
+#include <Rcpp/stats/random/rnbinom.h>
+#include <Rcpp/stats/random/rnbinom_mu.h>
+#include <Rcpp/stats/random/rpois.h>
+#include <Rcpp/stats/random/rweibull.h>
+#include <Rcpp/stats/random/rlogis.h>
+#include <Rcpp/stats/random/rwilcox.h>
+#include <Rcpp/stats/random/rsignrank.h>
+#include <Rcpp/stats/random/rhyper.h>
+
+namespace Rcpp{
+ namespace internal{
+ namespace {
+ int RNGScopeCounter = 0;
+ }
+
+ void enterRNGScope() {
+ if (RNGScopeCounter == 0)
+ GetRNGstate();
+ RNGScopeCounter++;
+ }
+
+ void exitRNGScope() {
+ RNGScopeCounter--;
+ if (RNGScopeCounter == 0)
+ PutRNGstate();
+ }
+ } // internal
+
+
+ NumericVector rnorm( int n, double mean, double sd){
+ if (ISNAN(mean) || !R_FINITE(sd) || sd < 0.){
+ // TODO: R also throws a warning in that case, should we ?
+ return NumericVector( n, R_NaN ) ;
+ } else if (sd == 0. || !R_FINITE(mean)){
+ return NumericVector( n, mean ) ;
+ } else {
+ bool sd1 = sd == 1.0 ;
+ bool mean0 = mean == 0.0 ;
+ if( sd1 && mean0 ){
+ return NumericVector( n, stats::NormGenerator__mean0__sd1() ) ;
+ } else if( sd1 ){
+ return NumericVector( n, stats::NormGenerator__sd1( mean ) );
+ } else if( mean0 ){
+ return NumericVector( n, stats::NormGenerator__mean0( sd ) );
+ } else {
+ // general case
+ return NumericVector( n, stats::NormGenerator( mean, sd ) );
+ }
+ }
+ }
+
+
+
+
+ NumericVector rnorm( int n, double mean /*, double sd [=1.0] */ ){
+ if (ISNAN(mean) ){
+ // TODO: R also throws a warning in that case, should we ?
+ return NumericVector( n, R_NaN ) ;
+ } else if ( !R_FINITE(mean)){
+ return NumericVector( n, mean ) ;
+ } else {
+ bool mean0 = mean == 0.0 ;
+ if( mean0 ){
+ return NumericVector( n, stats::NormGenerator__mean0__sd1() ) ;
+ } else {
+ return NumericVector( n, stats::NormGenerator__sd1( mean ) );
+ }
+ }
+ }
+
+
+
+
+ NumericVector rnorm( int n /*, double mean [=0.0], double sd [=1.0] */ ){
+ return NumericVector( n, stats::NormGenerator() ) ;
+ }
+
+
+
+
+ NumericVector rbeta( int n, double a, double b ){
+ return NumericVector( n, stats::BetaGenerator(a, b ) ) ;
+ }
+
+
+
+
+ NumericVector rbinom( int n, double nin, double pp ){
+ return NumericVector( n, stats::BinomGenerator(nin, pp) ) ;
+ }
+
+
+
+
+ NumericVector rcauchy( int n, double location, double scale ){
+ if (ISNAN(location) || !R_FINITE(scale) || scale < 0)
+ return NumericVector( n, R_NaN ) ;
+
+ if (scale == 0. || !R_FINITE(location))
+ return NumericVector( n, location ) ;
+
+ return NumericVector( n, stats::CauchyGenerator( location, scale ) ) ;
+ }
+
+
+
+
+ NumericVector rcauchy( int n, double location /* , double scale [=1.0] */ ){
+ if (ISNAN(location))
+ return NumericVector( n, R_NaN ) ;
+
+ if (!R_FINITE(location))
+ return NumericVector( n, location ) ;
+
+ return NumericVector( n, stats::CauchyGenerator_1( location ) ) ;
+ }
+
+
+
+
+ NumericVector rcauchy( int n /*, double location [=0.0] , double scale [=1.0] */ ){
+ return NumericVector( n, stats::CauchyGenerator_0() ) ;
+ }
+
+
+
+
+ NumericVector rchisq( int n, double df ){
+ if (!R_FINITE(df) || df < 0.0) return NumericVector(n, R_NaN) ;
+ return NumericVector( n, stats::ChisqGenerator( df ) ) ;
+ }
+
+
+
+
+ NumericVector rexp( int n, double rate ){
+ double scale = 1.0 / rate ;
+ if (!R_FINITE(scale) || scale <= 0.0) {
+ if(scale == 0.) return NumericVector( n, 0.0 ) ;
+ /* else */
+ return NumericVector( n, R_NaN ) ;
+ }
+ return NumericVector( n, stats::ExpGenerator( scale ) ) ;
+ }
+ NumericVector rexp( int n /* , rate = 1 */ ){
+ return NumericVector( n, stats::ExpGenerator__rate1() ) ;
+ }
+
+
+
+
+
+ NumericVector rf( int n, double n1, double n2 ){
+ if (ISNAN(n1) || ISNAN(n2) || n1 <= 0. || n2 <= 0.)
+ return NumericVector( n, R_NaN ) ;
+ if( R_FINITE( n1 ) && R_FINITE( n2 ) ){
+ return NumericVector( n, stats::FGenerator_Finite_Finite( n1, n2 ) ) ;
+ } else if( ! R_FINITE( n1 ) && ! R_FINITE( n2 ) ){
+ return NumericVector( n, 1.0 ) ;
+ } else if( ! R_FINITE( n1 ) ) {
+ return NumericVector( n, stats::FGenerator_NotFinite_Finite( n2 ) ) ;
+ } else {
+ return NumericVector( n, stats::FGenerator_Finite_NotFinite( n1 ) ) ;
+ }
+ }
+
+
+
+
+
+ NumericVector rgamma( int n, double a, double scale ){
+ if (!R_FINITE(a) || !R_FINITE(scale) || a < 0.0 || scale <= 0.0) {
+ if(scale == 0.) return NumericVector( n, 0.) ;
+ return NumericVector( n, R_NaN ) ;
+ }
+ if( a == 0. ) return NumericVector(n, 0. ) ;
+ return NumericVector( n, stats::GammaGenerator(a, scale) ) ;
+ }
+ NumericVector rgamma( int n, double a /* scale = 1.0 */ ){
+ if (!R_FINITE(a) || a < 0.0 ) {
+ return NumericVector( n, R_NaN ) ;
+ }
+ if( a == 0. ) return NumericVector(n, 0. ) ;
+ /* TODO: check if we can take advantage of the scale = 1 special case */
+ return NumericVector( n, stats::GammaGenerator(a, 1.0) ) ;
+ }
+
+
+
+
+ NumericVector rgeom( int n, double p ){
+ if (!R_FINITE(p) || p <= 0 || p > 1)
+ return NumericVector( n, R_NaN );
+ return NumericVector( n, stats::GeomGenerator( p ) ) ;
+ }
+
+
+
+
+ NumericVector rhyper( int n, double nn1, double nn2, double kk ){
+ return NumericVector( n, stats::HyperGenerator( nn1, nn2, kk ) ) ;
+ }
+
+
+
+
+ NumericVector rlnorm( int n, double meanlog, double sdlog ){
+ if (ISNAN(meanlog) || !R_FINITE(sdlog) || sdlog < 0.){
+ // TODO: R also throws a warning in that case, should we ?
+ return NumericVector( n, R_NaN ) ;
+ } else if (sdlog == 0. || !R_FINITE(meanlog)){
+ return NumericVector( n, ::exp( meanlog ) ) ;
+ } else {
+ return NumericVector( n, stats::LNormGenerator( meanlog, sdlog ) );
+ }
+ }
+
+
+
+
+ NumericVector rlnorm( int n, double meanlog /*, double sdlog = 1.0 */){
+ if (ISNAN(meanlog) ){
+ // TODO: R also throws a warning in that case, should we ?
+ return NumericVector( n, R_NaN ) ;
+ } else if ( !R_FINITE(meanlog)){
+ return NumericVector( n, ::exp( meanlog ) ) ;
+ } else {
+ return NumericVector( n, stats::LNormGenerator_1( meanlog ) );
+ }
+ }
+
+
+
+
+ NumericVector rlnorm( int n /*, double meanlog [=0.], double sdlog = 1.0 */){
+ return NumericVector( n, stats::LNormGenerator_0( ) );
+ }
+
+
+
+
+ NumericVector rlogis( int n, double location, double scale ){
+ if (ISNAN(location) || !R_FINITE(scale))
+ return NumericVector( n, R_NaN ) ;
+
+ if (scale == 0. || !R_FINITE(location))
+ return NumericVector( n, location );
+
+ return NumericVector( n, stats::LogisGenerator( location, scale ) ) ;
+ }
+
+
+
+
+ NumericVector rlogis( int n, double location /*, double scale =1.0 */ ){
+ if (ISNAN(location) )
+ return NumericVector( n, R_NaN ) ;
+
+ if (!R_FINITE(location))
+ return NumericVector( n, location );
+
+ return NumericVector( n, stats::LogisGenerator_1( location ) ) ;
+ }
+
+
+
+
+ NumericVector rlogis( int n /*, double location [=0.0], double scale =1.0 */ ){
+ return NumericVector( n, stats::LogisGenerator_0() ) ;
+ }
+
+
+
+
+ NumericVector rnbinom( int n, double siz, double prob ){
+ if(!R_FINITE(siz) || !R_FINITE(prob) || siz <= 0 || prob <= 0 || prob > 1)
+ /* prob = 1 is ok, PR#1218 */
+ return NumericVector( n, R_NaN ) ;
+
+ return NumericVector( n, stats::NBinomGenerator( siz, prob ) ) ;
+ }
+
+
+
+
+ NumericVector rnbinom_mu( int n, double siz, double mu ){
+ if(!R_FINITE(siz) || !R_FINITE(mu) || siz <= 0 || mu < 0)
+ return NumericVector( n, R_NaN ) ;
+
+ return NumericVector( n, stats::NBinomGenerator_Mu( siz, mu ) ) ;
+ }
+
+
+
+
+ NumericVector rnchisq( int n, double df, double lambda ){
+ if (!R_FINITE(df) || !R_FINITE(lambda) || df < 0. || lambda < 0.)
+ return NumericVector(n, R_NaN) ;
+ if( lambda == 0.0 ){
+ // using the central generator, see rchisq.h
+ return NumericVector( n, stats::ChisqGenerator( df ) ) ;
+ }
+ return NumericVector( n, stats::NChisqGenerator( df, lambda ) ) ;
+ }
+
+
+
+
+ NumericVector rnchisq( int n, double df /*, double lambda = 0.0 */ ){
+ if (!R_FINITE(df) || df < 0. )
+ return NumericVector(n, R_NaN) ;
+ return NumericVector( n, stats::ChisqGenerator( df ) ) ;
+ }
+
+
+
+
+ NumericVector rpois( int n, double mu ){
+ return NumericVector( n, stats::PoissonGenerator(mu) ) ;
+ }
+
+
+
+
+
+ NumericVector rsignrank( int n, double nn ){
+ return NumericVector( n, stats::SignRankGenerator(nn) ) ;
+ }
+
+
+
+
+ NumericVector rt( int n, double df ){
+ // special case
+ if (ISNAN(df) || df <= 0.0)
+ return NumericVector( n, R_NaN ) ;
+
+ // just generating a N(0,1)
+ if(!R_FINITE(df))
+ return NumericVector( n, stats::NormGenerator__mean0__sd1() ) ;
+
+ // general case
+ return NumericVector( n, stats::TGenerator( df ) ) ;
+ }
+
+
+
+
+ NumericVector runif( int n, double min, double max ){
+ if (!R_FINITE(min) || !R_FINITE(max) || max < min) return NumericVector( n, R_NaN ) ;
+ if( min == max ) return NumericVector( n, min ) ;
+ return NumericVector( n, stats::UnifGenerator( min, max ) ) ;
+ }
+
+
+
+
+ NumericVector runif( int n, double min /*, double max = 1.0 */ ){
+ if (!R_FINITE(min) || 1.0 < min) return NumericVector( n, R_NaN ) ;
+ if( min == 1.0 ) return NumericVector( n, 1.0 ) ;
+ return NumericVector( n, stats::UnifGenerator( min, 1.0 ) ) ;
+ }
+
+
+
+
+ NumericVector runif( int n /*, double min = 0.0, double max = 1.0 */ ){
+ return NumericVector( n, stats::UnifGenerator__0__1() ) ;
+ }
+
+
+
+
+ NumericVector rweibull( int n, double shape, double scale ){
+ if (!R_FINITE(shape) || !R_FINITE(scale) || shape <= 0. || scale <= 0.) {
+ if(scale == 0.) return NumericVector(n, 0.);
+ /* else */
+ return NumericVector(n, R_NaN);
+ }
+ return NumericVector( n, stats::WeibullGenerator( shape, scale ) ) ;
+ }
+
+ NumericVector rweibull( int n, double shape /* scale = 1 */ ){
+ if (!R_FINITE(shape) || shape <= 0. ) {
+ return NumericVector(n, R_NaN);
+ }
+ return NumericVector( n, stats::WeibullGenerator__scale1( shape ) ) ;
+ }
+
+
+
+
+ NumericVector rwilcox( int n, double mm, double nn ){
+ return NumericVector( n, stats::WilcoxGenerator(mm, nn) ) ;
+ }
+
+// }}}
+
+
Modified: pkg/Rcpp/src/exceptions.cpp
===================================================================
--- pkg/Rcpp/src/exceptions.cpp 2012-12-09 14:52:30 UTC (rev 4116)
+++ pkg/Rcpp/src/exceptions.cpp 2012-12-09 15:09:14 UTC (rev 4117)
@@ -105,51 +105,6 @@
return real_class ;
}
-/* much inspired from the __verbose_terminate_handler of the GCC */
-void forward_uncaught_exceptions_to_r(){
-
- std::string exception_class ;
- bool has_exception_class = false;
- std::string exception_what ;
-
- // Make sure there was an exception; terminate is also called for an
- // attempt to rethrow when there is no suitable exception.
- std::type_info *t = abi::__cxa_current_exception_type();
- if (t){
- has_exception_class = true ;
- const char *name = t->name() ;
- // now we need to demangle "name"
-
- {
- int status = -1;
- char *dem = 0;
- dem = abi::__cxa_demangle(name, 0, 0, &status);
- if( status == 0){
- exception_class = dem ; /* great we can use the demangled name */
- free(dem);
- } else{
- exception_class = name ; /* just using the mangled name */
- }
- }
- }
-
- // If the exception is derived from std::exception, we can give more
- // information.
- try {
- __throw_exception_again;
- } catch (std::exception &exc) {
- exception_what = exc.what() ;
- } catch (...) {
- exception_what = "unrecognized exception" ;
- }
-
- SEXP cppExceptSym = Rf_install("cpp_exception"); // cannot cause a gc() once in symbol table
- SEXP cppExceptExpr = PROTECT(Rf_lang3(cppExceptSym,
- Rf_mkString(exception_what.c_str()),
- has_exception_class ? Rf_mkString(exception_class.c_str()) : R_NilValue));
- Rf_eval(cppExceptExpr, R_FindNamespace(Rf_mkString("Rcpp"))); // Should not return
- UNPROTECT(1); // in case someone replaces the definition of "cpp_exception" such that it does return
-}
void forward_exception_to_r( const std::exception& ex){
std::string exception_class ;
std::string exception_what = ex.what();
@@ -174,15 +129,6 @@
UNPROTECT(1); // in case someone replaces the definition of "cpp_exception" such that it does return
}
#else
-void forward_uncaught_exceptions_to_r(){
- SEXP cppExceptSym = Rf_install("cpp_exception"); // cannot cause a gc() once in symbol table
- SEXP cppExceptExpr = PROTECT(Rf_lang3(cppExceptSym,
- Rf_mkString("exception : we don't know how to get the exception"
- "message with your compiler, patches welcome"),
- R_NilValue));
- Rf_eval(cppExceptExpr, R_FindNamespace(Rf_mkString("Rcpp"))); // Should not return
- UNPROTECT(1); // in case someone replaces the definition of "cpp_exception" such that it does return
-}
void forward_exception_to_r( const std::exception& ex){
SEXP cppExceptSym = Rf_install("cpp_exception"); // cannot cause a gc() once in symbol table
SEXP cppExceptExpr = PROTECT(Rf_lang3(cppExceptSym, Rf_mkString(ex.what()), R_NilValue));
Deleted: pkg/Rcpp/src/random.cpp
===================================================================
--- pkg/Rcpp/src/random.cpp 2012-12-09 14:52:30 UTC (rev 4116)
+++ pkg/Rcpp/src/random.cpp 2012-12-09 15:09:14 UTC (rev 4117)
@@ -1,435 +0,0 @@
-// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
-//
-// random.cpp: R/C++ interface class library -- random generators
-//
-// Copyright (C) 2012 Dirk Eddelbuettel and Romain Francois
-//
-// This file is part of Rcpp.
-//
-// Rcpp is free software: you can redistribute it and/or modify it
-// under the terms of the GNU General Public License as published by
-// the Free Software Foundation, either version 2 of the License, or
-// (at your option) any later version.
-//
-// Rcpp is distributed in the hope that it will be useful, but
-// WITHOUT ANY WARRANTY; without even the implied warranty of
-// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-// GNU General Public License for more details.
-//
-// You should have received a copy of the GNU General Public License
-// along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
-
-// TODO: study what is really needed in Rcpp.h
-#include <Rcpp.h>
-
-// these files are no longer part of Rcpp.h since they are only needed here
-#include <Rcpp/stats/random/rnorm.h>
-#include <Rcpp/stats/random/runif.h>
-#include <Rcpp/stats/random/rgamma.h>
-#include <Rcpp/stats/random/rbeta.h>
-#include <Rcpp/stats/random/rlnorm.h>
-#include <Rcpp/stats/random/rchisq.h>
-#include <Rcpp/stats/random/rnchisq.h>
-#include <Rcpp/stats/random/rf.h>
-#include <Rcpp/stats/random/rt.h>
-#include <Rcpp/stats/random/rbinom.h>
-#include <Rcpp/stats/random/rcauchy.h>
-#include <Rcpp/stats/random/rexp.h>
-#include <Rcpp/stats/random/rgeom.h>
-#include <Rcpp/stats/random/rnbinom.h>
-#include <Rcpp/stats/random/rnbinom_mu.h>
-#include <Rcpp/stats/random/rpois.h>
-#include <Rcpp/stats/random/rweibull.h>
-#include <Rcpp/stats/random/rlogis.h>
-#include <Rcpp/stats/random/rwilcox.h>
-#include <Rcpp/stats/random/rsignrank.h>
-#include <Rcpp/stats/random/rhyper.h>
-
-namespace Rcpp{
- namespace internal{
- namespace {
- int RNGScopeCounter = 0;
- }
-
- void enterRNGScope() {
- if (RNGScopeCounter == 0)
- GetRNGstate();
- RNGScopeCounter++;
- }
-
- void exitRNGScope() {
- RNGScopeCounter--;
- if (RNGScopeCounter == 0)
- PutRNGstate();
- }
- } // internal
-
-
- NumericVector rnorm( int n, double mean, double sd){
- if (ISNAN(mean) || !R_FINITE(sd) || sd < 0.){
- // TODO: R also throws a warning in that case, should we ?
- return NumericVector( n, R_NaN ) ;
- } else if (sd == 0. || !R_FINITE(mean)){
- return NumericVector( n, mean ) ;
- } else {
- bool sd1 = sd == 1.0 ;
- bool mean0 = mean == 0.0 ;
- if( sd1 && mean0 ){
- return NumericVector( n, stats::NormGenerator__mean0__sd1() ) ;
- } else if( sd1 ){
- return NumericVector( n, stats::NormGenerator__sd1( mean ) );
- } else if( mean0 ){
- return NumericVector( n, stats::NormGenerator__mean0( sd ) );
- } else {
- // general case
- return NumericVector( n, stats::NormGenerator( mean, sd ) );
- }
- }
- }
-
-
-
-
- NumericVector rnorm( int n, double mean /*, double sd [=1.0] */ ){
- if (ISNAN(mean) ){
- // TODO: R also throws a warning in that case, should we ?
- return NumericVector( n, R_NaN ) ;
- } else if ( !R_FINITE(mean)){
- return NumericVector( n, mean ) ;
- } else {
- bool mean0 = mean == 0.0 ;
- if( mean0 ){
- return NumericVector( n, stats::NormGenerator__mean0__sd1() ) ;
- } else {
- return NumericVector( n, stats::NormGenerator__sd1( mean ) );
- }
- }
- }
-
-
-
-
- NumericVector rnorm( int n /*, double mean [=0.0], double sd [=1.0] */ ){
- return NumericVector( n, stats::NormGenerator() ) ;
- }
-
-
-
-
- NumericVector rbeta( int n, double a, double b ){
- return NumericVector( n, stats::BetaGenerator(a, b ) ) ;
- }
-
-
-
-
- NumericVector rbinom( int n, double nin, double pp ){
- return NumericVector( n, stats::BinomGenerator(nin, pp) ) ;
- }
-
-
-
-
- NumericVector rcauchy( int n, double location, double scale ){
- if (ISNAN(location) || !R_FINITE(scale) || scale < 0)
- return NumericVector( n, R_NaN ) ;
-
- if (scale == 0. || !R_FINITE(location))
- return NumericVector( n, location ) ;
-
- return NumericVector( n, stats::CauchyGenerator( location, scale ) ) ;
- }
-
-
-
-
- NumericVector rcauchy( int n, double location /* , double scale [=1.0] */ ){
- if (ISNAN(location))
- return NumericVector( n, R_NaN ) ;
-
- if (!R_FINITE(location))
- return NumericVector( n, location ) ;
-
- return NumericVector( n, stats::CauchyGenerator_1( location ) ) ;
- }
-
-
-
-
- NumericVector rcauchy( int n /*, double location [=0.0] , double scale [=1.0] */ ){
- return NumericVector( n, stats::CauchyGenerator_0() ) ;
- }
-
-
-
-
- NumericVector rchisq( int n, double df ){
- if (!R_FINITE(df) || df < 0.0) return NumericVector(n, R_NaN) ;
- return NumericVector( n, stats::ChisqGenerator( df ) ) ;
- }
-
-
-
-
- NumericVector rexp( int n, double rate ){
- double scale = 1.0 / rate ;
- if (!R_FINITE(scale) || scale <= 0.0) {
- if(scale == 0.) return NumericVector( n, 0.0 ) ;
- /* else */
- return NumericVector( n, R_NaN ) ;
- }
- return NumericVector( n, stats::ExpGenerator( scale ) ) ;
- }
- NumericVector rexp( int n /* , rate = 1 */ ){
- return NumericVector( n, stats::ExpGenerator__rate1() ) ;
- }
-
-
-
-
-
- NumericVector rf( int n, double n1, double n2 ){
- if (ISNAN(n1) || ISNAN(n2) || n1 <= 0. || n2 <= 0.)
- return NumericVector( n, R_NaN ) ;
- if( R_FINITE( n1 ) && R_FINITE( n2 ) ){
- return NumericVector( n, stats::FGenerator_Finite_Finite( n1, n2 ) ) ;
- } else if( ! R_FINITE( n1 ) && ! R_FINITE( n2 ) ){
- return NumericVector( n, 1.0 ) ;
- } else if( ! R_FINITE( n1 ) ) {
- return NumericVector( n, stats::FGenerator_NotFinite_Finite( n2 ) ) ;
- } else {
- return NumericVector( n, stats::FGenerator_Finite_NotFinite( n1 ) ) ;
- }
- }
-
-
-
-
-
- NumericVector rgamma( int n, double a, double scale ){
- if (!R_FINITE(a) || !R_FINITE(scale) || a < 0.0 || scale <= 0.0) {
- if(scale == 0.) return NumericVector( n, 0.) ;
- return NumericVector( n, R_NaN ) ;
- }
- if( a == 0. ) return NumericVector(n, 0. ) ;
- return NumericVector( n, stats::GammaGenerator(a, scale) ) ;
- }
- NumericVector rgamma( int n, double a /* scale = 1.0 */ ){
- if (!R_FINITE(a) || a < 0.0 ) {
- return NumericVector( n, R_NaN ) ;
- }
- if( a == 0. ) return NumericVector(n, 0. ) ;
- /* TODO: check if we can take advantage of the scale = 1 special case */
- return NumericVector( n, stats::GammaGenerator(a, 1.0) ) ;
- }
-
-
-
-
- NumericVector rgeom( int n, double p ){
- if (!R_FINITE(p) || p <= 0 || p > 1)
- return NumericVector( n, R_NaN );
- return NumericVector( n, stats::GeomGenerator( p ) ) ;
- }
-
-
-
-
- NumericVector rhyper( int n, double nn1, double nn2, double kk ){
- return NumericVector( n, stats::HyperGenerator( nn1, nn2, kk ) ) ;
- }
-
-
-
-
- NumericVector rlnorm( int n, double meanlog, double sdlog ){
- if (ISNAN(meanlog) || !R_FINITE(sdlog) || sdlog < 0.){
- // TODO: R also throws a warning in that case, should we ?
- return NumericVector( n, R_NaN ) ;
- } else if (sdlog == 0. || !R_FINITE(meanlog)){
- return NumericVector( n, ::exp( meanlog ) ) ;
- } else {
- return NumericVector( n, stats::LNormGenerator( meanlog, sdlog ) );
- }
- }
-
-
-
-
- NumericVector rlnorm( int n, double meanlog /*, double sdlog = 1.0 */){
- if (ISNAN(meanlog) ){
- // TODO: R also throws a warning in that case, should we ?
- return NumericVector( n, R_NaN ) ;
- } else if ( !R_FINITE(meanlog)){
- return NumericVector( n, ::exp( meanlog ) ) ;
- } else {
- return NumericVector( n, stats::LNormGenerator_1( meanlog ) );
- }
- }
-
-
-
-
- NumericVector rlnorm( int n /*, double meanlog [=0.], double sdlog = 1.0 */){
- return NumericVector( n, stats::LNormGenerator_0( ) );
- }
-
-
-
-
- NumericVector rlogis( int n, double location, double scale ){
- if (ISNAN(location) || !R_FINITE(scale))
- return NumericVector( n, R_NaN ) ;
-
- if (scale == 0. || !R_FINITE(location))
- return NumericVector( n, location );
-
- return NumericVector( n, stats::LogisGenerator( location, scale ) ) ;
- }
-
-
-
-
- NumericVector rlogis( int n, double location /*, double scale =1.0 */ ){
- if (ISNAN(location) )
- return NumericVector( n, R_NaN ) ;
-
- if (!R_FINITE(location))
- return NumericVector( n, location );
-
- return NumericVector( n, stats::LogisGenerator_1( location ) ) ;
- }
-
-
-
-
- NumericVector rlogis( int n /*, double location [=0.0], double scale =1.0 */ ){
- return NumericVector( n, stats::LogisGenerator_0() ) ;
- }
-
-
-
-
- NumericVector rnbinom( int n, double siz, double prob ){
- if(!R_FINITE(siz) || !R_FINITE(prob) || siz <= 0 || prob <= 0 || prob > 1)
- /* prob = 1 is ok, PR#1218 */
- return NumericVector( n, R_NaN ) ;
-
- return NumericVector( n, stats::NBinomGenerator( siz, prob ) ) ;
- }
-
-
-
-
- NumericVector rnbinom_mu( int n, double siz, double mu ){
- if(!R_FINITE(siz) || !R_FINITE(mu) || siz <= 0 || mu < 0)
- return NumericVector( n, R_NaN ) ;
-
- return NumericVector( n, stats::NBinomGenerator_Mu( siz, mu ) ) ;
- }
-
-
-
-
- NumericVector rnchisq( int n, double df, double lambda ){
- if (!R_FINITE(df) || !R_FINITE(lambda) || df < 0. || lambda < 0.)
- return NumericVector(n, R_NaN) ;
- if( lambda == 0.0 ){
- // using the central generator, see rchisq.h
- return NumericVector( n, stats::ChisqGenerator( df ) ) ;
- }
- return NumericVector( n, stats::NChisqGenerator( df, lambda ) ) ;
- }
-
-
-
-
- NumericVector rnchisq( int n, double df /*, double lambda = 0.0 */ ){
- if (!R_FINITE(df) || df < 0. )
- return NumericVector(n, R_NaN) ;
- return NumericVector( n, stats::ChisqGenerator( df ) ) ;
- }
-
-
-
-
- NumericVector rpois( int n, double mu ){
- return NumericVector( n, stats::PoissonGenerator(mu) ) ;
- }
-
-
-
-
-
- NumericVector rsignrank( int n, double nn ){
- return NumericVector( n, stats::SignRankGenerator(nn) ) ;
- }
-
-
-
-
- NumericVector rt( int n, double df ){
- // special case
- if (ISNAN(df) || df <= 0.0)
- return NumericVector( n, R_NaN ) ;
-
- // just generating a N(0,1)
- if(!R_FINITE(df))
- return NumericVector( n, stats::NormGenerator__mean0__sd1() ) ;
-
- // general case
- return NumericVector( n, stats::TGenerator( df ) ) ;
- }
-
-
-
-
- NumericVector runif( int n, double min, double max ){
- if (!R_FINITE(min) || !R_FINITE(max) || max < min) return NumericVector( n, R_NaN ) ;
- if( min == max ) return NumericVector( n, min ) ;
- return NumericVector( n, stats::UnifGenerator( min, max ) ) ;
- }
-
-
-
-
- NumericVector runif( int n, double min /*, double max = 1.0 */ ){
- if (!R_FINITE(min) || 1.0 < min) return NumericVector( n, R_NaN ) ;
- if( min == 1.0 ) return NumericVector( n, 1.0 ) ;
- return NumericVector( n, stats::UnifGenerator( min, 1.0 ) ) ;
- }
-
-
-
-
- NumericVector runif( int n /*, double min = 0.0, double max = 1.0 */ ){
- return NumericVector( n, stats::UnifGenerator__0__1() ) ;
- }
-
-
-
-
- NumericVector rweibull( int n, double shape, double scale ){
- if (!R_FINITE(shape) || !R_FINITE(scale) || shape <= 0. || scale <= 0.) {
- if(scale == 0.) return NumericVector(n, 0.);
- /* else */
- return NumericVector(n, R_NaN);
- }
- return NumericVector( n, stats::WeibullGenerator( shape, scale ) ) ;
- }
-
- NumericVector rweibull( int n, double shape /* scale = 1 */ ){
- if (!R_FINITE(shape) || shape <= 0. ) {
- return NumericVector(n, R_NaN);
- }
- return NumericVector( n, stats::WeibullGenerator__scale1( shape ) ) ;
- }
-
-
-
-
- NumericVector rwilcox( int n, double mm, double nn ){
- return NumericVector( n, stats::WilcoxGenerator(mm, nn) ) ;
- }
-
-}
More information about the Rcpp-commits
mailing list