Диаграммы сжимаются, а также плохое разрешение при экспорте отчета rmd в слово - PullRequest
0 голосов
/ 17 марта 2020

У меня есть отчет с графиками и таблицами. Для этого я использую офицерскую и гибкую библиотеку. Когда я экспортирую отчет в таблицы слов, все в порядке, но диаграммы не одинакового качества. Большие диаграммы выглядят очень сжатыми, а разрешение также очень низким.

ниже приведен пример отчета, показывающий, как я экспортирую отчет

---
title: "Test syntax generator"
output: 
  word_document:
    reference_docx: template.docx
    fig_width: 6
    fig_height: 4
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(
    echo = FALSE,
    message = FALSE,
    warning = FALSE
)
```


```{r include=FALSE}

#Loading libraries

library(data.table)
library(dplyr)
library(knitr)
library(ggplot2)
library(stringr)
library(scales)
library(readr)
library(expss)
library(officer)
library(flextable)

path<-"C:/Users/sandhya-ghildiyal/Desktop/SyntaxGenerator/R-version"
setwd(path)
template <- read_docx("template.docx")


d <- docx_dim(template) # to check dimensions of the Word page to later adjust width
av_d <- d$page["width"] - d$margins["left"] - d$margins["right"]
```

1.Gender

## A.   Gender 

### What is your gender?

```{r}
## footer can be any text about the table

test<-data.frame(gender=c("M","M","F",NA),Names=c("A","B","C","D"),Amount=c(3,4,2,5))

tab_std(test, "gender","Gender","footer","Title")
```
## Chart

```{r echo=FALSE}

donut(test,"gender")
```

Функции, используемые в этом отчете:

roundUp <- function(x){ifelse(round(abs(x-trunc(x)),1) == 0.5, trunc(x+0.5),round(x))}

specify_decimal <- function(x, k) trimws(format(round(x, k), nsmall=k))

masking_criteria<-c(3,4,5)

mask_m<-function(x,N){
  x= ifelse(N<masking_criteria[1],"--",x)
}

freq_for_charts<-function(data,var){
  data<- data[!is.na(data[[var]]),]
  T1<-as.data.frame(table(data[[var]]))
  T1<-T1%>% mutate(Q=as.character(Var1),Freq=as.numeric(Freq))%>% select(Q,Freq)
  all<-sum(T1[,2])
  T1[, 2:ncol(T1)]<- sapply(T1[, 2:ncol(T1)],function(x) ifelse(all<3,NA,round(x/all,4)))
  T1}

donut <- function(data, var) {

  table <- freq_for_charts(data, var) %>% filter(Freq != 0) %>% mutate(Freq = Freq * 100)
  mycols <- c("#00A8C8", "#33658A", "#002c77","#006D9E")
  mercer_theme()
  ggplot(table, aes(x = 2, y = Freq, fill = Q)) +
    geom_bar(stat = "identity", color = "white") +
    coord_polar(theta = "y", start = 0) +
    geom_text(aes(label = paste(roundUp(Freq), "%")), color = "white", fontface = "bold", size = 4, 
              position = position_stack(vjust = 0.5)) +
    scale_fill_manual(values = sapphire) +
    theme_void() + theme(legend.text = element_text(size = 12)) +
    xlim(0.5, 2.5) + theme(legend.position = "bottom", legend.title = element_blank()) + 
    guides(fill = guide_legend(nrow = 2, byrow = TRUE))
}

tab_std<-function(data, var, Name_of_variable, footer, Title) { 
  data <- data[!is.na(data[[var]]), ]
  T1 <- as.data.frame(table(data[[var]]))
  all <- sum(T1[, 2])
  T1 <- T1 %>% mutate(
    !!Name_of_variable := as.character(Var1),
    "Percent" = roundUp(Freq * 100 / all),
    "N" = as.numeric(Freq)
  ) %>%
    select(!!Name_of_variable, "Percent", "N")
  T1[ ,2]<-sapply(T1[,2], function(x) ifelse(x=="--","--",paste0(mask_m(x,all),"%")))

  T1%>% flextable()%>% add_header_lines(Title)%>% add_footer_lines(footer)
}

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

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...