inst/doc/Introduction.R

In openxlsx: Read, Write and Edit xlsx Files

## ----include = TRUE, tidy = TRUE, eval = FALSE, highlight = TRUE--------------
#  ## write to working directory
#  library(openxlsx)
#  write.xlsx(iris, file = "writeXLSX1.xlsx")
#  write.xlsx(iris, file = "writeXLSXTable1.xlsx", asTable = TRUE)

## ----include = TRUE, tidy = TRUE, eval = FALSE ,highlight = 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)

## ----include = TRUE, tidy = TRUE, eval = FALSE ,highlight= 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) / 1E9,  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)
#  
#  

## ----include = TRUE, tidy = TRUE, eval = FALSE, highlight= TRUE---------------
#  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))

## ----include = TRUE, tidy = TRUE, eval = FALSE, highlight = TRUE--------------
#  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")

## ----include = TRUE, tidy = TRUE, eval = FALSE, highlight = TRUE--------------
#  wb <- write.xlsx(iris, "writeXLSX6.xlsx")
#  setColWidths(wb, sheet = 1, cols = 1:5, widths = 20)
#  saveWorkbook(wb, "writeXLSX6.xlsx", overwrite = TRUE)

## ----include = TRUE, tidy = TRUE, eval = FALSE, highlight = TRUE--------------
#  require(ggplot2)
#  wb <- createWorkbook()
#  options("openxlsx.borderColour" = "#4F80BD")
#  options("openxlsx.borderStyle" = "thin")
#  modifyBaseFont(wb, fontSize = 10, fontName = "Arial Narrow")

## ----include = TRUE,tidy = TRUE, eval = FALSE, highlight = TRUE---------------
#  addWorksheet(wb, sheetName = "Motor Trend Car Road Tests", gridLines = FALSE)
#  addWorksheet(wb, sheetName = "Iris", gridLines = FALSE)

## ----include = TRUE, tidy = TRUE, eval = FALSE, highlight = TRUE--------------
#  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)

## ----include = TRUE, tidy = TRUE, eval = FALSE, highlight = TRUE--------------
#  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)

## ----include = TRUE, tidy = TRUE, eval = FALSE, highlight = TRUE--------------
#  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)

## ----include = TRUE, tidy = TRUE, eval = FALSE, highlight = TRUE--------------
#  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)

## ----include = TRUE, tidy = TRUE, eval = FALSE, highlight = TRUE--------------
#  s1 <- createStyle(fontSize=14, textDecoration=c("bold", "italic"))
#  addStyle(wb, 2, style = s1, rows=c(2,9), cols=c(2,2))

## ----include = TRUE, tidy = TRUE, eval = FALSE, highlight = TRUE--------------
#  saveWorkbook(wb, "basics.xlsx", overwrite = TRUE) ## save to working directory

## ----eval = FALSE, include = TRUE---------------------------------------------
#  ## inspired by xtable gallery
#  #https://CRAN.R-project.org/package=xtable/vignettes/xtableGallery.pdf
#  
#  ## Create a new workbook
#  wb <- createWorkbook()
#  data(tli, package = "xtable")
#  
#  ## data.frame
#  test.n <- "data.frame"
#  my.df <- tli[1:10, ]
#  addWorksheet(wb = wb, sheetName = test.n)
#  writeData(wb = wb, sheet = test.n, x = my.df, borders = "n")
#  
#  ## matrix
#  test.n <- "matrix"
#  design.matrix <- model.matrix(~ sex * grade, data = my.df)
#  addWorksheet(wb = wb, sheetName = test.n)
#  writeData(wb = wb, sheet = test.n, x = design.matrix)
#  
#  ## aov
#  test.n <- "aov"
#  fm1 <- aov(tlimth ~ sex + ethnicty + grade + disadvg, data = tli)
#  addWorksheet(wb = wb, sheetName = test.n)
#  writeData(wb = wb, sheet = test.n, x = fm1)
#  
#  ## lm
#  test.n <- "lm"
#  fm2 <- lm(tlimth ~ sex*ethnicty, data = tli)
#  addWorksheet(wb = wb, sheetName = test.n)
#  writeData(wb = wb, sheet = test.n, x = fm2)
#  
#  ## anova 1
#  test.n <- "anova"
#  my.anova <- anova(fm2)
#  addWorksheet(wb = wb, sheetName = test.n)
#  writeData(wb = wb, sheet = test.n, x = my.anova)
#  
#  ## anova 2
#  test.n <- "anova2"
#  fm2b <- lm(tlimth ~ ethnicty, data = tli)
#  my.anova2 <- anova(fm2b, fm2)
#  addWorksheet(wb = wb, sheetName = test.n)
#  writeData(wb = wb, sheet = test.n, x = my.anova2)
#  
#  ## glm
#  test.n <- "glm"
#  fm3 <- glm(disadvg ~ ethnicty*grade, data = tli, family = binomial())
#  addWorksheet(wb = wb, sheetName = test.n)
#  writeData(wb = wb, sheet = test.n, x = fm3)
#  
#  ## prcomp
#  test.n <- "prcomp"
#  pr1 <- prcomp(USArrests)
#  addWorksheet(wb = wb, sheetName = test.n)
#  writeData(wb = wb, sheet = test.n, x = pr1)
#  
#  ## summary.prcomp
#  test.n <- "summary.prcomp"
#  addWorksheet(wb = wb, sheetName = test.n)
#  writeData(wb = wb, sheet = test.n, x = summary(pr1))
#  
#  ## simple table
#  test.n <- "table"
#  data(airquality)
#  airquality$OzoneG80 <- factor(airquality$Ozone > 80,
#  levels = c(FALSE, TRUE),
#  labels = c("Oz <= 80", "Oz > 80"))
#  airquality$Month <- factor(airquality$Month,
#  levels = 5:9,
#  labels = month.abb[5:9])
#  my.table <- with(airquality, table(OzoneG80,Month) )
#  addWorksheet(wb = wb, sheetName = test.n)
#  writeData(wb = wb, sheet = test.n, x = my.table)
#  
#  ## survdiff 1
#  library(survival)
#  test.n <- "survdiff1"
#  addWorksheet(wb = wb, sheetName = test.n)
#  x <- survdiff(Surv(futime, fustat) ~ rx, data = ovarian)
#  writeData(wb = wb, sheet = test.n, x = x)
#  
#  ## survdiff 2
#  test.n <- "survdiff2"
#  addWorksheet(wb = wb, sheetName = test.n)
#  expect <- survexp(futime ~ ratetable(age=(accept.dt - birth.dt),
#        sex=1,year=accept.dt,race="white"), jasa, cohort=FALSE,
#        ratetable=survexp.usr)
#  x <- survdiff(Surv(jasa$futime, jasa$fustat) ~ offset(expect))
#  writeData(wb = wb, sheet = test.n, x = x)
#  
#  ## coxph 1
#  test.n <- "coxph1"
#  addWorksheet(wb = wb, sheetName = test.n)
#  bladder$rx <- factor(bladder$rx, labels = c("Pla","Thi"))
#  x <- coxph(Surv(stop,event) ~ rx, data = bladder)
#  writeData(wb = wb, sheet = test.n, x = x)
#  
#  ## coxph 2
#  test.n <- "coxph2"
#  addWorksheet(wb = wb, sheetName = test.n)
#  x <- coxph(Surv(stop,event) ~ rx + cluster(id), data = bladder)
#  writeData(wb = wb, sheet = test.n, x = x)
#  
#  ## cox.zph
#  test.n <- "cox.zph"
#  addWorksheet(wb = wb, sheetName = test.n)
#  x <- cox.zph(coxph(Surv(futime, fustat) ~ age + ecog.ps,  data=ovarian))
#  writeData(wb = wb, sheet = test.n, x = x)
#  
#  ## summary.coxph 1
#  test.n <- "summary.coxph1"
#  addWorksheet(wb = wb, sheetName = test.n)
#  x <- summary(coxph(Surv(stop,event) ~ rx, data = bladder))
#  writeData(wb = wb, sheet = test.n, x = x)
#  
#  ## summary.coxph 2
#  test.n <- "summary.coxph2"
#  addWorksheet(wb = wb, sheetName = test.n)
#  x <- summary(coxph(Surv(stop,event) ~ rx + cluster(id), data = bladder))
#  writeData(wb = wb, sheet = test.n, x = x)
#  
#  ## view without saving
#  openXL(wb)
#  

## ----eval = FALSE, include = TRUE, tidy = TRUE, highlight= TRUE---------------
#  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_histogram(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 = seq_len((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")

## ----eval = FALSE, include = TRUE---------------------------------------------
#  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[rev(seq_len(nrow(colmat))) , ]),
#      col = unique(colvec), xlab = "", ylab = "", axes = FALSE, asp = 1,
#      bty ="n", frame.plot=FALSE, 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(seq_len(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" = seq_len(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 seq_len(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 = TRUE)
#    file_list<-fl[!grepl("inst/extdata",file_list)&!grepl("man/",file_list)]
#  
#    if(length(file_list)>0) {
#      rm(file_list)
#    }
#  }

## ----cleanup, eval = FALSE, include = FALSE-----------------------------------
#  xlsx_files <- dir(pattern = "*.xlsx")
#  unlink(xlsx_files)