diff --git a/.github/workflows/R.yml b/.github/workflows/R.yml index fdc72553..c3e0d120 100644 --- a/.github/workflows/R.yml +++ b/.github/workflows/R.yml @@ -107,32 +107,6 @@ jobs: name: results-${{ runner.os }}-r${{ matrix.r }} path: r/check - rchk: - if: false # Skip until https://github.com/r-lib/actions/issues/783 - needs: R-CMD-check - runs-on: ubuntu-latest - container: - image: rhub/ubuntu-rchk - options: --user=root - - steps: - - uses: actions/checkout@v4 - - - uses: r-lib/actions/run-rchk@v2 - with: - setup-only: true - - - run: ls -R /home/docker/R-svn/bin - - - uses: r-lib/actions/setup-r-dependencies@v2 - with: - extra-packages: any::rcmdcheck, local::., any::eaf - working-directory: r - - - uses: r-lib/actions/run-rchk@v2 - with: - run-only: true - coverage: needs: R-CMD-check name: Coverage ${{ matrix.os }} (${{ matrix.r }}) diff --git a/.github/workflows/rchk.yml b/.github/workflows/rchk.yml new file mode 100644 index 00000000..b205ccdb --- /dev/null +++ b/.github/workflows/rchk.yml @@ -0,0 +1,80 @@ +# adapted from a similar check run by {arrow} +# Licensed to the Apache Software Foundation (ASF) under one +# or more contributor license agreements. See the NOTICE file +# distributed with this work for additional information +# regarding copyright ownership. The ASF licenses this file +# to you under the Apache License, Version 2.0 (the +# "License"); you may not use this file except in compliance +# with the License. You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, +# software distributed under the License is distributed on an +# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY +# KIND, either express or implied. See the License for the +# specific language governing permissions and limitations +# under the License. +name: rchk + +on: + workflow_run: + workflows: ['R'] + types: + - completed + branches-ignore: [gh-pages] + paths: + - ".github/workflows/rchk.yml" + - "r/**" + - 'c/Make*' + - 'c/*.mk' + - 'c/**/*.[ch]p?p?' + +env: + R_REMOTES_NO_ERRORS_FROM_WARNINGS: true + _R_CHECK_FORCE_SUGGESTS_: false + _R_CHECK_CRAN_INCOMING_REMOTE_: false + +concurrency: + group: ${{ github.workflow }}-${{ github.ref }} + cancel-in-progress: true + +jobs: + rchk: + if: ${{ github.event.workflow_run.conclusion == 'success' }} + runs-on: ubuntu-latest + name: Run rchk + steps: + - uses: actions/checkout@v4 + - uses: r-lib/actions/setup-r@v2 + with: + r-version: 'devel' + + - name: Install minimal dependencies + run: | + install.packages(c("Rdpack","matrixStats")) + shell: Rscript {0} + working-directory: r + + - name: Build + run: | + R CMD build --no-build-vignettes r + mkdir packages + mv moocore_*.tar.gz packages + + - name: Run rchk + run: | + docker run -v `pwd`/packages:/rchk/packages kalibera/rchk:latest /rchk/packages/moocore_*.tar.gz |& tee rchk.out + - name: Confirm that rchk has no errors + # Suspicious call, [UP], and [PB] are all of the error types currently at + # https://github.com/kalibera/cran-checks/tree/HEAD/rchk/results + # though this might not be exhaustive, there does not appear to be a way to have rchk return an error code + # CRAN also will remove some of the outputs (especially those related to Rcpp and strptime, e.g. + # ERROR: too many states (abstraction error?)) + # https://github.com/kalibera/rchk + run: | + if [ $(grep -Fc "Suspicious call" rchk.out) -gt 0 ] || [ $(grep -F "[UP]" rchk.out | grep -Fvc "results will be incomplete") -gt 0 ] || [ $(grep -Fc "[PB]" rchk.out) -gt 0 ]; then + echo "Found rchk errors" + exit 1 + fi + if: always() diff --git a/r/DESCRIPTION b/r/DESCRIPTION index dc51c913..f7636fd2 100644 --- a/r/DESCRIPTION +++ b/r/DESCRIPTION @@ -32,7 +32,7 @@ URL: https://multi-objective.github.io/moocore/r/, https://github.com/multi-obje LazyLoad: true LazyData: true Encoding: UTF-8 -RoxygenNote: 7.3.0 +RoxygenNote: 7.3.2 Roxygen: list(markdown = TRUE, roclets = c("collate", "rd", "namespace", "doctest::dt_roclet")) diff --git a/r/src/Rcommon.h b/r/src/Rcommon.h index 115a77fb..20f8b6b8 100644 --- a/r/src/Rcommon.h +++ b/r/src/Rcommon.h @@ -9,19 +9,19 @@ #define CHECK_ARG_IS_NUMERIC_VECTOR(A) \ if (!Rf_isReal(A) || !Rf_isVector(A)) \ - Rf_error("Argument '" #A "' is not a numeric vector"); + Rf_error("Argument '" #A "' is not a numeric vector"); #define CHECK_ARG_IS_NUMERIC_MATRIX(A) \ if (!Rf_isReal(A) || !Rf_isMatrix(A)) \ - Rf_error("Argument '" #A "' is not a numeric matrix"); + Rf_error("Argument '" #A "' is not a numeric matrix"); #define CHECK_ARG_IS_INT_VECTOR(A) \ if (!Rf_isInteger(A) || !Rf_isVector(A)) \ - Rf_error("Argument '" #A "' is not an integer vector"); + Rf_error("Argument '" #A "' is not an integer vector"); #define CHECK_ARG_IS_LOGICAL_VECTOR(A) \ if (!Rf_isLogical(A) || !Rf_isVector(A)) \ - Rf_error("Argument '" #A "' is not a logical vector"); + Rf_error("Argument '" #A "' is not a logical vector"); /* The C API of R is awfully ugly and unpractical (and poorly documented). These wrappers make it a little more bearable. */ diff --git a/r/src/Rmoocore.c b/r/src/Rmoocore.c index 79541f8f..99f62a13 100644 --- a/r/src/Rmoocore.c +++ b/r/src/Rmoocore.c @@ -1,8 +1,7 @@ #include "Rcommon.h" #include "eaf.h" -#define DECLARE_CALL(RET_TYPE, NAME, ...) \ - extern RET_TYPE NAME(__VA_ARGS__); +#define DECLARE_CALL(NAME, ...) extern SEXP NAME(__VA_ARGS__); #include "init.h" #undef DECLARE_CALL @@ -52,8 +51,7 @@ compute_eaf_C(SEXP DATA, SEXP CUMSIZES, SEXP PERCENTILE) eaf_t **eaf = compute_eaf_helper(DATA, nobj, cumsizes, nruns, percentile, nlevels); int totalpoints = eaf_totalpoints (eaf, nlevels); - SEXP mat; - PROTECT(mat = Rf_allocMatrix(REALSXP, totalpoints, nobj + 1)); + SEXP mat = PROTECT(Rf_allocMatrix(REALSXP, totalpoints, nobj + 1)); eaf2matrix_R(REAL(mat), eaf, nobj, totalpoints, percentile, nlevels); eaf_free(eaf, nlevels); UNPROTECT(1); @@ -271,8 +269,7 @@ R_read_datasets(SEXP FILENAME) const int ntotal = cumsizes[nruns - 1]; /* FIXME: Is this the fastest way to transfer a matrix from C to R ? */ - SEXP DATA; - PROTECT(DATA = Rf_allocMatrix(REALSXP, ntotal, nobj + 1)); + SEXP DATA = PROTECT(Rf_allocMatrix(REALSXP, ntotal, nobj + 1)); double *rdata = REAL(DATA); matrix_transpose_double (rdata, data, ntotal, nobj); @@ -290,7 +287,7 @@ R_read_datasets(SEXP FILENAME) #include "nondominated.h" -void +SEXP normalise_C(SEXP DATA, SEXP RANGE, SEXP LBOUND, SEXP UBOUND, SEXP MAXIMISE) { int nprotected = 0; @@ -310,6 +307,7 @@ normalise_C(SEXP DATA, SEXP RANGE, SEXP LBOUND, SEXP UBOUND, SEXP MAXIMISE) lbound, ubound); free (maximise); UNPROTECT(nprotected); + return R_NilValue; } SEXP @@ -356,15 +354,12 @@ pareto_ranking_C(SEXP DATA) SEXP hypervolume_C(SEXP DATA, SEXP REFERENCE) { - int nprotected = 0; /* We transpose the matrix before calling this function. */ SEXP_2_DOUBLE_MATRIX(DATA, data, nobj, npoint); SEXP_2_DOUBLE_VECTOR(REFERENCE, reference, reference_len); assert (nobj == reference_len); - new_real_vector(hv, 1); - hv[0] = fpli_hv(data, nobj, npoint, reference); - UNPROTECT (nprotected); - return Rexp(hv); + double hv = fpli_hv(data, nobj, npoint, reference); + return Rf_ScalarReal(hv); } SEXP @@ -385,20 +380,16 @@ hv_contributions_C(SEXP DATA, SEXP REFERENCE) SEXP rect_weighted_hv2d_C(SEXP DATA, SEXP RECTANGLES) { - int nprotected = 0; /* We transpose the matrix before calling this function. */ SEXP_2_DOUBLE_MATRIX(DATA, data, nobj, npoint); SEXP_2_DOUBLE_MATRIX(RECTANGLES, rectangles, unused, rectangles_nrow); - new_real_vector(hv, 1); - hv[0] = rect_weighted_hv2d(data, npoint, rectangles, rectangles_nrow); - UNPROTECT (nprotected); - return Rexp(hv); + double hv = rect_weighted_hv2d(data, npoint, rectangles, rectangles_nrow); + return Rf_ScalarReal(hv); } SEXP preprocess_rectangles_C(SEXP RECTANGLES, SEXP REFERENCE) { - int nprotected = 0; /* We transpose the matrix before calling this function. */ SEXP_2_DOUBLE_MATRIX(RECTANGLES, rectangles, ncol, nrow); SEXP_2_DOUBLE_VECTOR(REFERENCE, reference, reference_len); @@ -411,7 +402,7 @@ preprocess_rectangles_C(SEXP RECTANGLES, SEXP REFERENCE) rectangles[k * ncol + 3] = MIN(rectangles[k * ncol + 3], reference[1]); } int skip_nrow = 0; - int * skip = (int *) malloc(nrow * sizeof(int)); + int * skip = (int *) R_alloc(nrow, sizeof(int)); for (int k = 0; k < nrow; k++) { bool empty = (rectangles[k * ncol + 0] == rectangles[k * ncol + 2] || rectangles[k * ncol + 1] == rectangles[k * ncol + 3]); @@ -420,8 +411,6 @@ preprocess_rectangles_C(SEXP RECTANGLES, SEXP REFERENCE) } if (skip_nrow == 0) { - free(skip); - UNPROTECT(nprotected); return RECTANGLES; } int new_nrow = nrow - skip_nrow; @@ -440,8 +429,7 @@ preprocess_rectangles_C(SEXP RECTANGLES, SEXP REFERENCE) k = skip[s] + 1; } } - free(skip); - UNPROTECT(nprotected + 1); + UNPROTECT(1); return R_dest; } @@ -450,7 +438,6 @@ preprocess_rectangles_C(SEXP RECTANGLES, SEXP REFERENCE) SEXP whv_hype_C(SEXP DATA, SEXP IDEAL, SEXP REFERENCE, SEXP NSAMPLES, SEXP DIST, SEXP SEED, SEXP MU) { - int nprotected = 0; SEXP_2_DOUBLE_MATRIX(DATA, data, nobj, npoints); SEXP_2_DOUBLE_VECTOR(IDEAL, ideal, ideal_len); SEXP_2_DOUBLE_VECTOR(REFERENCE, reference, reference_len); @@ -460,20 +447,19 @@ whv_hype_C(SEXP DATA, SEXP IDEAL, SEXP REFERENCE, SEXP NSAMPLES, SEXP DIST, SEXP SEXP_2_STRING(DIST, dist_type); SEXP_2_UINT32(SEED, seed); - new_real_vector(hv, 1); + double hv; if (0 == strcmp(dist_type, "uniform")) { - hv[0] = whv_hype_unif(data, npoints, ideal, reference, nsamples, seed); + hv = whv_hype_unif(data, npoints, ideal, reference, nsamples, seed); } else if (0 == strcmp(dist_type, "exponential")) { const double * mu = REAL(MU); - hv[0] = whv_hype_expo(data, npoints, ideal, reference, nsamples, seed, mu[0]); + hv = whv_hype_expo(data, npoints, ideal, reference, nsamples, seed, mu[0]); } else if (0 == strcmp(dist_type, "point")) { const double * mu = REAL(MU); - hv[0] = whv_hype_gaus(data, npoints, ideal, reference, nsamples, seed, mu); + hv = whv_hype_gaus(data, npoints, ideal, reference, nsamples, seed, mu); } else { Rf_error("unknown 'dist' value: %s", dist_type); } - UNPROTECT (nprotected); - return Rexp(hv); + return Rf_ScalarReal(hv); } #include "epsilon.h" @@ -492,7 +478,6 @@ static inline SEXP unary_metric_ref(SEXP DATA, SEXP REFERENCE, SEXP MAXIMISE, enum unary_metric_t metric, SEXP EXTRA) { - int nprotected = 0; /* We transpose the matrix before calling this function. */ SEXP_2_DOUBLE_MATRIX(DATA, data, nobj, npoint); double *ref = REAL(REFERENCE); @@ -501,23 +486,23 @@ unary_metric_ref(SEXP DATA, SEXP REFERENCE, SEXP MAXIMISE, SEXP_2_LOGICAL_BOOL_VECTOR(MAXIMISE, maximise, maximise_len); assert (nobj == maximise_len); - new_real_vector(value, 1); + double value; switch (metric) { case EPSILON_ADD: - value[0] = epsilon_additive (data, nobj, npoint, ref, ref_size, maximise); + value = epsilon_additive (data, nobj, npoint, ref, ref_size, maximise); break; case EPSILON_MUL: - value[0] = epsilon_mult (data, nobj, npoint, ref, ref_size, maximise); + value = epsilon_mult (data, nobj, npoint, ref, ref_size, maximise); break; case INV_GD: - value[0] = IGD (data, nobj, npoint, ref, ref_size, maximise); + value = IGD (data, nobj, npoint, ref, ref_size, maximise); break; case INV_GDPLUS: - value[0] = IGD_plus (data, nobj, npoint, ref, ref_size, maximise); + value = IGD_plus (data, nobj, npoint, ref, ref_size, maximise); break; case AVG_HAUSDORFF: { SEXP_2_INT(EXTRA, p); - value[0] = avg_Hausdorff_dist (data, nobj, npoint, ref, ref_size, maximise, p); + value = avg_Hausdorff_dist (data, nobj, npoint, ref, ref_size, maximise, p); break; } default: @@ -525,8 +510,7 @@ unary_metric_ref(SEXP DATA, SEXP REFERENCE, SEXP MAXIMISE, } free (maximise); - UNPROTECT (nprotected); - return Rexp(value); + return Rf_ScalarReal(value); } SEXP diff --git a/r/src/init.c b/r/src/init.c index 5987cff6..8cc352bb 100644 --- a/r/src/init.c +++ b/r/src/init.c @@ -7,13 +7,13 @@ #define VA_NARGS_IMPL(_1, _2, _3, _4, _5, _6, _7, _8, _9, _10, N, ...) N #define VA_NARGS(...) VA_NARGS_IMPL(__VA_ARGS__, 10, 9, 8, 7, 6, 5, 4, 3, 2, 1) -#define DECLARE_CALL(RET_TYPE, NAME, ...) \ - extern RET_TYPE NAME(__VA_ARGS__); +#define DECLARE_CALL(NAME, ...) \ + extern SEXP NAME(__VA_ARGS__); #include "init.h" #undef DECLARE_CALL -#define DECLARE_CALL(RET_TYPE, NAME, ...) \ +#define DECLARE_CALL(NAME, ...) \ {#NAME, (DL_FUNC) &NAME, VA_NARGS(__VA_ARGS__)}, static const R_CallMethodDef CallEntries[] = { diff --git a/r/src/init.h b/r/src/init.h index 0b479739..68db9c68 100644 --- a/r/src/init.h +++ b/r/src/init.h @@ -1,19 +1,19 @@ /* .Call calls */ -DECLARE_CALL(SEXP, compute_eaf_C, SEXP DATA, SEXP CUMSIZES, SEXP PERCENTILE) -DECLARE_CALL(SEXP, compute_eafdiff_C, SEXP DATA, SEXP CUMSIZES, SEXP INTERVALS) -DECLARE_CALL(SEXP, compute_eafdiff_polygon_C, SEXP DATA, SEXP CUMSIZES, SEXP INTERVALS) -DECLARE_CALL(SEXP, compute_eafdiff_rectangles_C, SEXP DATA, SEXP CUMSIZES, SEXP INTERVALS) -DECLARE_CALL(SEXP, R_read_datasets, SEXP FILENAME) -DECLARE_CALL(SEXP, hypervolume_C, SEXP DATA, SEXP REFERENCE) -DECLARE_CALL(SEXP, hv_contributions_C, SEXP DATA, SEXP REFERENCE) -DECLARE_CALL(void, normalise_C, SEXP DATA, SEXP RANGE, SEXP LBOUND, SEXP UBOUND, SEXP MAXIMISE) -DECLARE_CALL(SEXP, is_nondominated_C, SEXP DATA, SEXP MAXIMISE, SEXP KEEP_WEAKLY) -DECLARE_CALL(SEXP, pareto_ranking_C, SEXP DATA) -DECLARE_CALL(SEXP, epsilon_mul_C, SEXP DATA, SEXP REFERENCE, SEXP MAXIMISE) -DECLARE_CALL(SEXP, epsilon_add_C, SEXP DATA, SEXP REFERENCE, SEXP MAXIMISE) -DECLARE_CALL(SEXP, igd_C, SEXP DATA, SEXP REFERENCE, SEXP MAXIMISE) -DECLARE_CALL(SEXP, igd_plus_C, SEXP DATA, SEXP REFERENCE, SEXP MAXIMISE) -DECLARE_CALL(SEXP, avg_hausdorff_dist_C, SEXP DATA, SEXP REFERENCE, SEXP MAXIMISE, SEXP P) -DECLARE_CALL(SEXP, rect_weighted_hv2d_C, SEXP DATA, SEXP RECTANGLES) -DECLARE_CALL(SEXP, whv_hype_C, SEXP DATA, SEXP IDEAL, SEXP REFERENCE, SEXP NSAMPLES, SEXP DIST, SEXP SEED, SEXP MU) -DECLARE_CALL(SEXP, preprocess_rectangles_C, SEXP RECTANGLES, SEXP REFERENCE) +DECLARE_CALL(compute_eaf_C, SEXP DATA, SEXP CUMSIZES, SEXP PERCENTILE) +DECLARE_CALL(compute_eafdiff_C, SEXP DATA, SEXP CUMSIZES, SEXP INTERVALS) +DECLARE_CALL(compute_eafdiff_polygon_C, SEXP DATA, SEXP CUMSIZES, SEXP INTERVALS) +DECLARE_CALL(compute_eafdiff_rectangles_C, SEXP DATA, SEXP CUMSIZES, SEXP INTERVALS) +DECLARE_CALL(R_read_datasets, SEXP FILENAME) +DECLARE_CALL(hypervolume_C, SEXP DATA, SEXP REFERENCE) +DECLARE_CALL(hv_contributions_C, SEXP DATA, SEXP REFERENCE) +DECLARE_CALL(normalise_C, SEXP DATA, SEXP RANGE, SEXP LBOUND, SEXP UBOUND, SEXP MAXIMISE) +DECLARE_CALL(is_nondominated_C, SEXP DATA, SEXP MAXIMISE, SEXP KEEP_WEAKLY) +DECLARE_CALL(pareto_ranking_C, SEXP DATA) +DECLARE_CALL(epsilon_mul_C, SEXP DATA, SEXP REFERENCE, SEXP MAXIMISE) +DECLARE_CALL(epsilon_add_C, SEXP DATA, SEXP REFERENCE, SEXP MAXIMISE) +DECLARE_CALL(igd_C, SEXP DATA, SEXP REFERENCE, SEXP MAXIMISE) +DECLARE_CALL(igd_plus_C, SEXP DATA, SEXP REFERENCE, SEXP MAXIMISE) +DECLARE_CALL(avg_hausdorff_dist_C, SEXP DATA, SEXP REFERENCE, SEXP MAXIMISE, SEXP P) +DECLARE_CALL(rect_weighted_hv2d_C, SEXP DATA, SEXP RECTANGLES) +DECLARE_CALL(whv_hype_C, SEXP DATA, SEXP IDEAL, SEXP REFERENCE, SEXP NSAMPLES, SEXP DIST, SEXP SEED, SEXP MU) +DECLARE_CALL(preprocess_rectangles_C, SEXP RECTANGLES, SEXP REFERENCE)