|
Rcpp Version 0.9.10
|
00001 // -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 4 -*- 00002 // 00003 // rf.h: Rcpp R/C++ interface class library -- 00004 // 00005 // Copyright (C) 2010 - 2011 Douglas Bates, Dirk Eddelbuettel and Romain Francois 00006 // 00007 // This file is part of Rcpp. 00008 // 00009 // Rcpp is free software: you can redistribute it and/or modify it 00010 // under the terms of the GNU General Public License as published by 00011 // the Free Software Foundation, either version 2 of the License, or 00012 // (at your option) any later version. 00013 // 00014 // Rcpp is distributed in the hope that it will be useful, but 00015 // WITHOUT ANY WARRANTY; without even the implied warranty of 00016 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 00017 // GNU General Public License for more details. 00018 // 00019 // You should have received a copy of the GNU General Public License 00020 // along with Rcpp. If not, see <http://www.gnu.org/licenses/>. 00021 00022 #ifndef Rcpp__stats__random_rf_h 00023 #define Rcpp__stats__random_rf_h 00024 00025 namespace Rcpp { 00026 namespace stats { 00027 00028 00029 class FGenerator_Finite_Finite : public ::Rcpp::Generator<false,double> { 00030 public: 00031 00032 FGenerator_Finite_Finite( double n1_, double n2_ ) : 00033 n1(n1_), n2(n2_), n1__2(n1_ / 2.0 ), n2__2(n2_ / 2.0 ), ratio(n2_/n1_) {} 00034 00035 inline double operator()() const { 00036 // here we know that both n1 and n2 are finite 00037 // return ( ::rchisq( n1 ) / n1 ) / ( ::rchisq( n2 ) / n2 ); 00038 return ratio * ::Rf_rgamma( n1__2, 2.0 ) / ::Rf_rgamma( n2__2, 2.0 ) ; 00039 } 00040 00041 private: 00042 double n1, n2, n1__2, n2__2, ratio ; 00043 } ; 00044 00045 00046 class FGenerator_NotFinite_Finite : public ::Rcpp::Generator<false,double> { 00047 public: 00048 00049 FGenerator_NotFinite_Finite( double n2_ ) : n2( n2_), n2__2(n2_ / 2.0 ) {} 00050 00051 inline double operator()() const { 00052 // return n2 / ::rchisq( n2 ) ; 00053 return n2 / ::Rf_rgamma( n2__2, 2.0 ) ; 00054 } 00055 00056 private: 00057 double n2, n2__2 ; 00058 } ; 00059 00060 00061 class FGenerator_Finite_NotFinite : public ::Rcpp::Generator<false,double> { 00062 public: 00063 00064 FGenerator_Finite_NotFinite( double n1_ ) : n1(n1_), n1__2(n1_ / 2.0 ) {} 00065 00066 inline double operator()() const { 00067 // return ::rchisq( n1 ) / n1 ; 00068 return ::Rf_rgamma( n1__2, 2.0 ) / n1 ; 00069 } 00070 00071 private: 00072 double n1, n1__2 ; 00073 } ; 00074 00075 } // stats 00076 00077 // Please make sure you to read Section 6.3 of "Writing R Extensions" 00078 // about the need to call GetRNGstate() and PutRNGstate() when using 00079 // the random number generators provided by R. 00080 inline NumericVector rf( int n, double n1, double n2 ){ 00081 if (ISNAN(n1) || ISNAN(n2) || n1 <= 0. || n2 <= 0.) 00082 return NumericVector( n, R_NaN ) ; 00083 if( R_FINITE( n1 ) && R_FINITE( n2 ) ){ 00084 return NumericVector( n, stats::FGenerator_Finite_Finite( n1, n2 ) ) ; 00085 } else if( ! R_FINITE( n1 ) && ! R_FINITE( n2 ) ){ 00086 return NumericVector( n, 1.0 ) ; 00087 } else if( ! R_FINITE( n1 ) ) { 00088 return NumericVector( n, stats::FGenerator_NotFinite_Finite( n2 ) ) ; 00089 } else { 00090 return NumericVector( n, stats::FGenerator_Finite_NotFinite( n1 ) ) ; 00091 } 00092 } 00093 00094 } // Rcpp 00095 00096 #endif