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

Skip to content

fix #113 #140

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 6 commits into from
Aug 18, 2023
Merged

fix #113 #140

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
be89053
fix #113
chainsawriot Aug 18, 2023
7fc7120
Implement `na_as_string`
chainsawriot Aug 18, 2023
72d4f77
Consistent file naming
chainsawriot Aug 18, 2023
2c464e1
Bump ver
chainsawriot Aug 18, 2023
3e546b5
Calculate `cmax` in cpp; remove commented out code
chainsawriot Aug 18, 2023
1069546
Header file [no ci]
chainsawriot Aug 18, 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
2 changes: 1 addition & 1 deletion DESCRIPTION
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
Package: readODS
Type: Package
Title: Read and Write ODS Files
Version: 2.0.1
Version: 2.0.2
Authors@R:
c(person("Gerrit-Jan", "Schutten", role = c("aut"), email = "[email protected]"),
person("Chung-hong", "Chan", role = c("aut", "cre"), email = "[email protected]", comment = c(ORCID = "0000-0002-6232-7530")),
Expand Down
4 changes: 4 additions & 0 deletions R/cpp11.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -15,3 +15,7 @@ read_flat_ods_ <- function(file, start_row, stop_row, start_col, stop_col, sheet
read_ods_ <- function(file, start_row, stop_row, start_col, stop_col, sheet, formula_as_formula) {
.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)
}
115 changes: 25 additions & 90 deletions R/writeODS.R → R/write_ods.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -7,10 +7,6 @@
file.copy(file.path(temp_ods_dir, basename(path)), path, overwrite = overwrite)
}

.write_as_utf8 <- function(text, con) {
writeLines(enc2utf8(text), con = con, sep = "", useBytes = TRUE)
}

.find_sheet_node_by_sheet <- function(spreadsheet_node, sheet) {
sheet_node <- NULL
for (i in seq(2, length(xml2::xml_children(spreadsheet_node)))) {
Expand All @@ -36,120 +32,59 @@
stringi::stri_replace_all_fixed(str = stringi::stri_enc_toutf8(x), pattern = c("&", "\"", "<", ">", "'"), replacement = c("&amp;", "&quot;", "&lt;", "&gt;", "&apos;"), vectorize_all = FALSE)
}

.cell_out <- function(type, value, con) {
.write_as_utf8(stringi::stri_join("<table:table-cell office:value-type=\"", type, sep = ""), con)
if (type != "string") {
.write_as_utf8(stringi::stri_join("\" office:value=\"", value, sep = ""), con)
}
.write_as_utf8(stringi::stri_join("\" table:style-name=\"ce1\"><text:p>", value,
"</text:p></table:table-cell>",
sep = ""), con)
}

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

.gen_sheet_tag <- function(sheet = "Sheet1", cols = 1024) {
sprintf('<table:table table:name="%s" table:style-name="ta1"><table:table-column table:style-name="co1" table:number-columns-repeated="%d" table:default-cell-style-name="ce1"/>', .escape_xml(sheet), cols)
}

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

.write_sheet_con <- function(x, con, sheet = "Sheet1", row_names = FALSE, col_names = FALSE, na_as_string = FALSE, padding = FALSE) {
cmax <- force(if(ncol(x) > 1024) { 16384 } else { 1024 })
types <- unlist(lapply(x, function(x) class(x)[1]))
types <- ifelse(types %in% c("integer", "numeric"), "float", "string")
colj <- seq_len(NCOL(x))
cols <- ncol(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))
cols <- cols + 1
} else {
rownames_x <- c(NA_character_)
}
rows <- nrow(x)
if (col_names) {
colnames_x <- .escape_xml(colnames(x))
rows <- rows + 1
}
if (padding) {
.write_as_utf8(.gen_sheet_tag(sheet = sheet, cols = cmax), con)
} else {
.write_as_utf8(.gen_sheet_tag(sheet = sheet, cols = cols), con)
}
# add data
if (col_names) {
.write_as_utf8("<table:table-row table:style-name=\"ro1\">", con)
if (row_names) {
.cell_out("string", value = "", con = con)
}
for (j in colj) {
.cell_out(type = "string", value = colnames_x[j], con = con)
}
if (cols < cmax && padding) {
.write_as_utf8(stringi::stri_join("<table:table-cell table:number-columns-repeated=\"", as.character(cmax - cols), "\"/>", sep = ""), con)
}
.write_as_utf8("</table:table-row>", con)
}
x_list <- mapply(.flatten, x = x, column_type = types, SIMPLIFY = FALSE)
for (i in seq_len(NROW(x))) {
## create a row
.write_as_utf8("<table:table-row table:style-name=\"ro1\">", con)
if (row_names) {
.cell_out(type = "string", value = rownames_x[i], con = con)
}
for (j in colj) {
value <- x_list[[j, drop = TRUE]][i, drop = TRUE]
type <- types[j]
if (!is.na(value)) {
.cell_out(type = type, value = value, con = con)
next
}
## NA processing from now
if (!na_as_string) {
.write_as_utf8("<table:table-cell/>", con)
next
}
.cell_out(type = "string", value = "NA", con = con)
## end
}
if (cols < cmax && padding) {
.write_as_utf8(stringi::stri_join("<table:table-cell table:number-columns-repeated=\"", as.character(cmax - cols), "\"/>", sep = ""), con)
}
.write_as_utf8("</table:table-row>", con)
colnames_x <- c(NA_character_)
}
if (rows < 2^20 && padding) {
.write_as_utf8(stringi::stri_join("<table:table-row table:style-name=\"ro1\" table:number-rows-repeated=\"", 2^20 - rows, "\"><table:table-cell table:number-columns-repeated=\"", cmax, "\"/></table:table-row>", sep = ""), con)
}
.write_as_utf8("</table:table>", con)
return(invisible(con))
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 <- tempfile(fileext = ".xml")
con <- file(file.path(throwaway_xml_file), open="w+", encoding = "native.enc")
.write_sheet_con(x = x, con = con, sheet = sheet, row_names = row_names, col_names = col_names,
na_as_string = na_as_string, padding = padding)
close(con)
return(file.path(throwaway_xml_file))
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,
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)
con <- file(file.path(temp_ods_dir, "content.xml"), open="w+", encoding = "native.enc")
.write_as_utf8(.CONTENT[1], con)
.write_as_utf8(.CONTENT[2], con)
.write_sheet_con(x = x, con = con, sheet = sheet, row_names = row_names, col_names = col_names,
na_as_string = na_as_string, padding = padding)
.write_as_utf8(.FOOTER, con)
close(con)
filename <- file.path(temp_ods_dir, "content.xml")
.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
73 changes: 15 additions & 58 deletions benchmark/issue81_template.md
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,10 +1,10 @@
# Testing the speed of write_ods
# Testing the speed of reading the ODS file `issue81.ods`

``` r
date()
```

[1] "Sat Jul 22 17:56:29 2023"
[1] "Sat Aug 19 00:00:22 2023"

``` r
devtools::load_all()
Expand All @@ -18,7 +18,7 @@ system.time(x <- read_ods(file, sheet = 2, skip = 4))
```

user system elapsed
0.404 0.044 0.448
0.435 0.024 0.459

``` r
dim(x)
Expand All @@ -32,7 +32,7 @@ sessionInfo()

R version 4.3.1 (2023-06-16)
Platform: x86_64-pc-linux-gnu (64-bit)
Running under: Ubuntu 22.04.2 LTS
Running under: Ubuntu 22.04.3 LTS

Matrix products: default
BLAS: /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.10.0
Expand All @@ -53,65 +53,22 @@ sessionInfo()
[1] stats graphics grDevices utils datasets methods base

other attached packages:
[1] readODS_1.9.0 testthat_3.1.10
[1] readODS_2.0.1 testthat_3.1.10

loaded via a namespace (and not attached):
[1] utf8_1.2.3 xml2_1.3.5 stringi_1.7.12 hms_1.1.3
[5] digest_0.6.33 magrittr_2.0.3 evaluate_0.21 pkgload_1.3.2
[5] digest_0.6.33 magrittr_2.0.3 evaluate_0.21 pkgload_1.3.2.1
[9] fastmap_1.1.1 cellranger_1.1.0 rprojroot_2.0.3 jsonlite_1.8.7
[13] zip_2.2.2 processx_3.8.2 pkgbuild_1.4.0 sessioninfo_1.2.2
[17] brio_1.1.3 urlchecker_1.0.1 ps_1.7.5 promises_1.2.0.1
[21] fansi_1.0.4 purrr_1.0.1 cli_3.6.1 shiny_1.7.4
[25] rlang_1.1.1 crayon_1.5.2 ellipsis_0.3.2 remotes_2.4.2
[13] zip_2.3.0 processx_3.8.2 pkgbuild_1.4.2 sessioninfo_1.2.2
[17] brio_1.1.3 urlchecker_1.0.1 ps_1.7.5 promises_1.2.1
[21] purrr_1.0.2 fansi_1.0.4 cli_3.6.1 shiny_1.7.5
[25] rlang_1.1.1 crayon_1.5.2 ellipsis_0.3.2 remotes_2.4.2.1
[29] withr_2.5.0 cachem_1.0.8 yaml_2.3.7 devtools_2.4.5
[33] tools_4.3.1 tzdb_0.4.0 memoise_2.0.1 httpuv_1.6.11
[37] here_1.0.1 vctrs_0.6.3 R6_2.5.1 mime_0.12
[41] lifecycle_1.0.3 stringr_1.5.0 fs_1.6.2 htmlwidgets_1.6.2
[45] usethis_2.1.6 miniUI_0.1.1.1 pkgconfig_2.0.3 desc_1.4.2
[41] lifecycle_1.0.3 stringr_1.5.0 fs_1.6.3 htmlwidgets_1.6.2
[45] usethis_2.2.2 miniUI_0.1.1.1 pkgconfig_2.0.3 desc_1.4.2
[49] callr_3.7.3 pillar_1.9.0 later_1.3.1 glue_1.6.2
[53] profvis_0.3.7 Rcpp_1.0.11 xfun_0.39 tibble_3.2.1
[57] rstudioapi_0.14 knitr_1.43 xtable_1.8-4 htmltools_0.5.5
[61] rmarkdown_2.22 readr_2.1.4 compiler_4.3.1 prettyunits_1.1.1

``` {r}
date()
devtools::load_all()
## generate a 3000 x 8 data.frame
set.seed(721831)
df1 <- data.frame(a1 = sample(c(1:100), size = 3000, replace = TRUE),
b1 = sample(c(3.14, 3.1416, 12.345, 721.831), size = 3000, replace = TRUE),
c1 = sample(LETTERS, size = 3000, replace = TRUE),
d1 = sample(c(1L:100L), size = 3000, replace = TRUE),
a2 = sample(c(1:100), size = 3000, replace = TRUE),
b2 = sample(c(3.14, 3.1416, 12.345, 99.831), size = 3000, replace = TRUE),
c2 = sample(LETTERS, size = 3000, replace = TRUE),
d2 = sample(c(1L:100L), size = 3000, replace = TRUE))
path <- tempfile(fileext = ".ods")
write_ods(df1, path = path)
system.time(write_ods(df1, path = path, sheet = "aaaa", append = TRUE))
system.time(write_ods(df1, path = path, sheet = "aaaa", update = TRUE))
```

``` {r}
sessionInfo()
```

``` {r}
date()
devtools::load_all()
## generate a 3000 x 8 data.frame
set.seed(721831)
df1 <- data.frame(a1 = sample(c(1:100), size = 3000, replace = TRUE),
b1 = sample(c(3.14, 3.1416, 12.345, 721.831), size = 3000, replace = TRUE),
c1 = sample(LETTERS, size = 3000, replace = TRUE),
d1 = sample(c(1L:100L), size = 3000, replace = TRUE),
a2 = sample(c(1:100), size = 3000, replace = TRUE),
b2 = sample(c(3.14, 3.1416, 12.345, 99.831), size = 3000, replace = TRUE),
c2 = sample(LETTERS, size = 3000, replace = TRUE),
d2 = sample(c(1L:100L), size = 3000, replace = TRUE))
system.time(write_ods(df1, path = tempfile(fileext = ".ods")))
```

``` {r}
sessionInfo()
```
[53] profvis_0.3.8 Rcpp_1.0.11 xfun_0.40 tibble_3.2.1
[57] rstudioapi_0.15.0 knitr_1.43 xtable_1.8-4 htmltools_0.5.6
[61] rmarkdown_2.24 readr_2.1.4 compiler_4.3.1 prettyunits_1.1.1
32 changes: 16 additions & 16 deletions benchmark/roundtrip.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -15,22 +15,22 @@ Let’s break it down
date()
```

[1] "Wed Aug 9 23:38:22 2023"
[1] "Fri Aug 18 23:59:27 2023"

``` r
library(nycflights13)
system.time(path <- writexl::write_xlsx(flights))
```

user system elapsed
5.949 0.304 6.262
6.201 0.291 6.494

``` r
system.time(out <- readxl::read_xlsx(path))
```

user system elapsed
2.188 0.640 2.837
2.205 0.603 2.809

``` r
all.equal(out, flights)
Expand All @@ -51,14 +51,14 @@ system.time(path <- readODS::write_ods(flights))
```

user system elapsed
94.480 0.452 95.059
13.211 0.460 13.898

``` r
system.time(out <- readODS::read_ods(path))
```

user system elapsed
26.438 1.660 28.104
27.572 1.508 29.081

``` r
all.equal(out, flights)
Expand Down Expand Up @@ -94,23 +94,23 @@ sessionInfo()
[1] stats graphics grDevices utils datasets methods base

other attached packages:
[1] readODS_2.0.0 testthat_3.1.10 nycflights13_1.0.2
[1] readODS_2.0.1 testthat_3.1.10 nycflights13_1.0.2

loaded via a namespace (and not attached):
[1] utf8_1.2.3 xml2_1.3.5 stringi_1.7.12 hms_1.1.3
[5] digest_0.6.33 magrittr_2.0.3 evaluate_0.21 pkgload_1.3.2
[5] digest_0.6.33 magrittr_2.0.3 evaluate_0.21 pkgload_1.3.2.1
[9] fastmap_1.1.1 rprojroot_2.0.3 cellranger_1.1.0 jsonlite_1.8.7
[13] zip_2.3.0 writexl_1.4.2 processx_3.8.2 pkgbuild_1.4.2
[17] sessioninfo_1.2.2 brio_1.1.3 urlchecker_1.0.1 ps_1.7.5
[21] promises_1.2.0.1 purrr_1.0.1 fansi_1.0.4 cli_3.6.1
[25] shiny_1.7.4 rlang_1.1.1 crayon_1.5.2 ellipsis_0.3.2
[13] zip_2.3.0 writexl_1.4.2 processx_3.8.2 sessioninfo_1.2.2
[17] pkgbuild_1.4.2 brio_1.1.3 urlchecker_1.0.1 ps_1.7.5
[21] promises_1.2.1 purrr_1.0.2 fansi_1.0.4 cli_3.6.1
[25] shiny_1.7.5 rlang_1.1.1 crayon_1.5.2 ellipsis_0.3.2
[29] withr_2.5.0 remotes_2.4.2.1 cachem_1.0.8 yaml_2.3.7
[33] devtools_2.4.5 tools_4.3.1 tzdb_0.4.0 memoise_2.0.1
[37] httpuv_1.6.11 vctrs_0.6.3 R6_2.5.1 mime_0.12
[41] lifecycle_1.0.3 stringr_1.5.0 fs_1.6.3 htmlwidgets_1.6.2
[45] usethis_2.1.6 miniUI_0.1.1.1 desc_1.4.2 pkgconfig_2.0.3
[45] usethis_2.2.2 miniUI_0.1.1.1 desc_1.4.2 pkgconfig_2.0.3
[49] callr_3.7.3 pillar_1.9.0 later_1.3.1 glue_1.6.2
[53] profvis_0.3.7 Rcpp_1.0.11 xfun_0.39 tibble_3.2.1
[57] rstudioapi_0.14 knitr_1.43 xtable_1.8-4 htmltools_0.5.5
[61] rmarkdown_2.22 readr_2.1.4 compiler_4.3.1 prettyunits_1.1.1
[65] readxl_1.4.2
[53] profvis_0.3.8 Rcpp_1.0.11 xfun_0.40 tibble_3.2.1
[57] rstudioapi_0.15.0 knitr_1.43 xtable_1.8-4 htmltools_0.5.6
[61] rmarkdown_2.24 readr_2.1.4 compiler_4.3.1 prettyunits_1.1.1
[65] readxl_1.4.3
Loading