I am trying to use officer to add images to a Word document. I have a whole directory's worth of images that I want to loop through. The problem I am having is that I need to add the image to the document, then add the next image to the newly created document that I just created by adding the last image.
Here's a sample of the code without loops or functions:
library(magrittr)
library(officer)
read_docx() %>% # create document
body_add_img("img1.png", width = 3, height = 4) %>% # add image
body_add_img("img2.png", width = 3, height = 4) %>% # add image
body_add_img("img3.png", width = 3, height = 4) %>% # add image
print(target = "samp.docx") # write document
Using map and lapply doesn't work in this case because every iteration needs to return the object of the previous iteration. I tried writing a function with a for loop but I think I was way off. Any help and pointers would be appreciated.
I think you can use a reduce here. For example using a bit of purrr
library(purrr)
read_docx() %>%
reduce(1:3, function(docx, idx) {
docx %>% body_add_img(paste0("img", idx, ".png"), width = 3, height = 4)
}, .init=.) %>%
print(target = "samp.docx")
The reduce keeps feeding the result back into itself.
I am not sure what was your attempt with the for loop but this simple loop seem to work.
library(officer)
data <- read_docx()
image_list <- paste0('img', 1:3, '.png')
for(i in image_list) {
data <- body_add_img(data, i, width = 3, height = 4)
}
print(data, target = "samp.docx")
Related
I have set of images. For each image I need to exract the intensity of so-called "web safe colors"
As an output I need a dataframe, where each row is am image, and each column is a color.
Here is how I get safe colors
library(rvest)
library(dplyr)
colors = read_html("https://en.wikipedia.org/wiki/Web_colors#Color_table") %>%
html_nodes("h3+ .wikitable td") %>%
html_text() %>%
trimws()
Here is an example of image:
library(magick)
im = image_read("https://farm4.staticflickr.com/3579/3370591414_f321bd33ff_z.jpg")
I can transform it to different number of color like this:
im %>%
image_quantize(max=12)
But since I need to compare images, I want each image to be presented in the same palette (and I've chose web safe palette).
So, finally I end up with this. Not exactly the same that I wanted, but works.
# recolor image
image_id = im
num_vector = as.numeric(img_vector)*255
num_vector = round(num_vector / int) * int
#loop for pixels
for(i in 1:90){
for(j in 1:120){
pixel = num_vector[i,j,]
whichcolor = which(tmp$rgb == paste0(pixel, collapse = "|"))
color = tmp$color_id[whichcolor]
result = rbind(result, data.frame(image_id, i, j, color))
}
}
I want to print two table (3x2 and 2x3) at the top of a PDF page next to each other. The following code prints them in the centre despite pagecentre = FALSE:
tab2 <- tableGrob(df2)
tab3 <- tableGrob(df3)
pdf("file.pdf", height = 20, width = 15, pagecentre = FALSE)
grid.arrange(tab2, tab3, ncol = 2, nrow = 1))
dev.off()
How do I fix this using layout()? I looked at the function but can't understand how the to set the matrix.
I'd also like to add table titles. Do I do this with using a data frame function or while writing to df to pdf?
I have a directory of images and I want to combine anywhere from 3-10 of the images dynamically. It will be anywhere from 3-10 images. My thought was to create n variables and just pass those n variables to image_append. Is there a way to pass my list of image1,image2,image3... to image_append?
library(magick)
these=list.files('../Desktop/',pattern = '.tif') ##list of images, could be 3-10
for (h in 1:3){
assign(paste("image", h, sep = ""), image_read(these[h]) %>%
image_annotate(.,strsplit(these[h],'_')[[1]][4],color = 'white',size=30))
}
image_append(c(image1,image2,image3)) ##Works, but there will be an unknown number of *image* vars created
combine_images = function(...){z=image_append(c(...));return(z)} ##Function that can combine a dynamic number, but passing ls(pattern='image') does not work
Instead of storing the images in the global environment, store it in a list. That way, instead of looping, you can just lapply your calls:
library(magick)
these <- list.files('../Pictures/', pattern = '.tif', full.names = TRUE)
pictures <- image_append(do.call("c", lapply(these, function(h){
image_annotate(image_read(h), strsplit(h, '[.]')[[1]][1], color = 'white', size = 30)
})))
So now, in my case, I get the following result:
pictures
I built a Shiny app where I create some plot from hist() and density() objects, both saved in a list into an .RDS file from another script file. So, in shiny I only read the .RDS and make the plot.
Everything is working now, except that I am not finding how to change the height of the highchart plot using the hchart() function. In my code, the way it was built, I cannot work with pipes "%>%", beacuse I am using hchart inside a purrr::map() function.
To explain better I created a small example, that follows.
# Example of how the objects are structured
list <-
list(df1 = list(Sepal.Length = hist(iris$Sepal.Length, plot = FALSE)),
df2 = list(Sepal.Length = density(iris$Sepal.Length)))
# Example of a plot built with hchart function
list[['df2']]['Sepal.Length'] %>%
purrr::map(hchart, showInLegend = FALSE)
# Example of what does not work
list[['df2']]['Sepal.Length'] %>%
purrr::map(hchart, showInLegend = FALSE, height = 200)
Actually, I also would like to change more options of the chart, like colors, for example. But I am not finding a way with this solution I found.
Thanks in advance.
Wlademir.
I can see 2 main ways to do what you need (not sure why you can't use the pipe):
Option 1
Create a function to process every data and add the options inside that function:
get_hc <- function(d) {
hchart(d, showInLegend = FALSE) %>%
hc_size(height= 200) %>%
hc_title(text = "Purrr rocks")
}
Then:
list_of_charts <- list[['df2']]['Sepal.Length'] %>%
purrr::map(get_hc)
Option 2
You can use successively purrr::map:
list_of_charts <- list[['df2']]['Sepal.Length'] %>%
purrr::map(hchart, showInLegend = FALSE)
# change heigth
list_of_charts <- purrr::map(list_of_charts, hc_size, height = 200)
# change title
list_of_charts <- purrr::map(list_of_charts, hc_title. text = "Purrr rocks")
Or you can use successively purrr::map/ %>% combo:
list_of_charts <- list[['df2']]['Sepal.Length'] %>%
purrr::map(hchart, showInLegend = FALSE) %>%
purrr::map(hc_size, height = 200) %>%
purrr::map(hc_title, text = "Purrr rocks")
I am looking for a help to generate a 'rtf' report from R (dataframe).
I am trying output data with many columns into a 'rtf' file using following code
library(rtf)
inp.data <- cbind(ChickWeight,ChickWeight,ChickWeight)
outputFileName = "test.out"
rtf<-RTF(paste(".../",outputFileName,".rtf"), width=11,height=8.5,font.size=10,omi=c(.5,.5,.5,.5))
addTable(rtf,inp.data,row.names=F,NA.string="-",col.widths=rep(1,12),header.col.justify=rep("C",12))
done(rtf)
The problem I face is, some of the columns are getting hide (as you can see last 2 columns are getting hide). I am expecting these columns to print in next page (without reducing column width).
Can anyone suggest packages/techniques for this scenario?
Thanks
Six years later, there is finally a package that can do exactly what you wanted. It is called reporter (small "r", no "s"). It will wrap columns to the next page if they exceed the available content width.
library(reporter)
library(magrittr)
# Prepare sample data
inp.data <- cbind(ChickWeight,ChickWeight,ChickWeight)
# Make unique column names
nm <- c("weight", "Time", "Chick", "Diet")
nms <- paste0(nm, c(rep(1, 4), rep(2, 4), rep(3, 4)))
names(inp.data) <- nms
# Create table
tbl <- create_table(inp.data) %>%
column_defaults(width = 1, align = "center")
# Create report and add table to report
rpt <- create_report("test.rtf", output_type = "RTF", missing = "-") %>%
set_margins(left = .5, right = .5) %>%
add_content(tbl)
# Write the report
write_report(rpt)
Only thing is you need unique columns names. So I added a bit of code to do that.
If docx format can replace rtf format, use package ReporteRs.
library( ReporteRs )
inp.data <- cbind(ChickWeight,ChickWeight,ChickWeight)
doc = docx( )
# uncomment addSection blocks if you want to change page
# orientation to landscape
# doc = addSection(doc, landscape = TRUE )
doc = addFlexTable( doc, vanilla.table( inp.data ) )
# doc = addSection(doc, landscape = FALSE )
writeDoc( doc, file = "inp.data.docx" )