2016-06-30 2 views
3

Возможно ли создать таблицу в R с несколькими строками, соответствующими одной строке? И напишите результирующую таблицу в pdf. Таблица образцов приведена ниже. sample tableТаблица в r с несколькими подстроками и написать в pdf

Возможно ли соединить две отдельные таблицы способом, показанным на изображении. Пример кода для двух таблиц приведены ниже

tab1="Test Description 
1 test1 description 
2 test2 description" 
table1 <-read.table(text = tab1,header = TRUE) 

tab21="Cause Probability Feedback 
1 cause1 .5 positive 
2 Cause2 .2 negative 
3 Cause3 .1 negative 
4 Cause4 .2 negative" 
table2 <-read.table(text = tab21,header = TRUE) 

tab22="Cause Probability Feedback 
1 cause1 .7 positive 
2 Cause2 .2 negative 
3 Cause3 .1 negative" 
table3 <-read.table(text = tab22,header = TRUE) 
+2

Можете ли вы пересмотреть свой код, чтобы генерировать данные в нужном формате? – mtoto

+0

У меня есть данные только в том формате, который я предоставил. Мне нужно создать кадр данных или таблицу, как показано на изображении. –

ответ

2

Это немного сложнее, но я бы воспользоваться тем, что клетки с НСБУ печатаются пустые по print.xtable -функции , Ячейки не действительно «слиты», но выглядит так, когда содержимое выровнено сверху.

В основном шаги:

  1. Сформировать подходящую data.frame в R
  2. Распечатать совместимый таблицу .tex использование print.xtable из пакета 'xtable'
  3. Используйте Sweave/knitr/etc для создания подходящего .tex
  4. tools :: texi2pdf затем преобразует ваш .tex в подходящий .pdf

Вот файлы, вам нужно только подключим RunSweave.R в вашем R терминале (и убедитесь, что LaTeX устанавливается вместе с необходимыми пакетами, т.е. «xtable и имеют файлы в одной папке; это было запущено в Windows).

Файл StackExampleCode.R:

# StackExampleCode.R 
library(xtable) 

# A work-around by setting rows in the multi-row to NA after the initial top-justified line 
header <- data.frame(test = "Tests", det = "Details", cause = "Cause", prob = "Probability", fb = "Feedback") 
# Filling the fields for these is something you'd probably want to do in R in a more sophisticated manner 
test1 <- data.frame(
    test = c("Test 1", NA, NA, NA, NA), 
    det = c("Description", NA, NA, NA, NA), 
    cause = c("Cause 1", NA, paste("Cause", 2:4)), 
    prob = c(".5", NA, ".2", ".1", ".2"), 
    fb = c("positive", NA, "negative", "negative", "negative") 
) 
test2 <- data.frame(
    test = c("Test 2", NA, NA, NA), 
    det = c("Description", NA, NA, NA), 
    cause = c(paste("Cause", 1:3), NA), 
    prob = c(".7", ".1", ".2", NA), 
    fb = c("positive", "negative", "negative", NA) 
) 
# Bind it all together, you probably want something similar if it's automatic data you're generating 
tab <- rbind(header, test1, test2) 

Файл StackExampleRnw.Rnw:

% StackExampleRnw.Rnw 
% Note the different comment char, writing .tex here 
\documentclass{article} 

\begin{document} 

<<echo=FALSE, results=tex>>= 
# Printing the table 
print(
    xtable(tab, 
     align = "|l|l|l|l|l|l|" # Create the desired vertical lines and text alignments ala LaTeX; left align with vertical lines in-between each column) 
    ), 
    add.to.row = list(# Add horizontal lines to correct spots, should be adjusted according to the desired data 
     pos = list(-1, 1, 6, nrow(tab)), 
     command = c("\\hline \n", "\\hline \n", "\\hline \n", "\\hline \n") # Horizontal lines and a neater formatting of output using a linechange 
    ), 
    include.rownames = FALSE, # Don't include the rownames (which would be just numbers) 
    include.colnames = FALSE, # Don't include the rownames, these were already included as if it was an ordinary table row 
    hline.after = NULL # Suppress the empty horizontal line that is intended for an automated caption 
) 
@ 
\end{document} 

Файл RunSweave.R:

# RunSweave.R 

# Run the code 
source("StackExampleCode.R") 
# Bundle R code with LaTeX 
Sweave("StackExampleRnw.Rnw") 
# .tex -> .pdf 
tools::texi2pdf("StackExampleRnw.tex") 

Вот как это выглядит для меня в StackExampleRnw.pdf:

enter image description here

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

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

1

Я хотел был бы сделать это в pixiedust путем слияния некоторых ячеек, но, похоже, у меня есть недостаток в pixiedust, который не допускает вертикальные границы на объединенные строки. Обходной путь использует подход Teemu для установки ячеек, которые мы не хотим просматривать до NA, и направляя их для печати в виде пустых символов.

library(dplyr) 
library(pixiedust) 

table2$Test <- "test1" 
table3$Test <- "test2" 

bind_rows(
    right_join(table1, table2), 
    right_join(table1, table3) 
) %>% 
    mutate(Description = as.character(Description)) %>% 
    group_by(Test) %>% 
    mutate(Description = ifelse(duplicated(Description), NA, Description)) %>% 
    ungroup() %>% 
    mutate(Test = ifelse(duplicated(Test), NA, Test))%>% 
    dust(float = FALSE) %>% 
    sprinkle(cols = 1:2, 
      rows = c(4, 7), 
      border = "bottom") %>% 
    sprinkle(cols = 1:2, 
      rows = 1, 
      border = "top") %>% 
    sprinkle(cols = 1:2, 
      border = "left", 
      na.string = "") %>% 
    medley_all_borders(cols = 3:5) %>% 
    medley_all_borders(part = "head") %>% 
    sprinkle_print_method("latex") 

полный, рабочий файл RMD будет:

--- 
title: "Untitled" 
output: pdf_document 
header-includes: 
- \usepackage{amssymb} 
- \usepackage{arydshln} 
- \usepackage{caption} 
- \usepackage{graphicx} 
- \usepackage{hhline} 
- \usepackage{longtable} 
- \usepackage{multirow} 
- \usepackage[dvipsnames,table]{xcolor} 

--- 

```{r, echo = FALSE, message = FALSE, warning = FALSE} 
library(dplyr) 
library(pixiedust) 

tab1="Test Description 
1 test1 description 
2 test2 description" 
table1 <-read.table(text = tab1,header = TRUE) 

tab21="Cause Probability Feedback 
1 cause1 .5 positive 
2 Cause2 .2 negative 
3 Cause3 .1 negative 
4 Cause4 .2 negative" 
table2 <-read.table(text = tab21,header = TRUE) 

tab22="Cause Probability Feedback 
1 cause1 .7 positive 
2 Cause2 .2 negative 
3 Cause3 .1 negative" 
table3 <-read.table(text = tab22,header = TRUE) 
``` 

```{r, echo = FALSE, message = FALSE, warning = FALSE} 
table2$Test <- "test1" 
table3$Test <- "test2" 

bind_rows(
    right_join(table1, table2), 
    right_join(table1, table3) 
) %>% 
    mutate(Description = as.character(Description)) %>% 
    group_by(Test) %>% 
    mutate(Description = ifelse(duplicated(Description), NA, Description)) %>% 
    ungroup() %>% 
    mutate(Test = ifelse(duplicated(Test), NA, Test))%>% 
    dust(float = FALSE) %>% 
    sprinkle(cols = 1:2, 
      rows = c(4, 7), 
      border = "bottom") %>% 
    sprinkle(cols = 1:2, 
      rows = 1, 
      border = "top") %>% 
    sprinkle(cols = 1:2, 
      border = "left", 
      na.string = "") %>% 
    medley_all_borders(cols = 3:5) %>% 
    medley_all_borders(part = "head") 
```