Skip to content

Commit a23f116

Browse files
alystalyst
committed
update matrix tests
1 parent 5e9bbf7 commit a23f116

File tree

6 files changed

+92
-21
lines changed

6 files changed

+92
-21
lines changed

‎cpp11test/R/cpp11.R

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -92,6 +92,10 @@ row_sums <- function(x) {
9292
.Call(`_cpp11test_row_sums`, x)
9393
}
9494

95+
col_sums <- function(x) {
96+
.Call(`_cpp11test_col_sums`, x)
97+
}
98+
9599
protect_one_ <- function(x, n) {
96100
invisible(.Call(`_cpp11test_protect_one_`, x, n))
97101
}

‎cpp11test/src/cpp11.cpp

Lines changed: 13 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,7 @@
55
#include <Rcpp.h>
66
using namespace Rcpp;
77
#include "cpp11/declarations.hpp"
8+
#include <R_ext/Visibility.h>
89

910
// add.cpp
1011
SEXP cpp11_add_vec_for_(cpp11::writable::doubles x, double num);
@@ -148,7 +149,7 @@ extern "C" SEXP _cpp11test_gibbs_cpp(SEXP N, SEXP thin) {
148149
END_CPP11
149150
}
150151
// matrix.cpp
151-
cpp11::doubles_matrix gibbs_cpp2(int N, int thin);
152+
cpp11::doubles_matrix<> gibbs_cpp2(int N, int thin);
152153
extern "C" SEXP _cpp11test_gibbs_cpp2(SEXP N, SEXP thin) {
153154
BEGIN_CPP11
154155
return cpp11::as_sexp(gibbs_cpp2(cpp11::as_cpp<cpp11::decay_t<int>>(N), cpp11::as_cpp<cpp11::decay_t<int>>(thin)));
@@ -169,10 +170,17 @@ extern "C" SEXP _cpp11test_gibbs_rcpp2(SEXP N, SEXP thin) {
169170
END_CPP11
170171
}
171172
// matrix.cpp
172-
cpp11::doubles row_sums(cpp11::doubles_matrix x);
173+
cpp11::doubles row_sums(cpp11::doubles_matrix<cpp11::by_row> x);
173174
extern "C" SEXP _cpp11test_row_sums(SEXP x) {
174175
BEGIN_CPP11
175-
return cpp11::as_sexp(row_sums(cpp11::as_cpp<cpp11::decay_t<cpp11::doubles_matrix>>(x)));
176+
return cpp11::as_sexp(row_sums(cpp11::as_cpp<cpp11::decay_t<cpp11::doubles_matrix<cpp11::by_row>>>(x)));
177+
END_CPP11
178+
}
179+
// matrix.cpp
180+
cpp11::doubles col_sums(cpp11::doubles_matrix<cpp11::by_column> x);
181+
extern "C" SEXP _cpp11test_col_sums(SEXP x) {
182+
BEGIN_CPP11
183+
return cpp11::as_sexp(col_sums(cpp11::as_cpp<cpp11::decay_t<cpp11::doubles_matrix<cpp11::by_column>>>(x)));
176184
END_CPP11
177185
}
178186
// protect.cpp
@@ -388,6 +396,7 @@ extern "C" {
388396
extern SEXP run_testthat_tests(SEXP);
389397

390398
static const R_CallMethodDef CallEntries[] = {
399+
{"_cpp11test_col_sums", (DL_FUNC) &_cpp11test_col_sums, 1},
391400
{"_cpp11test_cpp11_add_vec_for_", (DL_FUNC) &_cpp11test_cpp11_add_vec_for_, 2},
392401
{"_cpp11test_cpp11_insert_", (DL_FUNC) &_cpp11test_cpp11_insert_, 1},
393402
{"_cpp11test_cpp11_release_", (DL_FUNC) &_cpp11test_cpp11_release_, 1},
@@ -444,7 +453,7 @@ static const R_CallMethodDef CallEntries[] = {
444453
};
445454
}
446455

447-
extern "C" void R_init_cpp11test(DllInfo* dll){
456+
extern "C" attribute_visible void R_init_cpp11test(DllInfo* dll){
448457
R_registerRoutines(dll, NULL, CallEntries, NULL, NULL);
449458
R_useDynamicSymbols(dll, FALSE);
450459
R_forceSymbols(dll, TRUE);

‎cpp11test/src/matrix.cpp

Lines changed: 24 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@
44
using namespace cpp11;
55

66
[[cpp11::register]] SEXP gibbs_cpp(int N, int thin) {
7-
cpp11::writable::doubles_matrix mat(N, 2);
7+
cpp11::writable::doubles_matrix<> mat(N, 2);
88
double x = 0, y = 0;
99
for (int i = 0; i < N; i++) {
1010
for (int j = 0; j < thin; j++) {
@@ -18,8 +18,8 @@ using namespace cpp11;
1818
return mat;
1919
}
2020

21-
[[cpp11::register]] cpp11::doubles_matrix gibbs_cpp2(int N, int thin) {
22-
cpp11::writable::doubles_matrix mat(N, 2);
21+
[[cpp11::register]] cpp11::doubles_matrix<> gibbs_cpp2(int N, int thin) {
22+
cpp11::writable::doubles_matrix<> mat(N, 2);
2323
double x = 0, y = 0;
2424
for (int i = 0; i < N; i++) {
2525
for (int j = 0; j < thin; j++) {
@@ -67,11 +67,11 @@ using namespace Rcpp;
6767
return (mat);
6868
}
6969

70-
[[cpp11::register]] cpp11::doubles row_sums(cpp11::doubles_matrix x) {
70+
[[cpp11::register]] cpp11::doubles row_sums(cpp11::doubles_matrix<cpp11::by_row> x) {
7171
cpp11::writable::doubles sums(x.nrow());
7272

7373
int i = 0;
74-
for (auto& row : x) {
74+
for (auto row : x) {
7575
sums[i] = 0.;
7676
for (auto&& val : row) {
7777
if (cpp11::is_na(val)) {
@@ -85,3 +85,22 @@ using namespace Rcpp;
8585

8686
return sums;
8787
}
88+
89+
[[cpp11::register]] cpp11::doubles col_sums(cpp11::doubles_matrix<cpp11::by_column> x) {
90+
cpp11::writable::doubles sums(x.ncol());
91+
92+
int i = 0;
93+
for (auto col : x) {
94+
sums[i] = 0.;
95+
for (auto&& val : col) {
96+
if (cpp11::is_na(val)) {
97+
sums[i] = NA_REAL;
98+
break;
99+
}
100+
sums[i] += val;
101+
}
102+
++i;
103+
}
104+
105+
return sums;
106+
}

‎cpp11test/src/test-matrix.cpp

Lines changed: 39 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@
77

88
context("matrix-C++") {
99
test_that("matrix dim attributes are correct for writable matrices") {
10-
cpp11::writable::doubles_matrix x(5, 2);
10+
cpp11::writable::doubles_matrix<cpp11::by_row> x(5, 2);
1111

1212
cpp11::integers dim(SEXP(x.attr("dim")));
1313

@@ -16,42 +16,71 @@ context("matrix-C++") {
1616

1717
expect_true(x.nrow() == 5);
1818
expect_true(x.ncol() == 2);
19+
expect_true(x.nslices() == 5);
20+
expect_true(x.slice_size() == 2);
1921
}
2022
test_that("matrix dim attributes are correct for read only matrices") {
2123
auto getExportedValue = cpp11::package("base")["getExportedValue"];
2224

23-
cpp11::doubles_matrix x(SEXP(getExportedValue("datasets", "volcano")));
25+
cpp11::doubles_matrix<cpp11::by_row> x(SEXP(getExportedValue("datasets", "volcano")));
2426

2527
expect_true(x.size() == 5307);
2628
expect_true(x.nrow() == 87);
2729
expect_true(x.ncol() == 61);
30+
expect_true(x.nslices() == 87);
31+
expect_true(x.slice_size() == 61);
2832
}
2933

3034
test_that("row based subsetting works") {
3135
auto getExportedValue = cpp11::package("base")["getExportedValue"];
3236

33-
cpp11::doubles_matrix x(SEXP(getExportedValue("datasets", "volcano")));
37+
cpp11::doubles_matrix<cpp11::by_row> x(SEXP(getExportedValue("datasets", "volcano")));
38+
expect_true(x.nslices() == 87);
39+
expect_true(x.slice_size() == 61);
3440

3541
auto r = x[0];
3642
expect_true(r[0] == 100);
3743
expect_true(r[60] == 103);
3844
}
3945

46+
test_that("column based subsetting works") {
47+
auto getExportedValue = cpp11::package("base")["getExportedValue"];
48+
49+
cpp11::doubles_matrix<cpp11::by_column> x(SEXP(getExportedValue("datasets", "volcano")));
50+
expect_true(x.nslices() == 61);
51+
expect_true(x.slice_size() == 87);
52+
53+
auto c = x[0];
54+
expect_true(c[0] == 100);
55+
expect_true(c[86] == 103);
56+
}
57+
4058
test_that("index based subsetting works") {
4159
auto getExportedValue = cpp11::package("base")["getExportedValue"];
4260

43-
cpp11::doubles_matrix x(SEXP(getExportedValue("datasets", "volcano")));
61+
cpp11::doubles_matrix<cpp11::by_row> xr(SEXP(getExportedValue("datasets", "volcano")));
62+
expect_true(xr(0, 0) == 100);
63+
expect_true(xr(0, 60) == 103);
4464

45-
expect_true(x(0, 0) == 100);
46-
expect_true(x(0, 60) == 103);
65+
cpp11::doubles_matrix<cpp11::by_column> xc(SEXP(getExportedValue("datasets", "volcano")));
66+
expect_true(xc(0, 0) == 100);
67+
expect_true(xc(0, 60) == 103);
4768
}
4869

4970
test_that("copy constructor works") {
5071
auto getExportedValue = cpp11::package("base")["getExportedValue"];
51-
cpp11::doubles_matrix x(SEXP(getExportedValue("datasets", "volcano")));
52-
cpp11::doubles_matrix y(x);
72+
cpp11::doubles_matrix<cpp11::by_row> x(SEXP(getExportedValue("datasets", "volcano")));
73+
74+
cpp11::doubles_matrix<cpp11::by_row> yr(x);
75+
expect_true(x.nrow() == yr.nrow());
76+
expect_true(x.ncol() == yr.ncol());
77+
expect_true(yr.nslices() == yr.nrow());
78+
expect_true(SEXP(x) == SEXP(yr));
5379

54-
expect_true(x.nrow() == y.nrow());
55-
expect_true(SEXP(x) == SEXP(y));
80+
cpp11::doubles_matrix<cpp11::by_column> yc(x);
81+
expect_true(x.nrow() == yc.nrow());
82+
expect_true(x.ncol() == yc.ncol());
83+
expect_true(yc.nslices() == yc.ncol());
84+
expect_true(SEXP(x) == SEXP(yc));
5685
}
5786
}

‎cpp11test/tests/testthat/test-matrix.R

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -7,3 +7,13 @@ test_that("row_sums gives same result as rowSums", {
77
y[3, ] <- NA; x[4, 2] <- NA
88
expect_equal(row_sums(x), rowSums(x))
99
})
10+
11+
test_that("col_sums gives same result as colSums", {
12+
x <- cbind(x1 = 3, x2 = c(4:1, 2:5))
13+
expect_equal(col_sums(x), colSums(x))
14+
15+
# With missing values
16+
y <- cbind(x1 = 3, x2 = c(4:1, 2:5))
17+
y[3, ] <- NA; x[4, 2] <- NA
18+
expect_equal(col_sums(x), colSums(x))
19+
})

‎vignettes/cpp11.Rmd

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -951,8 +951,8 @@ This is relatively straightforward to convert to C++. We:
951951
using namespace cpp11;
952952
namespace writable = cpp11::writable;
953953
954-
[[cpp11::register]] cpp11::doubles_matrix gibbs_cpp(int N, int thin) {
955-
writable::doubles_matrix mat(N, 2);
954+
[[cpp11::register]] cpp11::doubles_matrix<> gibbs_cpp(int N, int thin) {
955+
writable::doubles_matrix<> mat(N, 2);
956956
double x = 0, y = 0;
957957
for (int i = 0; i < N; i++) {
958958
for (int j = 0; j < thin; j++) {

0 commit comments

Comments
 (0)