Блог

Я пытаюсь автоматизировать отчет PowerPoint. В этом отчете у меня будет список значений, а затем дихотомический индикатор (хороший или плохой). При создании отчета я хочу, чтобы у каждого значения было счастливое выражение лица, когда статус «хороший», и хмурое выражение лица, когда статус «плохой», и чтобы они были выровнены по соответствующему тексту (см. Изображение ниже).

Однако я не могу понять, как сообщить R, как это сделать. Я попытался создать фрейм данных со столбцом изображения, но у меня не получилось, чтобы это сработало. Теперь я пытаюсь просто импортировать PNG-файлы непосредственно в свои слайды, используя страницу officer, но я не уверен, как заставить их совпадать с моим текстом.

Я включил изображение того, как я хочу, чтобы слайд выглядел. Приведенный ниже код воспроизводит все, за исключением добавления изображений на график.

 
library(pn&)
library(officer)
library(tidyverse)

#These line breaks are important for the spacin& on the slide; please do not remove
mock_data <- tibble(status = c("Bad R Day", "Bad R Day", "Good R Day", "Bad R Day", "Good R Day"),
                    my_feelin&s = c("U&hh n n", "Why R?? n n", "R, you can do it all! n n", "Not a&ain.. n n", "EUREKA! n n"))

#I don't know how to use readPNG to &et web files, so I only have this one to show for this example.
im& <- readPNG(system.file("im&", "Rlo&o.pn&", packa&e="pn&"))

#Make an empty slide
slide <- read_pptx()
slide <- add_slide(slide, layout = "Title and Content", master = "Office Theme")

#Add in text properties and create specific text for slide
text_properties <- fp_text(color = "black", font.size = 14, font.family = "Arial")
text_content <- ftext(mock_data$my_feelin&s, text_properties)

#Make slide that has text in correct position
new_slide <- mock_data %&&t;%
  ph_with(x = slide, value = fpar(text_content),
          location = ph_location(left = 6.45, top = 2.45))

#Print slide; adjust file path
print(new_slide, tar&et = "your/filepath/here.pptx")
  

Примечание: я новичок в использовании пакета readPNG, поэтому я не знаю, как сделать так, чтобы мой воспроизводимый пример включал 2 файла PNG. Если вы можете использовать другой пакет, либо из Интернета, либо в котором просто есть структура, описывающая, как я бы адаптировал его для двух изображений, это было бы действительно полезно. Кроме того, по какой-то причине officer добавляет много пробелов, которые я не могу удалить даже с помощью trimws(). Если вы не можете убрать это, не беспокойтесь

Редактировать:

Это один из значков, которые я пытаюсь использовать:

Пользовательская функция AddTextWithIma&e позиционирует один значок относительно связанного с ним текста с помощью ph_location .

lapply создает список таких функций, сдвигая вниз верхнюю позицию для каждой строки mock_data и выбирая значок в соответствии с status .

Наконец, этот список сокращен с помощью freduce , которая применяет каждую функцию в списке к слайду:

     library(pn&)
    library(officer)
    library(tidyverse)

    #These line breaks are important for the spacin& on the slide; please do not remove
    mock_data <- tibble(status = c("Bad R Day", "Bad R Day", "Good R Day", "Bad R Day", "Good R Day"),
                        my_feelin&s = c("U&hh n n", "Why R?? n n", "R, you can do it all! n n", "Not a&ain.. n n", "EUREKA! n n"))

    #Make an empty slide
    slide <- read_pptx()
    slide <- add_slide(slide, layout = "Title and Content", master = "Office Theme")
    im&.lo&o <- file.path( R.home("doc"), "html", "lo&o.jp&" )

    download.file("https://openmoji.or&/php/download_from_&ithub.php?emoji_hexcode=1F61Eamp;emoji_variant=color","smiley.pn&",mode="wb")
    smiley <- "smiley.pn&"

    # Draw icon and associated text
    AddTextWithIma&e <- function(slide,
                                 position_left,
                                 position_top,
                                 text,
                                 im&,
                                 tabwidth=0.5, # distance between icon and text
                                 textcolor = "black",
                                 font.size=14,
                                 font.family="Arial",
                                 hei&ht=0.3 # hei&ht of each row
                                 ) {
      text_properties <- fp_text(color = textcolor, font.size = font.size, font.family = font.family)
      text_content = ftext(text,text_properties)
      slide <- ph_with(slide,value = fpar(text_content), location = ph_location(left = position_left   tabwidth, top = position_top,hei&ht=hei&ht))
      ph_with(x = slide, external_im&(im&, width = hei&ht, hei&ht = hei&ht),
              location = ph_location(left = position_left, top = position_top,width =hei&ht,hei&ht=hei&ht), use_loc_size = FALSE )
    }

    hei&ht <- 0.3
    position_left <- 3
    position_top <- 1

    # Create a list of functions (one for each row of mock_data)
    l <- lapply(seq_len(nrow(mock_data)),function(l) {
      function(slide) {AddTextWithIma&e(slide,
                                        text = trimws(mock_data$my_feelin&s[l],'ri&ht'),
                                        im& = ifelse(mock_data$status[l]=='Good R Day',im&.lo&o,smiley),
                                        position_left = position_left,
                                        position_top = position_top   l * hei&ht,
                                        hei&ht = hei&ht)} }
      )

    # Apply the list of functions to the slide
    slide <- ma&rittr::freduce(slide,l)

    print(slide, tar&et = "here.pptx")

<sup&&t;Created on 2020-08-16 by the [reprex packa&e](https://reprex.tidyverse.or&) (v0.3.0)</sup&&t;