Nothing
context("XLSX Lines")
library(xml2)
test_that("segments don't have fill", {
file <- tempfile()
dml_xlsx( file = file, bg = "transparent" )
plot.new()
segments(0.5, 0.5, 1, 1)
dev.off()
doc <- read_xml(file)
fill_node <- xml_find_first(doc, ".//xdr:sp/xdr:spPr/a:solidFill", ns = xml_ns( doc ) )
expect_is( fill_node, "xml_missing")
})
test_that("lines don't have fill", {
file <- tempfile()
dml_xlsx( file = file, bg = "transparent" )
plot.new()
lines(c(0.5, 1, 0.5), c(0.5, 1, 1))
dev.off()
doc <- read_xml(file)
fill_node <- xml_find_first(doc, ".//xdr:sp/xdr:spPr/a:solidFill", ns = xml_ns( doc ) )
expect_is( fill_node, "xml_missing")
})
test_that("polygons do have fill", {
file <- tempfile()
dml_xlsx( file = file, bg = "transparent" )
plot.new()
polygon(c(0.5, 1, 0.5), c(0.5, 1, 1), col = "red", border = "blue")
dev.off()
doc <- read_xml(file)
fill_node <- xml_find_first(doc, ".//xdr:sp/xdr:spPr/a:solidFill", ns = xml_ns( doc ) )
expect_is( fill_node, "xml_node")
})
test_that("polygons without border", {
file <- tempfile()
dml_xlsx( file = file, bg = "transparent" )
plot.new()
polygon(c(0.5, 1, 0.5), c(0.5, 1, 1), col = "red", border = NA)
dev.off()
doc <- read_xml(file)
fill_color <- xml_find_first(doc, ".//xdr:sp/xdr:spPr/a:solidFill/a:srgbClr", ns = xml_ns( doc ) )
expect_equal(xml_attr(fill_color, "val"), "FF0000")
line_color <- xml_find_first(doc, ".//xdr:sp/xdr:spPr/a:ln", ns = xml_ns( doc ))
expect_is( line_color, "xml_missing")
})
dash_array <- function(...) {
file <- tempfile()
dml_xlsx( file = file, bg = "transparent" )
plot(1:3, ..., axes = FALSE, xlab = "", ylab = "", type = "l")
dev.off()
doc <- read_xml(file)
dash <- xml_find_first(doc, ".//xdr:sp/xdr:spPr/a:ln/a:prstDash", ns = xml_ns( doc ))
dash
}
custom_dash_array <- function(...) {
file <- tempfile()
dml_xlsx( file = file, bg = "transparent" )
plot(1:3, ..., axes = FALSE, xlab = "", ylab = "", type = "l")
dev.off()
doc <- read_xml(file)
dash <- xml_find_all(doc, ".//xdr:sp/xdr:spPr/a:ln/a:custDash/a:ds", ns = xml_ns( doc ))
as.character( unlist(lapply( dash, xml_attrs)) )
}
test_that("lty are ok", {
expect_equal(xml_attr(dash_array(lty = 1), "val"), "solid")
expect_equal(xml_attr(dash_array(lty = 2), "val"), "dash")
expect_equal(xml_attr(dash_array(lty = 3), "val"), "dot")
expect_equal(custom_dash_array(lty = 4), c("100000", "300000", "400000", "300000"))
expect_equal(xml_attr(dash_array(lty = 5), "val"), "lgDash")
expect_equal(custom_dash_array(lty = 6), c("200000", "200000", "600000", "200000"))
expect_equal(custom_dash_array(lty = "1F"), c("100000", "1500000"))
expect_equal(custom_dash_array(lty = "1234"), c("100000", "200000", "300000", "400000"))
})
test_that("lty scales with lwd", {
expect_equal(custom_dash_array(lty = 4), c("100000", "300000", "400000", "300000"))
expect_equal(custom_dash_array(lty = 4, lwd = 2), c("200000", "600000", "800000", "600000"))
})
test_that("line join shapes", {
file <- tempfile()
dml_xlsx( file = file, bg = "transparent" )
plot.new()
lines(c(0.3, 0.5, 0.7), c(0.1, 0.9, 0.1), lwd = 15, ljoin = "round")
dev.off()
doc <- read_xml(file)
join_shape <- xml_find_first(doc, ".//xdr:sp/xdr:spPr/a:ln/a:round", ns = xml_ns( doc ) )
expect_is(join_shape, "xml_node")
file <- tempfile()
dml_xlsx( file = file, bg = "transparent" )
plot.new()
lines(c(0.3, 0.5, 0.7), c(0.1, 0.9, 0.1), lwd = 15, ljoin = "mitre")
dev.off()
doc <- read_xml(file)
join_shape <- xml_find_first(doc, ".//xdr:sp/xdr:spPr/a:ln/a:miter", ns = xml_ns( doc ) )
expect_is(join_shape, "xml_node")
file <- tempfile()
dml_xlsx( file = file, bg = "transparent" )
plot.new()
lines(c(0.3, 0.5, 0.7), c(0.1, 0.9, 0.1), lwd = 15, ljoin = "bevel")
dev.off()
doc <- read_xml(file)
join_shape <- xml_find_first(doc, ".//xdr:sp/xdr:spPr/a:ln/a:bevel", ns = xml_ns( doc ) )
expect_is(join_shape, "xml_node")
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.