From 31d7b11516f0391ad4f5f70155a5b87cc62225c1 Mon Sep 17 00:00:00 2001 From: ycphs Date: Tue, 24 Aug 2021 11:48:30 +0200 Subject: [PATCH 1/5] updates of urls for new release --- NEWS.md | 8 +- R/writeData.R | 2 +- man/writeData.Rd | 2 +- vignettes/Introduction.R | 4 +- vignettes/Introduction.Rmd | 4 +- vignettes/Introduction.html | 978 +++++++++++++++--------------------- 6 files changed, 411 insertions(+), 587 deletions(-) diff --git a/NEWS.md b/NEWS.md index f87427e6..263837a5 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# openxlsx (development version) +# openxlsx 4.2.5 ## Fixes @@ -6,8 +6,8 @@ * `loadWorkbook()` imports `inlineStr`. Values remain `inlineStr` when writing the workbook with `saveWorkbook()`. Similar `read.xlsx` and `readWorkbook` import `inlineStr`. * `read.xlsx()` no longer changes random seed ([#183](https://github.com/ycphs/openxlsx/issues/183)) * fixed a regression that caused fonts to be read in incorrectly ([#207](https://github.com/ycphs/openxlsx/issues/207)) -* add option to save as read only recommended ([#201](https://github.com/ychps/openxlsx/issues/201)) -* fixed writing hyperlink formulas ([#200](https://github.com/ychps/openxlsx/issues/200)) +* add option to save as read only recommended ([#201](https://github.com/ycphs/openxlsx/issues/201)) +* fixed writing hyperlink formulas ([#212](https://github.com/ycphs/openxlsx/issues/212)) * `write.xlsx()` now throws an error if it doesn't have write permissions ([#190](https://github.com/ycphs/openxlsx/issues/190)) * `write.xlsx()` now again uses the default of `overwrite = TRUE` for saving files ([#249](https://github.com/ycphs/openxlsx/issues/249)) * `Workbook$show()` no longer fails when called in a 0 sheet workbook([#240](https://github.com/ychps/openxlsx/issues/240)) @@ -85,7 +85,7 @@ ## Bug Fixes -* Solved CRAN check errors based on the change discussed in [PR#17277](https://bugs.r-project.org/bugzilla3/show_bug.cgi?id=17277) +* Solved CRAN check errors based on the change discussed in [PR#17277](https://bugs.r-project.org/show_bug.cgi?id=17277) # openxlsx 4.2.0 diff --git a/R/writeData.R b/R/writeData.R index e5262dd1..9f749497 100644 --- a/R/writeData.R +++ b/R/writeData.R @@ -22,7 +22,7 @@ #' a surrounding border is drawn with a border around each row. If #' "`columns`", a surrounding border is drawn with a border between #' each column. If "`all`" all cell borders are drawn. -#' @param borderColour Colour of cell border. A valid colour (belonging to `colours()` or a hex colour code, eg see [here](https://www.webfx.com/web-design/color-picker/)). +#' @param borderColour Colour of cell border. A valid colour (belonging to `colours()` or a hex colour code, eg see [here](https://www.w3schools.com/web-design/color-picker/)). #' @param borderStyle Border line style #' \itemize{ #' \item{**none**}{ no border} diff --git a/man/writeData.Rd b/man/writeData.Rd index 0de7130d..96bb0165 100644 --- a/man/writeData.Rd +++ b/man/writeData.Rd @@ -57,7 +57,7 @@ a surrounding border is drawn with a border around each row. If "\code{columns}", a surrounding border is drawn with a border between each column. If "\code{all}" all cell borders are drawn.} -\item{borderColour}{Colour of cell border. A valid colour (belonging to \code{colours()} or a hex colour code, eg see \href{https://www.webfx.com/web-design/color-picker/}{here}).} +\item{borderColour}{Colour of cell border. A valid colour (belonging to \code{colours()} or a hex colour code, eg see \href{https://www.w3schools.com/colors/colors_picker.asp}{here}).} \item{borderStyle}{Border line style \itemize{ diff --git a/vignettes/Introduction.R b/vignettes/Introduction.R index d9945e45..51cadad2 100644 --- a/vignettes/Introduction.R +++ b/vignettes/Introduction.R @@ -242,8 +242,8 @@ # # ## read historical prices from yahoo finance # ticker <- "CBA.AX" -# csv.url <- paste("http://ichart.finance.yahoo.com/table.csv?s=", -# ticker, "&a=01&b=9&c=2009&d=01&e=9&f=2014&g=d&ignore=.csv") +# csv.url <- paste0("https://query1.finance.yahoo.com/v7/finance/download/", +# ticker, "?period1=1597597610&period2=1629133610&interval=1d&events=history&includeAdjustedClose=true") # prices <- read.csv(url(csv.url), as.is = TRUE) # prices$Date <- as.Date(prices$Date) # close <- prices$Close diff --git a/vignettes/Introduction.Rmd b/vignettes/Introduction.Rmd index d322b1b8..fa0b6d7b 100644 --- a/vignettes/Introduction.Rmd +++ b/vignettes/Introduction.Rmd @@ -325,8 +325,8 @@ wb <- createWorkbook() ## read historical prices from yahoo finance ticker <- "CBA.AX" -csv.url <- paste("http://ichart.finance.yahoo.com/table.csv?s=", -ticker, "&a=01&b=9&c=2009&d=01&e=9&f=2014&g=d&ignore=.csv") +csv.url <- paste0("https://query1.finance.yahoo.com/v7/finance/download/", +ticker, "?period1=1597597610&period2=1629133610&interval=1d&events=history&includeAdjustedClose=true") prices <- read.csv(url(csv.url), as.is = TRUE) prices$Date <- as.Date(prices$Date) close <- prices$Close diff --git a/vignettes/Introduction.html b/vignettes/Introduction.html index d29873bb..110ac45a 100644 --- a/vignettes/Introduction.html +++ b/vignettes/Introduction.html @@ -12,43 +12,44 @@ - + Introduction - + + - + + + + @@ -319,7 +141,7 @@

Introduction

Alexander Walker, Philipp Schauberger

-

2020-08-14

+

2021-08-16

@@ -328,41 +150,41 @@

Basic Examples

write.xlsx

The simplest way to write to a workbook is write.xlsx(). By default, write.xlsx calls writeData. If asTable is TRUE write.xlsx will write x as an Excel table.

-
## write to working directory
-library(openxlsx)
-write.xlsx(iris, file = "writeXLSX1.xlsx")
-write.xlsx(iris, file = "writeXLSXTable1.xlsx", asTable = TRUE)
+
## write to working directory
+library(openxlsx)
+write.xlsx(iris, file = "writeXLSX1.xlsx")
+write.xlsx(iris, file = "writeXLSXTable1.xlsx", asTable = TRUE)

write list of data.frames to xlsx-file

-
## write a list of data.frames to individual worksheets using list names as
-## worksheet names
-l <- list(IRIS = iris, MTCARS = mtcars)
-write.xlsx(l, file = "writeXLSX2.xlsx")
-write.xlsx(l, file = "writeXLSXTable2.xlsx", asTable = TRUE)
+
## write a list of data.frames to individual worksheets using list names as
+## worksheet names
+l <- list(IRIS = iris, MTCARS = mtcars)
+write.xlsx(l, file = "writeXLSX2.xlsx")
+write.xlsx(l, file = "writeXLSXTable2.xlsx", asTable = TRUE)

write.xlsx also accepts styling parameters

The simplest way is to set default options and set column class

-
options(openxlsx.borderColour = "#4F80BD")
-options(openxlsx.borderStyle = "thin")
-options(openxlsx.dateFormat = "mm/dd/yyyy")
-options(openxlsx.datetimeFormat = "yyyy-mm-dd hh:mm:ss")
-options(openxlsx.numFmt = NULL)  ## For default style rounding of numeric columns
-
-df <- data.frame(Date = Sys.Date() - 0:19, LogicalT = TRUE, Time = Sys.time() - 0:19 * 
-    60 * 60, Cash = paste("$", 1:20), Cash2 = 31:50, hLink = "https://CRAN.R-project.org/", 
-    Percentage = seq(0, 1, length.out = 20), TinyNumbers = runif(20)/1e+09, stringsAsFactors = FALSE)
-
-class(df$Cash) <- "currency"
-class(df$Cash2) <- "accounting"
-class(df$hLink) <- "hyperlink"
-class(df$Percentage) <- "percentage"
-class(df$TinyNumbers) <- "scientific"
-
-write.xlsx(df, "writeXLSX3.xlsx")
-write.xlsx(df, file = "writeXLSXTable3.xlsx", asTable = TRUE)
+
options(openxlsx.borderColour = "#4F80BD")
+options(openxlsx.borderStyle = "thin")
+options(openxlsx.dateFormat = "mm/dd/yyyy")
+options(openxlsx.datetimeFormat = "yyyy-mm-dd hh:mm:ss")
+options(openxlsx.numFmt = NULL)  ## For default style rounding of numeric columns
+
+df <- data.frame(Date = Sys.Date() - 0:19, LogicalT = TRUE, Time = Sys.time() - 0:19 *
+    60 * 60, Cash = paste("$", 1:20), Cash2 = 31:50, hLink = "https://CRAN.R-project.org/",
+    Percentage = seq(0, 1, length.out = 20), TinyNumbers = runif(20)/1e+09, stringsAsFactors = FALSE)
+
+class(df$Cash) <- "currency"
+class(df$Cash2) <- "accounting"
+class(df$hLink) <- "hyperlink"
+class(df$Percentage) <- "percentage"
+class(df$TinyNumbers) <- "scientific"
+
+write.xlsx(df, "writeXLSX3.xlsx")
+write.xlsx(df, file = "writeXLSXTable3.xlsx", asTable = TRUE)
@@ -370,395 +192,397 @@

The simplest way is to set default options and set column class

Workbook styles

define a style for column headers

-
hs <- createStyle(fontColour = "#ffffff", fgFill = "#4F80BD", halign = "center", 
-    valign = "center", textDecoration = "Bold", border = "TopBottomLeftRight", textRotation = 45)
-
-write.xlsx(iris, file = "writeXLSX4.xlsx", borders = "rows", headerStyle = hs)
-write.xlsx(iris, file = "writeXLSX5.xlsx", borders = "columns", headerStyle = hs)
-
-write.xlsx(iris, "writeXLSXTable4.xlsx", asTable = TRUE, headerStyle = createStyle(textRotation = 45))
+
hs <- createStyle(fontColour = "#ffffff", fgFill = "#4F80BD", halign = "center",
+    valign = "center", textDecoration = "Bold", border = "TopBottomLeftRight", textRotation = 45)
+
+write.xlsx(iris, file = "writeXLSX4.xlsx", borders = "rows", headerStyle = hs)
+write.xlsx(iris, file = "writeXLSX5.xlsx", borders = "columns", headerStyle = hs)
+
+write.xlsx(iris, "writeXLSXTable4.xlsx", asTable = TRUE, headerStyle = createStyle(textRotation = 45))

When writing a list, the stylings will apply to all list elements

-
l <- list(IRIS = iris, colClasses = df)
-write.xlsx(l, file = "writeXLSX6.xlsx", borders = "columns", headerStyle = hs)
-write.xlsx(l, file = "writeXLSXTable5.xlsx", asTable = TRUE, tableStyle = "TableStyleLight2")
-
-openXL("writeXLSX6.xlsx")
-openXL("writeXLSXTable5.xlsx")
+
l <- list(IRIS = iris, colClasses = df)
+write.xlsx(l, file = "writeXLSX6.xlsx", borders = "columns", headerStyle = hs)
+write.xlsx(l, file = "writeXLSXTable5.xlsx", asTable = TRUE, tableStyle = "TableStyleLight2")
+
+openXL("writeXLSX6.xlsx")
+openXL("writeXLSXTable5.xlsx")

write.xlsx returns the workbook object for further editing

-
wb <- write.xlsx(iris, "writeXLSX6.xlsx")
-setColWidths(wb, sheet = 1, cols = 1:5, widths = 20)
-saveWorkbook(wb, "writeXLSX6.xlsx", overwrite = TRUE)
+
wb <- write.xlsx(iris, "writeXLSX6.xlsx")
+setColWidths(wb, sheet = 1, cols = 1:5, widths = 20)
+saveWorkbook(wb, "writeXLSX6.xlsx", overwrite = TRUE)

Workbook creation walk-through

create workbook and set default border Colour and style

-
require(ggplot2)
-wb <- createWorkbook()
-options(openxlsx.borderColour = "#4F80BD")
-options(openxlsx.borderStyle = "thin")
-modifyBaseFont(wb, fontSize = 10, fontName = "Arial Narrow")
+
require(ggplot2)
+wb <- createWorkbook()
+options(openxlsx.borderColour = "#4F80BD")
+options(openxlsx.borderStyle = "thin")
+modifyBaseFont(wb, fontSize = 10, fontName = "Arial Narrow")

Add Sheets

-
addWorksheet(wb, sheetName = "Motor Trend Car Road Tests", gridLines = FALSE)
-addWorksheet(wb, sheetName = "Iris", gridLines = FALSE)
+
addWorksheet(wb, sheetName = "Motor Trend Car Road Tests", gridLines = FALSE)
+addWorksheet(wb, sheetName = "Iris", gridLines = FALSE)

write data to sheet 1

-
freezePane(wb, sheet = 1, firstRow = TRUE, firstCol = TRUE)  ## freeze first row and column
-writeDataTable(wb, sheet = 1, x = mtcars, colNames = TRUE, rowNames = TRUE, tableStyle = "TableStyleLight9")
-
-setColWidths(wb, sheet = 1, cols = "A", widths = 18)
+
freezePane(wb, sheet = 1, firstRow = TRUE, firstCol = TRUE)  ## freeze first row and column
+writeDataTable(wb, sheet = 1, x = mtcars, colNames = TRUE, rowNames = TRUE, tableStyle = "TableStyleLight9")
+
+setColWidths(wb, sheet = 1, cols = "A", widths = 18)

write data to sheet 2

iris data.frame is added as excel table on sheet 2.

-
writeDataTable(wb, sheet = 2, iris, startCol = "K", startRow = 2)
-
-qplot(data = iris, x = Sepal.Length, y = Sepal.Width, colour = Species)
-insertPlot(wb, 2, xy = c("B", 16))  ## insert plot at cell B16
-
-means <- aggregate(x = iris[, -5], by = list(iris$Species), FUN = mean)
-vars <- aggregate(x = iris[, -5], by = list(iris$Species), FUN = var)
+
writeDataTable(wb, sheet = 2, iris, startCol = "K", startRow = 2)
+
+qplot(data = iris, x = Sepal.Length, y = Sepal.Width, colour = Species)
+insertPlot(wb, 2, xy = c("B", 16))  ## insert plot at cell B16
+
+means <- aggregate(x = iris[, -5], by = list(iris$Species), FUN = mean)
+vars <- aggregate(x = iris[, -5], by = list(iris$Species), FUN = var)

add write group means

-
headSty <- createStyle(fgFill = "#DCE6F1", halign = "center", border = "TopBottomLeftRight")
-writeData(wb, 2, x = "Iris dataset group means", startCol = 2, startRow = 2)
-writeData(wb, 2, x = means, startCol = "B", startRow = 3, borders = "rows", headerStyle = headSty)
+
headSty <- createStyle(fgFill = "#DCE6F1", halign = "center", border = "TopBottomLeftRight")
+writeData(wb, 2, x = "Iris dataset group means", startCol = 2, startRow = 2)
+writeData(wb, 2, x = means, startCol = "B", startRow = 3, borders = "rows", headerStyle = headSty)

add write group variances

-
writeData(wb, 2, x = "Iris dataset group variances", startCol = 2, startRow = 9)
-writeData(wb, 2, x = vars, startCol = "B", startRow = 10, borders = "columns", headerStyle = headSty)
-
-setColWidths(wb, 2, cols = 2:6, widths = 12)  ## width is recycled for each col
-setColWidths(wb, 2, cols = 11:15, widths = 15)
+
writeData(wb, 2, x = "Iris dataset group variances", startCol = 2, startRow = 9)
+writeData(wb, 2, x = vars, startCol = "B", startRow = 10, borders = "columns", headerStyle = headSty)
+
+setColWidths(wb, 2, cols = 2:6, widths = 12)  ## width is recycled for each col
+setColWidths(wb, 2, cols = 11:15, widths = 15)

add style mean & variance table headers

-
s1 <- createStyle(fontSize = 14, textDecoration = c("bold", "italic"))
-addStyle(wb, 2, style = s1, rows = c(2, 9), cols = c(2, 2))
+
s1 <- createStyle(fontSize = 14, textDecoration = c("bold", "italic"))
+addStyle(wb, 2, style = s1, rows = c(2, 9), cols = c(2, 2))

save workbook

-
saveWorkbook(wb, "basics.xlsx", overwrite = TRUE)  ## save to working directory
+
saveWorkbook(wb, "basics.xlsx", overwrite = TRUE)  ## save to working directory

Further Examples

Stock Price

-
require(ggplot2)
-
-wb <- createWorkbook()
-
-## read historical prices from yahoo finance
-ticker <- "CBA.AX"
-csv.url <- paste("http://ichart.finance.yahoo.com/table.csv?s=", ticker, "&a=01&b=9&c=2009&d=01&e=9&f=2014&g=d&ignore=.csv")
-prices <- read.csv(url(csv.url), as.is = TRUE)
-prices$Date <- as.Date(prices$Date)
-close <- prices$Close
-prices$logReturns = c(0, log(close[2:length(close)]/close[1:(length(close) - 1)]))
-
-## Create plot of price series and add to worksheet
-ggplot(data = prices, aes(as.Date(Date), as.numeric(Close))) + geom_line(colour = "royalblue2") + 
-    labs(x = "Date", y = "Price", title = ticker) + geom_area(fill = "royalblue1", 
-    alpha = 0.3) + coord_cartesian(ylim = c(min(prices$Close) - 1.5, max(prices$Close) + 
-    1.5))
-
-## Add worksheet and write plot to sheet
-addWorksheet(wb, sheetName = "CBA")
-insertPlot(wb, sheet = 1, xy = c("J", 3))
-
-## Histogram of log returns
-ggplot(data = prices, aes(x = logReturns)) + geom_bar(binwidth = 0.0025) + labs(title = "Histogram of log returns")
-
-## currency
-class(prices$Close) <- "currency"  ## styles as currency in workbook
-
-## write historical data and histogram of returns
-writeDataTable(wb, sheet = "CBA", x = prices)
-insertPlot(wb, sheet = 1, startRow = 25, startCol = "J")
-
-## Add conditional formatting to show where logReturn > 0.01 using default style
-conditionalFormat(wb, sheet = 1, cols = 1:ncol(prices), rows = 2:(nrow(prices) + 
-    1), rule = "$H2 > 0.01")
-
-## style log return col as a percentage
-logRetStyle <- createStyle(numFmt = "percentage")
-
-addStyle(wb, 1, style = logRetStyle, rows = 2:(nrow(prices) + 1), cols = "H", gridExpand = TRUE)
-
-setColWidths(wb, sheet = 1, cols = c("A", "F", "G", "H"), widths = 15)
-
-## save workbook to working directory
-saveWorkbook(wb, "stockPrice.xlsx", overwrite = TRUE)
-openXL("stockPrice.xlsx")
+
require(ggplot2)
+
+wb <- createWorkbook()
+
+## read historical prices from yahoo finance
+ticker <- "CBA.AX"
+csv.url <- paste0("https://query1.finance.yahoo.com/v7/finance/download/", ticker,
+    "?period1=1597597610&period2=1629133610&interval=1d&events=history&includeAdjustedClose=true")
+prices <- read.csv(url(csv.url), as.is = TRUE)
+prices$Date <- as.Date(prices$Date)
+close <- prices$Close
+prices$logReturns = c(0, log(close[2:length(close)]/close[1:(length(close) - 1)]))
+
+## Create plot of price series and add to worksheet
+ggplot(data = prices, aes(as.Date(Date), as.numeric(Close))) + geom_line(colour = "royalblue2") +
+    labs(x = "Date", y = "Price", title = ticker) + geom_area(fill = "royalblue1",
+    alpha = 0.3) + coord_cartesian(ylim = c(min(prices$Close) - 1.5, max(prices$Close) +
+    1.5))
+
+## Add worksheet and write plot to sheet
+addWorksheet(wb, sheetName = "CBA")
+insertPlot(wb, sheet = 1, xy = c("J", 3))
+
+## Histogram of log returns
+ggplot(data = prices, aes(x = logReturns)) + geom_bar(binwidth = 0.0025) + labs(title = "Histogram of log returns")
+
+## currency
+class(prices$Close) <- "currency"  ## styles as currency in workbook
+
+## write historical data and histogram of returns
+writeDataTable(wb, sheet = "CBA", x = prices)
+insertPlot(wb, sheet = 1, startRow = 25, startCol = "J")
+
+## Add conditional formatting to show where logReturn > 0.01 using default
+## style
+conditionalFormat(wb, sheet = 1, cols = 1:ncol(prices), rows = 2:(nrow(prices) +
+    1), rule = "$H2 > 0.01")
+
+## style log return col as a percentage
+logRetStyle <- createStyle(numFmt = "percentage")
+
+addStyle(wb, 1, style = logRetStyle, rows = 2:(nrow(prices) + 1), cols = "H", gridExpand = TRUE)
+
+setColWidths(wb, sheet = 1, cols = c("A", "F", "G", "H"), widths = 15)
+
+## save workbook to working directory
+saveWorkbook(wb, "stockPrice.xlsx", overwrite = TRUE)
+openXL("stockPrice.xlsx")

Image Compression using PCA

-
require(openxlsx)
-require(jpeg)
-require(ggplot2)
-
-plotFn <- function(x, ...){
-  colvec <- grey(x)
-  colmat <- array(match(colvec, unique(colvec)), dim = dim(x)[1:2])
-  image(x = 0:(dim(colmat)[2]), y = 0:(dim(colmat)[1]), z = t(colmat[nrow(colmat):1, ]),
-    col = unique(colvec), xlab = "", ylab = "", axes = FALSE, asp = 1,
-    bty ="n", frame.plot=F, ann=FALSE)
-}
-
-## Create workbook and add a worksheet, hide gridlines
-wb <- createWorkbook("Einstein")
-addWorksheet(wb, "Original Image", gridLines = FALSE)
-
-A <- readJPEG(file.path(path.package("openxlsx"), "einstein.jpg"))
-height <- nrow(A); width <- ncol(A)
-
-## write "Original Image" to cell B2
-writeData(wb, 1, "Original Image", xy = c(2,2))
-
-## write Object size to cell B3
-writeData(wb, 1, sprintf("Image object size: %s bytes",
-                         format(object.size(A+0)[[1]], big.mark=',')), 
-          xy = c(2,3))  ## equivalent to startCol = 2, startRow = 3
-
-## Plot image
-par(mar=rep(0, 4), xpd = NA); plotFn(A)
-
-## insert plot currently showing in plot window
-insertPlot(wb, 1, width, height, units="px", startRow= 5, startCol = 2)       
-
-## SVD of covariance matrix
-rMeans <- rowMeans(A)
-rowMeans <- do.call("cbind", lapply(1:ncol(A), function(X) rMeans))
-A <- A - rowMeans
-E <- svd(A %*% t(A) / (ncol(A) - 1)) # SVD on covariance matrix of A
-pve <- data.frame("Eigenvalues" = E$d, 
-                  "PVE" = E$d/sum(E$d),
-                  "Cumulative PVE" = cumsum(E$d/sum(E$d)))
-
-## write eigenvalues to worksheet
-addWorksheet(wb, "Principal Component Analysis")
-hs <- createStyle(fontColour = "#ffffff", fgFill = "#4F80BD",
-                  halign = "CENTER", textDecoration = "Bold",
-                  border = "TopBottomLeftRight", borderColour = "#4F81BD")
-
-writeData(wb, 2, x="Proportions of variance explained by Eigenvector" ,startRow = 2)
-mergeCells(wb, sheet=2, cols=1:4, rows=2)
-
-setColWidths(wb, 2, cols = 1:3, widths = c(14, 12, 15))
-writeData(wb, 2, x=pve, startRow = 3, startCol = 1, borders="rows", headerStyle=hs)
-
-## Plots
-pve <- cbind(pve, "Ind" = 1:nrow(pve))
-ggplot(data = pve[1:20,], aes(x = Ind, y = 100*PVE)) +
-  geom_bar(stat="identity", position = "dodge") +
-  xlab("Principal Component Index") + ylab("Proportion of Variance Explained") +
-  geom_line(size = 1, col = "blue") + geom_point(size = 3, col = "blue")
-
-## Write plot to worksheet 2
-insertPlot(wb, 2, width = 5, height = 4, startCol = "E", startRow = 2) 
-
-## Plot of cumulative explained variance
-ggplot(data = pve[1:50,], aes(x = Ind, y = 100*Cumulative.PVE)) +
-  geom_point(size=2.5) + geom_line(size=1) + xlab("Number of PCs") +
-  ylab("Cumulative Proportion of Variance Explained")
-insertPlot(wb, 2, width = 5, height = 4, xy= c("M", 2)) 
-
-
-## Reconstruct image using increasing number of PCs
-nPCs <- c(5, 7, 12, 20, 50, 200)
-startRow <- rep(c(2, 24), each = 3)
-startCol <- rep(c("B", "H", "N"), 2)
-
-## create a worksheet to save reconstructed images to
-addWorksheet(wb, "Reconstructed Images", zoom = 90)
-
-for(i in 1:length(nPCs)){
-  
-  V <- E$v[, 1:nPCs[i]]
-  imgHat <- t(V) %*% A  ## project img data on to PCs
-  imgSize <- object.size(V) + object.size(imgHat) + object.size(rMeans)
-  
-  imgHat <- V %*% imgHat + rowMeans  ## reconstruct from PCs and add back row means
-  imgHat <- round((imgHat - min(imgHat)) / (max(imgHat) - min(imgHat))*255) # scale
-  plotFn(imgHat/255)
-  
-  ## write strings to worksheet 3
-  writeData(wb, "Reconstructed Images", 
-            sprintf("Number of principal components used:  %s", 
-                    nPCs[[i]]), startCol[i], startRow[i])
-  
-  writeData(wb, "Reconstructed Images", 
-            sprintf("Sum of component object sizes: %s bytes",
-                    format(as.numeric(imgSize), big.mark=',')), startCol[i], startRow[i]+1)
-  
-  ## write reconstruced image
-  insertPlot(wb, "Reconstructed Images", width, height, units="px",
-             xy = c(startCol[i], startRow[i]+3))
-  
-}
-
-# hide grid lines
-showGridLines(wb, sheet = 3, showGridLines = FALSE)
-
-## Make text above images BOLD
-boldStyle <- createStyle(textDecoration="BOLD")
-
-## only want to apply style to specified cells (not all combinations of rows & cols)
-addStyle(wb, "Reconstructed Images", style=boldStyle, 
-         rows = c(startRow, startRow+1), cols = rep(startCol, 2), 
-         gridExpand = FALSE)  
-
-## save workbook to working directory
-saveWorkbook(wb, "Image dimensionality reduction.xlsx", overwrite = TRUE) 
-
-
-
-
-## remove example files for cran test
-if (identical(Sys.getenv("NOT_CRAN", unset = "true"), "false")) {
-file_list<-list.files(pattern="\\.xlsx",recursive = T)
-file_list<-fl[!grepl("inst/extdata",file_list)&!grepl("man/",file_list)]
-
-if(length(file_list)>0){
-rm(file_list)
-}
+
require(openxlsx)
+require(jpeg)
+require(ggplot2)
+
+plotFn <- function(x, ...){
+  colvec <- grey(x)
+  colmat <- array(match(colvec, unique(colvec)), dim = dim(x)[1:2])
+  image(x = 0:(dim(colmat)[2]), y = 0:(dim(colmat)[1]), z = t(colmat[nrow(colmat):1, ]),
+    col = unique(colvec), xlab = "", ylab = "", axes = FALSE, asp = 1,
+    bty ="n", frame.plot=F, ann=FALSE)
+}
+
+## Create workbook and add a worksheet, hide gridlines
+wb <- createWorkbook("Einstein")
+addWorksheet(wb, "Original Image", gridLines = FALSE)
+
+A <- readJPEG(file.path(path.package("openxlsx"), "einstein.jpg"))
+height <- nrow(A); width <- ncol(A)
+
+## write "Original Image" to cell B2
+writeData(wb, 1, "Original Image", xy = c(2,2))
+
+## write Object size to cell B3
+writeData(wb, 1, sprintf("Image object size: %s bytes",
+                         format(object.size(A+0)[[1]], big.mark=',')), 
+          xy = c(2,3))  ## equivalent to startCol = 2, startRow = 3
+
+## Plot image
+par(mar=rep(0, 4), xpd = NA); plotFn(A)
+
+## insert plot currently showing in plot window
+insertPlot(wb, 1, width, height, units="px", startRow= 5, startCol = 2)       
+
+## SVD of covariance matrix
+rMeans <- rowMeans(A)
+rowMeans <- do.call("cbind", lapply(1:ncol(A), function(X) rMeans))
+A <- A - rowMeans
+E <- svd(A %*% t(A) / (ncol(A) - 1)) # SVD on covariance matrix of A
+pve <- data.frame("Eigenvalues" = E$d, 
+                  "PVE" = E$d/sum(E$d),
+                  "Cumulative PVE" = cumsum(E$d/sum(E$d)))
+
+## write eigenvalues to worksheet
+addWorksheet(wb, "Principal Component Analysis")
+hs <- createStyle(fontColour = "#ffffff", fgFill = "#4F80BD",
+                  halign = "CENTER", textDecoration = "Bold",
+                  border = "TopBottomLeftRight", borderColour = "#4F81BD")
+
+writeData(wb, 2, x="Proportions of variance explained by Eigenvector" ,startRow = 2)
+mergeCells(wb, sheet=2, cols=1:4, rows=2)
+
+setColWidths(wb, 2, cols = 1:3, widths = c(14, 12, 15))
+writeData(wb, 2, x=pve, startRow = 3, startCol = 1, borders="rows", headerStyle=hs)
+
+## Plots
+pve <- cbind(pve, "Ind" = 1:nrow(pve))
+ggplot(data = pve[1:20,], aes(x = Ind, y = 100*PVE)) +
+  geom_bar(stat="identity", position = "dodge") +
+  xlab("Principal Component Index") + ylab("Proportion of Variance Explained") +
+  geom_line(size = 1, col = "blue") + geom_point(size = 3, col = "blue")
+
+## Write plot to worksheet 2
+insertPlot(wb, 2, width = 5, height = 4, startCol = "E", startRow = 2) 
+
+## Plot of cumulative explained variance
+ggplot(data = pve[1:50,], aes(x = Ind, y = 100*Cumulative.PVE)) +
+  geom_point(size=2.5) + geom_line(size=1) + xlab("Number of PCs") +
+  ylab("Cumulative Proportion of Variance Explained")
+insertPlot(wb, 2, width = 5, height = 4, xy= c("M", 2)) 
+
+
+## Reconstruct image using increasing number of PCs
+nPCs <- c(5, 7, 12, 20, 50, 200)
+startRow <- rep(c(2, 24), each = 3)
+startCol <- rep(c("B", "H", "N"), 2)
+
+## create a worksheet to save reconstructed images to
+addWorksheet(wb, "Reconstructed Images", zoom = 90)
+
+for(i in 1:length(nPCs)){
+  
+  V <- E$v[, 1:nPCs[i]]
+  imgHat <- t(V) %*% A  ## project img data on to PCs
+  imgSize <- object.size(V) + object.size(imgHat) + object.size(rMeans)
+  
+  imgHat <- V %*% imgHat + rowMeans  ## reconstruct from PCs and add back row means
+  imgHat <- round((imgHat - min(imgHat)) / (max(imgHat) - min(imgHat))*255) # scale
+  plotFn(imgHat/255)
+  
+  ## write strings to worksheet 3
+  writeData(wb, "Reconstructed Images", 
+            sprintf("Number of principal components used:  %s", 
+                    nPCs[[i]]), startCol[i], startRow[i])
+  
+  writeData(wb, "Reconstructed Images", 
+            sprintf("Sum of component object sizes: %s bytes",
+                    format(as.numeric(imgSize), big.mark=',')), startCol[i], startRow[i]+1)
+  
+  ## write reconstruced image
+  insertPlot(wb, "Reconstructed Images", width, height, units="px",
+             xy = c(startCol[i], startRow[i]+3))
+  
+}
+
+# hide grid lines
+showGridLines(wb, sheet = 3, showGridLines = FALSE)
+
+## Make text above images BOLD
+boldStyle <- createStyle(textDecoration="BOLD")
+
+## only want to apply style to specified cells (not all combinations of rows & cols)
+addStyle(wb, "Reconstructed Images", style=boldStyle, 
+         rows = c(startRow, startRow+1), cols = rep(startCol, 2), 
+         gridExpand = FALSE)  
+
+## save workbook to working directory
+saveWorkbook(wb, "Image dimensionality reduction.xlsx", overwrite = TRUE) 
+
+
+
+
+## remove example files for cran test
+if (identical(Sys.getenv("NOT_CRAN", unset = "true"), "false")) {
+file_list<-list.files(pattern="\\.xlsx",recursive = T)
+file_list<-fl[!grepl("inst/extdata",file_list)&!grepl("man/",file_list)]
+
+if(length(file_list)>0){
+rm(file_list)
+}
From 0cec90f2d3e6f8dfb2dbb117504a52b4ddcae16c Mon Sep 17 00:00:00 2001 From: ycphs Date: Tue, 24 Aug 2021 11:48:49 +0200 Subject: [PATCH 2/5] version update date update --- DESCRIPTION | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 433bd1ef..d78f4d0c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,9 @@ Type: Package Package: openxlsx Title: Read, Write and Edit xlsx Files -Version: 4.2.4.9000 -Date: 2021-06-08 +Version: 4.2.5 +Date: 2021-12-11 +Language: en-US Authors@R: c(person(given = "Philipp", family = "Schauberger", From 4347ca3e69dd66cd0cbb6f3c6c8f7e9a14e81f84 Mon Sep 17 00:00:00 2001 From: Jan Marvin Garbuszus Date: Sun, 29 Aug 2021 18:42:23 +0200 Subject: [PATCH 3/5] Update DESCRIPTION --- DESCRIPTION | 1 - 1 file changed, 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index d78f4d0c..a55af8e7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -3,7 +3,6 @@ Package: openxlsx Title: Read, Write and Edit xlsx Files Version: 4.2.5 Date: 2021-12-11 -Language: en-US Authors@R: c(person(given = "Philipp", family = "Schauberger", From 1af5f71f1a3f81cd5ab1faba1694ae6e3ee7280f Mon Sep 17 00:00:00 2001 From: Philipp Schauberger Date: Fri, 5 Nov 2021 19:41:23 +0100 Subject: [PATCH 4/5] release prep --- NEWS.md | 19 +++++++++---------- README.md | 3 +-- 2 files changed, 10 insertions(+), 12 deletions(-) diff --git a/NEWS.md b/NEWS.md index 263837a5..d88e0051 100644 --- a/NEWS.md +++ b/NEWS.md @@ -7,22 +7,21 @@ * `read.xlsx()` no longer changes random seed ([#183](https://github.com/ycphs/openxlsx/issues/183)) * fixed a regression that caused fonts to be read in incorrectly ([#207](https://github.com/ycphs/openxlsx/issues/207)) * add option to save as read only recommended ([#201](https://github.com/ycphs/openxlsx/issues/201)) -* fixed writing hyperlink formulas ([#212](https://github.com/ycphs/openxlsx/issues/212)) +* fixed writing hyperlink formulas ([#200](https://github.com/ycphs/openxlsx/issues/200)) * `write.xlsx()` now throws an error if it doesn't have write permissions ([#190](https://github.com/ycphs/openxlsx/issues/190)) * `write.xlsx()` now again uses the default of `overwrite = TRUE` for saving files ([#249](https://github.com/ycphs/openxlsx/issues/249)) -* `Workbook$show()` no longer fails when called in a 0 sheet workbook([#240](https://github.com/ychps/openxlsx/issues/240)) -* `read.xlsx()` again accepts `.xlsm` files ([#205](https://github.com/ychps/openxlsx/issues/205), -[#209](https://github.com/ychps/openxlsx/issues/209)) -* `makeHyperlinkString()` does no longer require a sheet argument ([#57](https://github.com/ychps/openxlsx/issues/57), [#58](https://github.com/ychps/openxlsx/issues/58)) -* improvements in how `openxlsx` creates temporary directories (see [#262](https://github.com/ychps/openxlsx/issues/262)) -* `writeData()` calls `force(x)` to evaluate the object before options are set ([#264](https://github.com/ycphs/openxlsx/issues/264)) -* `createComment()` now correctly handles `integers` in `width` and `height` ([#275](https://github.com/ycphs/openxlsx/issues/275)) -* `setStyles()` accepts `halign="justify"` -([#305](https://github.com/ycphs/openxlsx/issues/305)) ## Improvements * `options()` are more consistently set in functions (see: [#289](https://github.com/ychps/openxlsx/issues/262)) +* `Workbook$show()` no longer fails when called in a 0 sheet workbook([#240](https://github.com/ycphs/openxlsx/issues/240)) +* `read.xlsx()` again accepts `.xlsm` files ([#205](https://github.com/ycphs/openxlsx/issues/205), +[#209](https://github.com/ycphs/openxlsx/issues/209)) +* `makeHyperlinkString()` does no longer require a sheet argument ([#57](https://github.com/ycphs/openxlsx/issues/57), [#58](https://github.com/ycphs/openxlsx/issues/58)) +* improvements in how `openxlsx` creates temporary directories (see [#262](https://github.com/ycphs/openxlsx/issues/262)) +* `writeData()` calls `force(x)` to evaluate the object before options are set ([#264](https://github.com/ycphs/openxlsx/issues/264)) +* `createComment()` now correctly handles `integers` in `width` and `height` ([#275](https://github.com/ycphs/openxlsx/issues/275)) +* `setStyles()` accepts `halign="justify"` ([#305](https://github.com/ycphs/openxlsx/issues/305)) # openxlsx 4.2.4 diff --git a/README.md b/README.md index 6c6d37df..38f183f4 100644 --- a/README.md +++ b/README.md @@ -2,8 +2,7 @@ ======== - -[![codecov](https://codecov.io/gh/ycphs/openxlsx/branch/master/graph/badge.svg)](https://codecov.io/gh/ycphs/openxlsx) +[![codecov](https://codecov.io/gh/ycphs/openxlsx/branch/master/graph/badge.svg)](https://app.codecov.io/gh/ycphs/openxlsx) [![CRAN_Status_Badge](https://www.r-pkg.org/badges/version/openxlsx)](https://cran.r-project.org/package=openxlsx) [![CRAN RStudio mirror downloads](https://cranlogs.r-pkg.org/badges/openxlsx)](https://cran.r-project.org/package=openxlsx) ![R-CMD-check](https://github.com/ycphs/openxlsx/workflows/R-CMD-check/badge.svg?branch=master) From 8fcf0ec6b6d299798483d49ac5fb2385f8bc4225 Mon Sep 17 00:00:00 2001 From: Jan Marvin Garbuszus Date: Sat, 11 Dec 2021 10:06:59 +0100 Subject: [PATCH 5/5] remove older CIs --- .appveyor.yml | 53 --------------------------------------------------- .travis.yml | 23 ---------------------- 2 files changed, 76 deletions(-) delete mode 100644 .appveyor.yml delete mode 100644 .travis.yml diff --git a/.appveyor.yml b/.appveyor.yml deleted file mode 100644 index d289fcc0..00000000 --- a/.appveyor.yml +++ /dev/null @@ -1,53 +0,0 @@ -# DO NOT CHANGE the "init" and "install" sections below - -# Download script file from GitHub -init: - ps: | - $ErrorActionPreference = "Stop" - Invoke-WebRequest http://raw.github.com/krlmlr/r-appveyor/master/scripts/appveyor-tool.ps1 -OutFile "..\appveyor-tool.ps1" - Import-Module '..\appveyor-tool.ps1' - -install: - ps: Bootstrap - -cache: - - C:\RLibrary - -environment: - NOT_CRAN: true - # env vars that may need to be set, at least temporarily, from time to time - # see https://github.com/krlmlr/r-appveyor#readme for details - # USE_RTOOLS: true - # R_REMOTES_STANDALONE: true - -# Adapt as necessary starting from here - -build_script: - - travis-tool.sh install_deps - -test_script: - - travis-tool.sh run_tests - -on_failure: - - 7z a failure.zip *.Rcheck\* - - appveyor PushArtifact failure.zip - -artifacts: - - path: '*.Rcheck\**\*.log' - name: Logs - - - path: '*.Rcheck\**\*.out' - name: Logs - - - path: '*.Rcheck\**\*.fail' - name: Logs - - - path: '*.Rcheck\**\*.Rout' - name: Logs - - - path: '\*_*.tar.gz' - name: Bits - - - path: '\*_*.zip' - name: Bits - \ No newline at end of file diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 index a66e16c4..00000000 --- a/.travis.yml +++ /dev/null @@ -1,23 +0,0 @@ -# R for travis: see documentation at https://docs.travis-ci.com/user/languages/r - -language: r -cache: packages - -matrix: - include: - - r: devel - env: _R_CHECK_LENGTH_1_LOGIC2_=true - - r: release - pandoc: false - env: PANDOC='none' - - r: oldrel - - r: 3.3 - - r: 3.4 - - r: 3.5 - - r: 3.6 - - r: 4.0 - - -env: - global: - - _R_CHECK_FORCE_SUGGESTS_=TRUE