Skip to content

Commit 7e518da

Browse files
author
qkou
committed
Merge remote-tracking branch 'upstream/master'
2 parents a9b743f + 6485e01 commit 7e518da

File tree

11 files changed

+191
-123
lines changed

11 files changed

+191
-123
lines changed

‎.Rbuildignore

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -12,4 +12,5 @@ vignettes/notyet
1212
doxyfile
1313
.travis.yml
1414
.dir-locals.el
15+
.clang_format
1516
vignettes/getCurrentVersionsOfCitedPackages.R

‎.clang_format

Lines changed: 66 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,66 @@
1+
---
2+
Language: Cpp
3+
# BasedOnStyle: LLVM
4+
AccessModifierOffset: -4
5+
AlignAfterOpenBracket: true
6+
AlignEscapedNewlinesLeft: false
7+
AlignOperands: true
8+
AlignTrailingComments: true
9+
AlignConsecutiveAssignments: false
10+
AllowAllParametersOfDeclarationOnNextLine: true
11+
AllowShortBlocksOnASingleLine: false
12+
AllowShortCaseLabelsOnASingleLine: false
13+
AllowShortIfStatementsOnASingleLine: false
14+
AllowShortLoopsOnASingleLine: false
15+
AllowShortFunctionsOnASingleLine: All
16+
AlwaysBreakAfterDefinitionReturnType: false
17+
AlwaysBreakTemplateDeclarations: false
18+
AlwaysBreakBeforeMultilineStrings: false
19+
BreakBeforeBinaryOperators: None
20+
BreakBeforeTernaryOperators: true
21+
BreakConstructorInitializersBeforeComma: false
22+
BinPackParameters: true
23+
BinPackArguments: true
24+
ColumnLimit: 80
25+
ConstructorInitializerAllOnOneLineOrOnePerLine: false
26+
ConstructorInitializerIndentWidth: 4
27+
DerivePointerAlignment: false
28+
ExperimentalAutoDetectBinPacking: false
29+
IndentCaseLabels: false
30+
IndentWrappedFunctionNames: false
31+
IndentFunctionDeclarationAfterType: false
32+
MaxEmptyLinesToKeep: 1
33+
KeepEmptyLinesAtTheStartOfBlocks: true
34+
NamespaceIndentation: None
35+
ObjCBlockIndentWidth: 2
36+
ObjCSpaceAfterProperty: false
37+
ObjCSpaceBeforeProtocolList: true
38+
PenaltyBreakBeforeFirstCallParameter: 19
39+
PenaltyBreakComment: 300
40+
PenaltyBreakString: 1000
41+
PenaltyBreakFirstLessLess: 120
42+
PenaltyExcessCharacter: 1000000
43+
PenaltyReturnTypeOnItsOwnLine: 60
44+
PointerAlignment: Left
45+
SpacesBeforeTrailingComments: 2
46+
Cpp11BracedListStyle: true
47+
Standard: Cpp03
48+
IndentWidth: 4
49+
TabWidth: 4
50+
UseTab: Never
51+
BreakBeforeBraces: Attach
52+
SpacesInParentheses: false
53+
SpacesInSquareBrackets: false
54+
SpacesInAngles: false
55+
SpaceInEmptyParentheses: false
56+
SpacesInCStyleCastParentheses: false
57+
SpaceAfterCStyleCast: true
58+
SpacesInContainerLiterals: true
59+
SpaceBeforeAssignmentOperators: true
60+
ContinuationIndentWidth: 4
61+
CommentPragmas: '^ IWYU pragma:'
62+
ForEachMacros: [ foreach, Q_FOREACH, BOOST_FOREACH ]
63+
SpaceBeforeParens: ControlStatements
64+
DisableFormat: false
65+
...
66+

‎ChangeLog

Lines changed: 16 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,23 @@
1+
2015-07-14 JJ Allaire <[email protected]>
2+
3+
* src/attributes.cpp: fix crash on second call to sourceCpp
4+
5+
2015-07-07 Matt P. Dziubinski <[email protected]>
6+
7+
* inst/include/Rcpp/sugar/functions/var.h: Variance -- changed from
8+
the unstable formula back to the stable (two-pass) formula, fixed
9+
support for complex numbers (formula correction).
10+
* inst/unitTests/runit.sugar.var.R: Added tests for complex variance
11+
computation, applied simple code refactoring.
12+
113
2015-07-04 Dirk Eddelbuettel <[email protected]>
214

315
* vignettes/Rcpp.bib: Updated reference to several CRAN packages
416

17+
2015-07-02 Kevin Ushey <[email protected]>
18+
19+
* .clang_format: Added
20+
521
2015-06-25 Kevin Ushey <[email protected]>
622

723
* inst/include/Rcpp/api/meat/Rcpp_eval.h: reset error after Rcpp_eval

‎DESCRIPTION

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
Package: Rcpp
22
Title: Seamless R and C++ Integration
3-
Version: 0.11.6.2.1
4-
Date: 2015-06-28
3+
Version: 0.11.6.3
4+
Date: 2015-07-14
55
Author: Dirk Eddelbuettel, Romain Francois, JJ Allaire, Kevin Ushey,
66
Douglas Bates, and John Chambers
77
Maintainer: Dirk Eddelbuettel <[email protected]>

‎inst/NEWS.Rd

Lines changed: 7 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -8,15 +8,17 @@
88
\itemize{
99
\item All internal length variables have been changed from \code{R_len_t}
1010
to \code{R_xlen_t} to support vectors longer than 2^31-1 elements (via
11-
pull request 303 by Qiang Kou)
12-
\item The sugar function \code{sapply} now supports lambda functions
11+
pull request 303 by Qiang Kou).
12+
\item The sugar function \code{sapply} now supports lambda functions.
13+
\item The \code{var} sugar function now uses a more robust two-pass
14+
method, supports complex numbers, with new unit tests added.
1315
\item \code{String} constructors now allow encodings (via pull request 310
14-
by Qiang Kou)
16+
by Qiang Kou).
1517
}
1618
\item Changes in Rcpp Attributes:
1719
\itemize{
18-
\item Don't load \code{sourceCpp} dynamic library if it's already
19-
been loaded.
20+
\item Use more robust method of ensuring unique paths for generated shared
21+
libraries.
2022
\item The \code{evalCpp} function now also supports the \code{plugins}
2123
argument.
2224
}

‎inst/include/Rcpp/api/meat/Rcpp_eval.h

Lines changed: 53 additions & 88 deletions
Original file line numberDiff line numberDiff line change
@@ -20,101 +20,66 @@
2020

2121
#include <Rcpp/Interrupt.h>
2222

23-
namespace Rcpp{
24-
25-
struct EvalCall {
26-
SEXP expr;
27-
SEXP env;
28-
SEXP result;
29-
std::vector<std::string> warnings;
30-
bool error_occurred;
31-
std::string error_message;
32-
};
33-
34-
inline void Rcpp_eval(void* data) {
35-
36-
EvalCall* evalCall = (EvalCall*)data;
37-
SEXP env = evalCall->env;
38-
39-
Shield<SEXP> expr(evalCall->expr) ;
40-
41-
Environment RCPP = Environment::Rcpp_namespace();
42-
SEXP withCallingHandlersSym = ::Rf_install("withCallingHandlers");
43-
SEXP tryCatchSym = ::Rf_install("tryCatch");
44-
SEXP evalqSym = ::Rf_install("evalq");
45-
SEXP conditionMessageSym = ::Rf_install("conditionMessage");
46-
SEXP errorRecorderSym = ::Rf_install(".rcpp_error_recorder");
47-
SEXP warningRecorderSym = ::Rf_install(".rcpp_warning_recorder");
48-
SEXP collectWarningsSym = ::Rf_install(".rcpp_collect_warnings");
49-
SEXP errorSym = ::Rf_install("error");
50-
SEXP warningSym = ::Rf_install("warning");
51-
52-
// define the tryCatchCall
53-
Shield<SEXP> tryCatchCall( Rf_lang3(
54-
tryCatchSym,
55-
Rf_lang3( evalqSym, expr, env ),
56-
errorRecorderSym
57-
) ) ;
58-
SET_TAG( CDDR(tryCatchCall), errorSym ) ;
59-
60-
// encose it in withCallingHandlers
61-
Shield<SEXP> call( Rf_lang3(
62-
withCallingHandlersSym,
63-
tryCatchCall,
64-
warningRecorderSym
65-
) ) ;
66-
SET_TAG( CDDR(call), warningSym ) ;
67-
68-
// execute the call
69-
Shield<SEXP> res(::Rf_eval( call, RCPP ) );
23+
namespace Rcpp {
24+
25+
inline SEXP Rcpp_eval(SEXP expr, SEXP env) {
26+
27+
// 'identity' function used to capture errors, interrupts
28+
SEXP identity = Rf_findFun(
29+
::Rf_install("identity"),
30+
R_BaseNamespace
31+
);
32+
33+
if (identity == R_UnboundValue) {
34+
stop("Failed to find 'base::identity()'");
35+
}
7036

71-
// collect warnings
72-
Shield<SEXP> warningCall(Rf_lang1(collectWarningsSym));
73-
Shield<SEXP> warnings(::Rf_eval(warningCall, RCPP));
37+
// define the evalq call -- the actual R evaluation we
38+
// want to execute
39+
Shield<SEXP> evalqCall(Rf_lang3(
40+
::Rf_install("evalq"),
41+
expr,
42+
env
43+
));
44+
45+
// define the call -- enclose with `tryCatch` so we can record
46+
// and later forward error messages
47+
Shield<SEXP> call(Rf_lang4(
48+
::Rf_install("tryCatch"),
49+
evalqCall,
50+
identity,
51+
identity
52+
));
53+
SET_TAG(CDDR(call), ::Rf_install("error"));
54+
SET_TAG(CDDDR(call), ::Rf_install("interrupt"));
55+
56+
// execute the call
57+
Shield<SEXP> res(::Rf_eval(call, R_GlobalEnv));
58+
59+
// check for condition results (errors, interrupts)
60+
if (Rf_inherits(res, "condition")) {
7461

75-
evalCall->warnings = Rcpp::as<std::vector<std::string> >(warnings);
76-
77-
// check for error
78-
if( error_occured() ) {
79-
Shield<SEXP> current_error ( rcpp_get_current_error() ) ;
80-
Shield<SEXP> conditionMessageCall (::Rf_lang2(conditionMessageSym, current_error)) ;
81-
Shield<SEXP> condition_message (::Rf_eval(conditionMessageCall, R_GlobalEnv)) ;
82-
evalCall->error_occurred = true;
83-
evalCall->error_message = std::string(CHAR(::Rf_asChar(condition_message)));
84-
} else {
85-
evalCall->error_occurred = false;
86-
evalCall->result = res;
62+
if (Rf_inherits(res, "error")) {
63+
64+
Shield<SEXP> conditionMessageCall(::Rf_lang2(
65+
::Rf_install("conditionMessage"),
66+
res
67+
));
68+
69+
Shield<SEXP> conditionMessage(::Rf_eval(conditionMessageCall, R_GlobalEnv));
70+
throw eval_error(CHAR(STRING_ELT(conditionMessage, 0)));
8771
}
8872

89-
reset_current_error() ;
90-
91-
}
92-
93-
inline SEXP Rcpp_eval(SEXP expr_, SEXP env) {
94-
95-
// create the call object
96-
EvalCall call;
97-
call.expr = expr_;
98-
call.env = env;
99-
100-
// execute it
101-
Rboolean completed = R_ToplevelExec(Rcpp_eval, (void*)&call);
102-
103-
// print warnings
104-
for (size_t i = 0; i<call.warnings.size(); i++)
105-
Rf_warning(call.warnings[i].c_str());
106-
107-
// handle error or result if it completed, else throw interrupt
108-
if (completed) {
109-
if (call.error_occurred)
110-
throw eval_error(call.error_message);
111-
else
112-
return call.result;
113-
} else {
73+
// check for interrupt
74+
if (Rf_inherits(res, "interrupt")) {
11475
throw internal::InterruptedException();
11576
}
77+
11678
}
117-
79+
80+
return res;
11881
}
11982

83+
} // namespace Rcpp
84+
12085
#endif

‎inst/include/Rcpp/sugar/functions/var.h

Lines changed: 13 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -34,10 +34,12 @@ class Var : public Lazy< double , Var<RTYPE,NA,T> > {
3434
Var( const VEC_TYPE& object_ ) : object(object_){}
3535

3636
double get() const{
37-
double
38-
m = mean(object).get(),
39-
ssq = sum( pow(object, 2.0) ).get();
40-
return (ssq - m * m * object.size()) / (object.size() - 1);
37+
const double average = mean(object).get();
38+
const R_xlen_t sample_size = object.size();
39+
double sum_squared_deviations = 0.0;
40+
for (R_xlen_t i = 0; i != sample_size; ++i)
41+
sum_squared_deviations += std::pow(object[i] - average, 2.0);
42+
return sum_squared_deviations / (sample_size - 1);
4143
}
4244

4345
private:
@@ -52,13 +54,14 @@ class Var<CPLXSXP,NA,T> : public Lazy< double , Var<CPLXSXP,NA,T> > {
5254
Var( const VEC_TYPE& object_ ) : object(object_){}
5355

5456
double get() const{
55-
double sq = 0, ssq = 0;
56-
for(R_xlen_t i = 0;i < object.size();i++) {
57-
Rcomplex z = object[i];
58-
sq += z.r;
59-
ssq += z.r * z.r;
57+
const Rcomplex average = mean(object).get();
58+
const R_xlen_t sample_size = object.size();
59+
double sum_squared_deviations_magnitudes = 0.0;
60+
for (R_xlen_t i = 0; i != sample_size; ++i) {
61+
const Rcomplex deviation = object[i] - average;
62+
sum_squared_deviations_magnitudes += deviation.r * deviation.r + deviation.i * deviation.i;
6063
}
61-
return (ssq - sq * sq / object.size()) / (object.size() - 1);
64+
return sum_squared_deviations_magnitudes / (sample_size - 1);
6265
}
6366

6467
private:

‎inst/include/RcppCommon.h

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -28,6 +28,9 @@
2828

2929
#include <Rcpp/r/headers.h>
3030

31+
// Override 'Rf_error' so that we can catch errors
32+
#define Rf_error Rcpp::stop
33+
3134
/**
3235
* \brief Rcpp API
3336
*/

‎inst/unitTests/runit.sugar.var.R

Lines changed: 15 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -23,14 +23,21 @@
2323
if (.runThisTest) {
2424

2525
test.Sugar.var <- function() {
26-
f1 <- Rcpp::cppFunction('double myVar(NumericVector x) { return(var(x)); }')
27-
f2 <- Rcpp::cppFunction('double myVar(IntegerVector x) { return(var(x)); }')
28-
f3 <- Rcpp::cppFunction('double myVar(ComplexVector x) { return(var(x)); }')
29-
f4 <- Rcpp::cppFunction('double myVar(LogicalVector x) { return(var(x)); }')
30-
checkEquals(f1((1:10) * 1.1), var((1:10) * 1.1))
31-
checkEquals(f2(1:10), var(1:10))
32-
checkEquals(f3(1:10 + (1 + 1i)), var(1:10 + (1 + 1i)))
33-
checkEquals(f4(c(T, F, T, F, T)), var(c(T, F, T, F, T)))
26+
fNumeric <- Rcpp::cppFunction('double myVar(NumericVector x) { return(var(x)); }')
27+
fInteger <- Rcpp::cppFunction('double myVar(IntegerVector x) { return(var(x)); }')
28+
fComplex <- Rcpp::cppFunction('double myVar(ComplexVector x) { return(var(x)); }')
29+
fLogical <- Rcpp::cppFunction('double myVar(LogicalVector x) { return(var(x)); }')
30+
test_data_real <- 1:10
31+
checkEquals(fNumeric(test_data_real * 1.1), var(test_data_real * 1.1))
32+
checkEquals(fInteger(test_data_real), var(test_data_real))
33+
test_data_complex_1 <- complex(real = 5:1, imag = 2:6)
34+
test_data_complex_2 <- complex(real = 1:5, imag = 6:10)
35+
test_data_complex_1_known_var <- 5
36+
test_data_complex_2_known_var <- 5
37+
checkEquals(fComplex(test_data_complex_1), test_data_complex_1_known_var)
38+
checkEquals(fComplex(test_data_complex_2), test_data_complex_2_known_var)
39+
test_data_logical <- c(TRUE, FALSE, TRUE, FALSE, TRUE)
40+
checkEquals(fLogical(test_data_logical), var(test_data_logical))
3441
}
3542

3643
}

0 commit comments

Comments
 (0)