Thanks to visit codestin.com
Credit goes to github.com

Skip to content

Call R functions inside cpp #145

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
chainsawriot merged 3 commits into from
Aug 19, 2023
Merged

Call R functions inside cpp #145

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
4854b88
Call R functions inside cpp
chainsawriot Aug 19, 2023
27a7fcf
Reduce sanitation
chainsawriot Aug 19, 2023
ef73548
escape `sheet` inside cpp
chainsawriot Aug 19, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 2 additions & 2 deletions R/cpp11.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -16,6 +16,6 @@ read_ods_ <- function(file, start_row, stop_row, start_col, stop_col, sheet, for
.Call(`_readODS_read_ods_`, file, start_row, stop_row, start_col, stop_col, sheet, formula_as_formula)
}

write_sheet_ <- function(filename, x_list, column_types, sheet, row_names, col_names, rownames_x, colnames_x, na_as_string, padding, header, footer) {
.Call(`_readODS_write_sheet_`, filename, x_list, column_types, sheet, row_names, col_names, rownames_x, colnames_x, na_as_string, padding, header, footer)
write_sheet_ <- function(filename, x, sheet, row_names, col_names, na_as_string, padding, header, footer) {
.Call(`_readODS_write_sheet_`, filename, x, sheet, row_names, col_names, na_as_string, padding, header, footer)
}
27 changes: 27 additions & 0 deletions R/utils.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,3 +5,30 @@ check_nonnegative_integer <- function(x, argument) {
return(x)
}

## To use inside cpp

.escape_xml <- function(x) {
stringi::stri_replace_all_fixed(str = stringi::stri_enc_toutf8(x), pattern = c("&", "\"", "<", ">", "'"), replacement = c("&amp;", "&quot;", "&lt;", "&gt;", "&apos;"), vectorize_all = FALSE)
}

## for single column, so `column_type`
.sanitize <- function(x, column_type) {
if (column_type == "string") {
return(.escape_xml(as.character(x)))
}
as.character(x)
}
.sanitize_df <- function(x, column_types) {
mapply(.sanitize, x = x, column_type = column_types, SIMPLIFY = FALSE)
}

.get_sanitized_dimnames <- function(x, cols = TRUE) {
if (cols) {
return(.escape_xml(colnames(x)))
}
return(.escape_xml(rownames(x)))
}

.get_column_types <- function(x) {
ifelse(unlist(lapply(x, function(x) class(x)[1])) %in% c("integer", "numeric"), "float", "string")
}
39 changes: 2 additions & 37 deletions R/write_ods.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -28,63 +28,28 @@
.silent_read_xml(sprintf('<table:table table:name="%s" table:style-name="ta1"><table:table-column table:style-name="co1" table:number-columns-repeated="16384" table:default-cell-style-name="ce1"/></table:table>', sheet))
}

.escape_xml <- function(x) {
stringi::stri_replace_all_fixed(str = stringi::stri_enc_toutf8(x), pattern = c("&", "\"", "<", ">", "'"), replacement = c("&amp;", "&quot;", "&lt;", "&gt;", "&apos;"), vectorize_all = FALSE)
}

## CREATION OF sysdata
## .CONTENT <- readLines("benchmark/header.xml")
## .FOOTER <- readLines("benchmark/footer.xml")
## usethis::use_data(.CONTENT, .FOOTER, internal = TRUE, overwrite = TRUE)

.flatten <- function(x, column_type) {
if (column_type == "string") {
return(.escape_xml(as.character(x)))
}
as.character(x)
}

.write_sheet_ <- function(x, filename, sheet = "Sheet1", row_names = FALSE, col_names = FALSE, na_as_string = FALSE, padding = FALSE, header = "", footer = "") {
column_types <- ifelse(unlist(lapply(x, function(x) class(x)[1])) %in% c("integer", "numeric"), "float", "string")
x_list <- mapply(.flatten, x = x, column_type = column_types, SIMPLIFY = FALSE)
if (row_names) {
rownames_x <- .escape_xml(rownames(x))
} else {
rownames_x <- c(NA_character_)
}
if (col_names) {
colnames_x <- .escape_xml(colnames(x))
} else {
colnames_x <- c(NA_character_)
}
write_sheet_(filename = filename, x_list = x_list,
column_types = column_types, sheet = .escape_xml(sheet),
row_names = row_names, col_names = col_names,
rownames_x = rownames_x, colnames_x = colnames_x,
na_as_string = na_as_string, padding = padding, header = header, footer = footer)
return(invisible(filename))
}


.convert_df_to_sheet <- function(x, sheet = "Sheet1", row_names = FALSE, col_names = FALSE, na_as_string = FALSE, padding = FALSE) {
throwaway_xml_file <- file.path(tempfile(fileext = ".xml"))
.write_sheet_(x = x, filename = throwaway_xml_file, sheet = sheet, row_names = row_names, col_names = col_names,
write_sheet_(x = x, filename = throwaway_xml_file, sheet = sheet, row_names = row_names, col_names = col_names,
na_as_string = na_as_string, padding = padding,
header = "",
footer = "")
return(throwaway_xml_file)
}

## https://github.com/ropensci/readODS/issues/88
.vfwrite_ods <- function(x, temp_ods_dir, sheet = "Sheet1", row_names = FALSE, col_names = TRUE, na_as_string = FALSE, padding = FALSE) {
templatedir <- system.file("template", package = "readODS")
file.copy(dir(templatedir, full.names = TRUE), temp_ods_dir, recursive = TRUE, copy.mode = FALSE)
filename <- file.path(temp_ods_dir, "content.xml")
.write_sheet_(x = x, filename = filename, sheet = sheet, row_names = row_names, col_names = col_names,
write_sheet_(x = x, filename = filename, sheet = sheet, row_names = row_names, col_names = col_names,
na_as_string = na_as_string, padding = padding,
header = paste0(.CONTENT[1], .CONTENT[2]),
footer = .FOOTER)
return(filename)
}

#' Write Data to ODS File
Expand Down
16 changes: 8 additions & 8 deletions src/cpp11.cpp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -34,20 +34,20 @@ extern "C" SEXP _readODS_read_ods_(SEXP file, SEXP start_row, SEXP stop_row, SEX
END_CPP11
}
// write_sheet_.cpp
cpp11::r_string write_sheet_(const std::string& filename, const cpp11::list_of<cpp11::strings>& x_list, const cpp11::strings& column_types, const std::string& sheet, const bool row_names, const bool col_names, const cpp11::strings& rownames_x, const cpp11::strings& colnames_x, const bool na_as_string, const bool padding, const std::string& header, const std::string& footer);
extern "C" SEXP _readODS_write_sheet_(SEXP filename, SEXP x_list, SEXP column_types, SEXP sheet, SEXP row_names, SEXP col_names, SEXP rownames_x, SEXP colnames_x, SEXP na_as_string, SEXP padding, SEXP header, SEXP footer) {
cpp11::r_string write_sheet_(const std::string& filename, const cpp11::data_frame& x, const std::string& sheet, const bool row_names, const bool col_names, const bool na_as_string, const bool padding, const std::string& header, const std::string& footer);
extern "C" SEXP _readODS_write_sheet_(SEXP filename, SEXP x, SEXP sheet, SEXP row_names, SEXP col_names, SEXP na_as_string, SEXP padding, SEXP header, SEXP footer) {
BEGIN_CPP11
return cpp11::as_sexp(write_sheet_(cpp11::as_cpp<cpp11::decay_t<const std::string&>>(filename), cpp11::as_cpp<cpp11::decay_t<const cpp11::list_of<cpp11::strings>&>>(x_list), cpp11::as_cpp<cpp11::decay_t<const cpp11::strings&>>(column_types), cpp11::as_cpp<cpp11::decay_t<const std::string&>>(sheet), cpp11::as_cpp<cpp11::decay_t<const bool>>(row_names), cpp11::as_cpp<cpp11::decay_t<const bool>>(col_names), cpp11::as_cpp<cpp11::decay_t<const cpp11::strings&>>(rownames_x), cpp11::as_cpp<cpp11::decay_t<const cpp11::strings&>>(colnames_x), cpp11::as_cpp<cpp11::decay_t<const bool>>(na_as_string), cpp11::as_cpp<cpp11::decay_t<const bool>>(padding), cpp11::as_cpp<cpp11::decay_t<const std::string&>>(header), cpp11::as_cpp<cpp11::decay_t<const std::string&>>(footer)));
return cpp11::as_sexp(write_sheet_(cpp11::as_cpp<cpp11::decay_t<const std::string&>>(filename), cpp11::as_cpp<cpp11::decay_t<const cpp11::data_frame&>>(x), cpp11::as_cpp<cpp11::decay_t<const std::string&>>(sheet), cpp11::as_cpp<cpp11::decay_t<const bool>>(row_names), cpp11::as_cpp<cpp11::decay_t<const bool>>(col_names), cpp11::as_cpp<cpp11::decay_t<const bool>>(na_as_string), cpp11::as_cpp<cpp11::decay_t<const bool>>(padding), cpp11::as_cpp<cpp11::decay_t<const std::string&>>(header), cpp11::as_cpp<cpp11::decay_t<const std::string&>>(footer)));
END_CPP11
}

extern "C" {
static const R_CallMethodDef CallEntries[] = {
{"_readODS_get_flat_sheet_names_", (DL_FUNC) &_readODS_get_flat_sheet_names_, 2},
{"_readODS_get_sheet_names_", (DL_FUNC) &_readODS_get_sheet_names_, 2},
{"_readODS_read_flat_ods_", (DL_FUNC) &_readODS_read_flat_ods_, 7},
{"_readODS_read_ods_", (DL_FUNC) &_readODS_read_ods_, 7},
{"_readODS_write_sheet_", (DL_FUNC) &_readODS_write_sheet_, 12},
{"_readODS_get_flat_sheet_names_", (DL_FUNC) &_readODS_get_flat_sheet_names_, 2},
{"_readODS_get_sheet_names_", (DL_FUNC) &_readODS_get_sheet_names_, 2},
{"_readODS_read_flat_ods_", (DL_FUNC) &_readODS_read_flat_ods_, 7},
{"_readODS_read_ods_", (DL_FUNC) &_readODS_read_ods_, 7},
{"_readODS_write_sheet_", (DL_FUNC) &_readODS_write_sheet_, 9},
{NULL, NULL, 0}
};
}
Expand Down
41 changes: 35 additions & 6 deletions src/write_sheet_.cpp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -28,28 +28,57 @@ void pad_rows_ (const bool& padding, const int& cols, const int& cmax, std::ofst
}
}

cpp11::strings dimnames_(const cpp11::data_frame& x, bool cols) {
// Is there a better way?
cpp11::function dimnames_rfun = cpp11::package("readODS")[".get_sanitized_dimnames"];
return cpp11::writable::strings(static_cast<SEXP>(dimnames_rfun(x, cols)));
}

cpp11::list_of<cpp11::strings> sanitize_(const cpp11::data_frame& x, const cpp11::strings column_types) {
cpp11::function sanitize_rfun = cpp11::package("readODS")[".sanitize_df"];
return cpp11::writable::list_of<cpp11::strings>(static_cast<SEXP>(sanitize_rfun(x, column_types)));
}

cpp11::strings get_column_types_(const cpp11::data_frame& x) {
cpp11::function get_column_types_rfun = cpp11::package("readODS")[".get_column_types"];
return cpp11::writable::strings(static_cast<SEXP>(get_column_types_rfun(x)));
}

std::string escape_xml_(const std::string& input) {
cpp11::sexp input_sexp = cpp11::as_sexp(input);
cpp11::function escape_xml_rfun = cpp11::package("readODS")[".escape_xml"];
return cpp11::as_cpp<std::string>(escape_xml_rfun(input_sexp));
}

[[cpp11::register]]
cpp11::r_string write_sheet_(const std::string& filename,
const cpp11::list_of<cpp11::strings>& x_list,
const cpp11::strings& column_types,
const cpp11::data_frame& x,
const std::string& sheet,
const bool row_names,
const bool col_names,
const cpp11::strings& rownames_x,
const cpp11::strings& colnames_x,
const bool na_as_string,
const bool padding,
const std::string& header,
const std::string& footer) {
// TODO: if x.nrow() == 0; just write empty xml
cpp11::strings rownames_x, colnames_x;
cpp11::strings column_types = get_column_types_(x);
cpp11::list_of<cpp11::strings> x_list = sanitize_(x, column_types);
if (row_names) {
rownames_x = dimnames_(x, false);
}
if (col_names) {
colnames_x = dimnames_(x, true);
}
int rows = col_names ? x_list[0].size() + 1 : x_list[0].size();
int cols = row_names ? column_types.size() + 1 : column_types.size();
int cmax = column_types.size() > 1024 ? 16384 : 1024;
// please escape all strings first!
std::ofstream xml_file(filename);
// gen_sheet_tag
xml_file << header;
xml_file << "<table:table table:name=\"";
xml_file << sheet;
std::string escaped_sheet = escape_xml_(sheet);
xml_file << escaped_sheet;
xml_file << "\" table:style-name=\"ta1\"><table:table-column table:style-name=\"co1\" table:number-columns-repeated=\"";
padding ? xml_file << cmax : xml_file << cols;
xml_file << "\" table:default-cell-style-name=\"ce1\"/>";
Expand Down
19 changes: 8 additions & 11 deletions src/write_sheet_.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -9,14 +9,11 @@
#include <iostream>

cpp11::r_string write_sheet_(const std::string& filename,
const cpp11::list_of<cpp11::strings>& x_list,
const cpp11::strings& column_types,
const std::string& sheet,
const bool row_names,
const bool col_names,
const cpp11::strings& rownames_x,
const cpp11::strings& colnames_x,
const bool na_as_string,
const bool padding,
const std::string& header,
const std::string& footer);
const cpp11::data_frame& x,
const std::string& sheet,
const bool row_names,
const bool col_names,
const bool na_as_string,
const bool padding,
const std::string& header,
const std::string& footer);
15 changes: 12 additions & 3 deletions tests/testthat/test_write_sheet.R
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,5 +1,14 @@
## These can't be tested with write_ods and then read_ods

## keep here for the defaults
.write_sheet_ <- function(x, filename, sheet = "Sheet1", row_names = FALSE, col_names = FALSE, na_as_string = FALSE, padding = FALSE, header = "", footer = "") {
write_sheet_(filename = filename, x = x,
sheet = sheet,
row_names = row_names, col_names = col_names,
na_as_string = na_as_string, padding = padding, header = header, footer = footer)
return(invisible(filename))
}

test_that("padding TRUE, ncol <= 1024", {
throwaway_xml_file <- tempfile(fileext = ".xml")
test_data <- data.frame(x = c(1.1, 2.2, 3.3), y = c("a", "b", "c"))
Expand All @@ -9,7 +18,7 @@ test_that("padding TRUE, ncol <= 1024", {
## 1024 - ncol(test_data)
expect_true(grepl("table:number-columns-repeated=\"1022\"", content))
## 2^20 - 3
expect_true(grepl("table:number-rows-repeated=\"1048573\"", content))
expect_true(grepl("table:number-rows-repeated=\"1048573\"", content))
})

test_that("padding FALSE, ncol <= 1024", {
Expand All @@ -21,7 +30,7 @@ test_that("padding FALSE, ncol <= 1024", {
## 1024 - ncol(test_data)
expect_false(grepl("table:number-columns-repeated=\"1022\"", content))
## 2^20 - 3
expect_false(grepl("table:number-rows-repeated=\"1048573\"", content))
expect_false(grepl("table:number-rows-repeated=\"1048573\"", content))
})

## padding > 1024 cols
Expand All @@ -32,7 +41,7 @@ test_that("padding TRUE, ncol > 1024", {
.write_sheet_(test_data, throwaway_xml_file, padding = TRUE)
content <- readLines(throwaway_xml_file, warn = FALSE)
expect_true(grepl("table:number-columns-repeated=\"16384\"", content))
## 16384 - ncol(test_data)
## 16384 - ncol(test_data)
expect_true(grepl("table:number-columns-repeated=\"15359\"", content))
## 2^20 - 1
expect_true(grepl("table:number-rows-repeated=\"1048575\"", content))
Expand Down