Rmarkdown Aggregate error

Question

Rmarkdown Aggregate error

Navigation

#1 by (0 votes)

0

Hello, I am trying to create reports by Rmarkdown, with the read_chunk() method it is possible to plot in doc using script.r externalization. In doing this integration, with only 1 script worked, when I put the second, an error occurred in the aggragate function, it claims that it does not have% rows to write. I'll detail the steps I take until I get the error:

1 °: Scripts in .R

Each of the two scripts contains a plot, they are geom_bar of library ggplot2 . to make this chart, X is usually put as a factor and pull the other information along the line as an array. To do this, I used the aggregate function in the two scripts indicated in an old question I made here in the stack.

Questions on ggplot on bars

Scratch script partN.R

dado <- data.frame("hora" = tab.genova$V1, "Mud" = tab.genova$V2, "Conf" = 
tab.genova$V3, "Alt" = tab.genova$V4, "DEM" = tab.genova$V4, "Cy" = tab.genova$V5)
agg <- aggregate(cbind(DEM, Alt, Conf, Mud, Cy) ~ hora, dado, sum)
molten <-melt(agg, id = "hora")

Scratch script chunk.R

data2 <- data.frame("dia" = tab.Roma$Dia,"ResolvidosFSR" = 
tab.Roma$Resolvidos_no_FSR, "Abertos" = tab.Roma$Abertos)
agg2 <- aggregate(cbind(tab.Roma$Resolvidos_no_FSR, tab.Roma$Abertos) ~ dia, data, sum)
molten2 <-melt(agg2, id = "dia2")

2 °: .Rmd code

'''{r LeituraDeDados, echo=FALSE, results='hide', warning=FALSE, 
message=FALSE}
library(lubridate)
library(ggplot2)
library(gtable)
library(grid)
library(extrafont)
library(data.table)
library(scales)
library(gridExtra)
library(tidyr)
library(reshape2)
library(knitr)
loadfonts(device="win")
# dê o set na pasta que está seus arquivos script.R, no meu caso tb os csv que eu usava.
setwd("C:/Users/admin/Desktop/testeMark")

# Esses read.csv eu uso aqui no meu pq tiro os dados no arquivo, coloquei aqui para ilustrar 
#que estou usando por este metódo e aqui no stack farei por dput (deve ser a mesma coisa).
#tab.genova <- read.csv(file="tab.genova.csv", sep=";")
#tab.Roma <- read.csv(file="tab.Roma.csv", sep=";")

'''

## Plot 1

'''{r echo=FALSE}
read_chunk('rascunhoN.R')
#Esse chunk está lendo e importando o script 'rascunhoN.R' com o primeiro plot
'''

'''{r rascunhoNplot.R , code=readLines("rascunhoN.R"), echo=FALSE, 
fig.align='right', fig.height=7.7522, fig.width= 11.816666666666666}
#Esse chunk está lendo o script importado e plotando.
'''

## plot2

'''{r echo=FALSE}
read_chunk('rascunho.R')
#Esse chunk está lendo e importando o script 'rascunho.R' com o segundo plot
'''

'''{r rascunho.R , code=readLines("rascunho.R"), echo=FALSE, fig.align= 
'center', fig.height=7.7522, fig.width= 11.816666666666666}
 #Esse chunk está lendo o script importado e plotando.
'''

3 °: ERROR

After giving Ctrl + shift + k

has the compilation of the file in .doc output, which generates this error:

 Quitting from lines 88-89 (teste.Rmd) 
 Error in aggregate.data.frame(lhs, mf[-1L], FUN = FUN, ...) : no rows to aggregate
 Calls: <Anonymous> ... aggregate -> aggregate.formula -> aggregate.data.frame

I'll leave the data and codes of the scripts:

rascunhoNplot.r

## @knitr rascunhoN.R


dados <- #...
agg <- aggregate(cbind(DEM, Alt, Conf, Mud, Cy) ~ hora, dado, sum)
molten <-melt(agg, id = "hora")

## @knitr rascunhoNplot.R
q1 <- ggplot(molten, aes(x = hora, y = value, fill = variable))+
  geom_bar(position = "stack", stat = "identity")+
  labs(x= NULL, y= NULL)+
  theme(axis.text.x = element_text( hjust = 1, vjust = 0.3))+
  scale_y_continuous(expand = c(0, 0),  breaks = pretty_breaks(8), sec.axis = sec_axis(~.*1, breaks = pretty_breaks(8)))+
  theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.3))+
  scale_fill_manual( values = c("#8AC5FF","#73C5FF", "#73B0EE", "#5EA9C9", "#5BC5AC"))+
  theme(
     axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.3, size = 14),
     panel.background = element_blank(), 
     panel.grid.minor = element_blank(), 
     panel.grid.major = element_line(color = "gray50", size = 0.5), 
     panel.grid.major.x = element_blank(),
     text = element_text(family="Simplon BP Light"),
     axis.text.y = element_text(size = 18),
     axis.title = element_text(color = "gray50", size = 14, family = "Simplon BP Light"),
     axis.ticks = element_line(colour = 'gray50'),
     axis.ticks.length = unit(.25, "cm"),
     axis.ticks.x = element_line(colour = "gray50"),
     legend.position="bottom",
     legend.title = element_blank(),
     axis.ticks.y = element_blank(),
     legend.text = element_text(colour="gray50", size=22,  family = "Simplon BP Light" ),
     legend.box = "horizontal",
     plot.margin = margin(15, 15, 15, 15),
     plot.title = element_text(hjust = 0.5, color = "gray50", size = 30, face = "bold", family = "Simplon BP Light"))

  q1

   #Dados:
   # ...
    dados <- structure(list(hora = structure(1:24, .Label = c("00:00", "01:00", 
   "02:00", "03:00", "04:00", "05:00", "06:00", "07:00", "08:00", 
   "09:00", "10:00", "11:00", "12:00", "13:00", "14:00", "15:00", 
   "16:00", "17:00", "18:00", "19:00", "20:00", "21:00", "22:00", 
   "23:00"), class = "factor"), Mud = c(4L, 3L, 0L, 0L, 2L, 0L, 
   1L, 1L, 2L, 2L, 1L, 2L, 0L, 1L, 1L, 1L, 6L, 5L, 0L, 0L, 2L, 2L, 
   0L, 3L), Conf = c(1L, 1L, 0L, 0L, 0L, 0L, 0L, 1L, 0L, 5L, 4L, 
   3L, 1L, 4L, 4L, 5L, 3L, 2L, 1L, 1L, 5L, 0L, 3L, 0L), AltSev = c(0L, 
   0L, 0L, 0L, 0L, 0L, 0L, 0L, 2L, 0L, 1L, 3L, 0L, 0L, 0L, 0L, 1L, 
   0L, 0L, 1L, 0L, 0L, 0L, 2L), DEM = c(0L, 1L, 0L, 0L, 0L, 
   0L, 1L, 0L, 4L, 2L, 1L, 2L, 1L, 2L, 4L, 3L, 2L, 2L, 1L, 0L, 1L, 
   0L, 1L, 0L), Cyber = c(0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 
   2L, 1L, 0L, 0L, 0L, 0L, 1L, 5L, 1L, 0L, 0L, 1L, 0L, 1L)), .Names = 
   c("hora", "Mud", "Conf", "Alt", "DEM", "Cy"), row.names = c(NA, 
   -24L), class = "data.frame")

scratch.R

   ## @knitr rascunho.R


   data2 <- #...
   agg2 <- aggregate(cbind(tab.Roma$Resolvidos_no_X, tab.Roma$Abertos) ~ 
   dia, data, sum)
   molten2 <-melt(agg2, id = "dia")


   q1 <- ggplot(molten2, aes(x = dia, y = value, fill = variable))+
   geom_bar(position = "dodge", stat = "identity")+
   labs(x= NULL, y= NULL)+
   theme(axis.text.x = element_text( hjust = 1, vjust = 0.3))+
   scale_y_continuous(expand = c(0, 0), limits = c(-0, 3000), breaks = 
   pretty_breaks(8))+
   scale_x_date(breaks=seq(min(tab.Roma$Dia), max(tab.Roma$Dia), by="1 day"),  date_labels="%d/%b", minor_breaks=seq(min(tab.Roma$Dia), max(tab.Roma$Dia), by="1 month"))+
   theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.3))+
   scale_fill_manual(labels = c("Resolvidos no X  ","Abertos  "), values = c("#00B0CC","#CC5200"))+
   theme(
       axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.3),
       panel.background = element_blank(), 
       panel.grid.minor = element_blank(), 
       panel.grid.major = element_line(color = "gray50", size = 0.5), 
       panel.grid.major.x = element_blank(),
text = element_text(family="Simplon BP Light"),
       axis.text.y = element_text(size = 14),
       axis.title = element_text(color = "gray50", size = 14, family = "Simplon BP Light"),
       axis.ticks = element_line(colour = 'gray50'),
       axis.ticks.length = unit(.25, "cm"),
       axis.ticks.x = element_line(colour = "gray50"),
       legend.position="bottom",
       legend.title = element_blank(),
       axis.ticks.y = element_blank(),
       legend.text = element_text(colour="gray50", size=10,  family = "Simplon BP Light" ),
       legend.box = "horizontal",
       plot.margin = margin(15, 15, 15, 15),
       plot.title = element_text(hjust = 0.5, color = "gray50", size = 14, face = "bold", family = "Simplon BP Light"))

   q2 <- ggplot(tab.Roma, aes(x = Dia))+
   geom_line(aes(y = Meta.X, colour = "Meta.X"), linetype = 4, size = 1.5)+
   geom_line(aes(y = X._Resolvidos, colour = "X._Resolvidos"), linetype= 1, size = 1.5)+
   geom_line(aes(y = X._Resolvidos_no_X, colour = "X._Resolvidos_no_X"), linetype = 1, size = 1.5)+
   labs(x= NULL, y= NULL)+
   theme(axis.text.x = element_text( hjust = 1, vjust = 0.3))+
   scale_y_continuous(expand = c(0, 0), limits = c(-0, 1), breaks = pretty_breaks(8), labels = scales::percent)+
   scale_x_date(breaks=seq(min(tab.Roma$Dia), max(tab.Roma$Dia), by="1 day"),  date_labels="%d/%b", minor_breaks=seq(min(tab.Roma$Dia), max(tab.Roma$Dia), by="1 month"))+
   theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.3))+
   scale_colour_manual(name = "", values = c("X._Resolvidos" = "#FFBB00", "X._Resolvidos_no_X" = "#484848", "Meta.X" = "#009600"), breaks=c("X._Resolvidos", "X._Resolvidos_no_X", "Meta.X"), labels=c("Abertos  \n    ( % ) ", "Resolvidos no X  \n            ( % )", "Meta X\n   ( 80% )"))+
   theme(
        panel.border = element_blank(),
        panel.background = element_rect(fill = "transparent"),
        panel.grid.minor = element_blank(), 
        panel.grid.major = element_blank(),
        axis.title = element_text(color = "gray50", size = 14, family = "Simplon BP Light"),
        text = element_text(family="Simplon BP Light"),
        axis.text.y = element_text(size=14),
        axis.text.x = element_text(size = 14),
        axis.ticks = element_line(colour = 'gray50'),
        axis.ticks.length = unit(.25, "cm"),
        axis.ticks.x = element_line(colour = "gray50"),
        legend.text = element_text(colour="gray50", size=10,  family = "Simplon BP Light" ),
        legend.position="bottom",
        legend.title = element_blank(),
        legend.box = "horizontal",
        axis.ticks.y = element_blank())

      g1 <- ggplot_gtable(ggplot_build(q1)) 
      g2 <- ggplot_gtable(ggplot_build(q2)) 
      pp <- c(subset(g1$layout, name == "panel", se = t:r)) 
      g <- gtable_add_grob(g1, g2$grobs[[which(g2$layout$name == "panel")]], pp$t, pp$l, pp$b, pp$l) 
      ia <- which(g2$layout$name == "axis-l") 
      ga <- g2$grobs[[ia]]
      ax <- ga$children[[2]]
      ax$widths <- rev(ax$widths) 
      ax$grobs <- rev(ax$grobs)
      g <- gtable_add_cols(g, g2$widths[g2$layout[ia, ]$l], length(g$widths) - 1) 
      g <- gtable_add_grob(g, ax, pp$t, length(g$widths) - 1, pp$b)



      leg1 <- g1$grobs[[which(g1$layout$name == "guide-box")]]
      leg2 <- g2$grobs[[which(g2$layout$name == "guide-box")]]


      g$grobs[[which(g$layout$name == "guide-box")]] <-
      gtable:::cbind_gtable(leg1, leg2, "first")


      plot(g)
  #dados:
  #...
  data2  <- structure(list(Dia = structure(c(17563, 17564, 17565, 17566, 17567, 17568, 17569, 17570, 17571, 17572, 17573, 17574, 17575, 17576, 17577, 17578, 17579, 17580, 17581, 17582, 17583, 17584, 17585, 17586, 17587, 17588, 17589, 17590), class = "Date"), Meta.X = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), .Label = "0,8", class = "factor"), 
X._Resolvidos = structure(c(5L, 9L, 1L, 3L, 10L, 11L, 9L, 
8L, 12L, 9L, 1L, 8L, 6L, 10L, 10L, 9L, 3L, 4L, 10L, 12L, 
11L, 11L, 10L, 7L, 12L, 13L, 13L, 2L), .Label = c("0,7", 
"0,76", "0,78", "0,79", "0,8", "0,81", "0,82", "0,83", "0,85", 
"0,86", "0,87", "0,88", "0,9"), class = "factor"), X._Resolvidos_no_X = structure(c(5L, 
3L, 1L, 5L, 9L, 6L, 6L, 5L, 4L, 10L, 7L, 4L, 8L, 5L, 8L, 
7L, 9L, 2L, 7L, 8L, 4L, 5L, 6L, 3L, 9L, 6L, 7L, 7L), .Label = c("0,87", 
"0,88", "0,89", "0,9", "0,91", "0,92", "0,93", "0,94", "0,95", 
"0,96"), class = "factor")), .Names = c("Dia", "Meta.X",  "X._Resolvidos", "X._Resolvidos_no_X"), row.names = c(NA, -28L), class = "data.frame")

r rstudio ggplot2 markdown

asked by anonymous 16.03.2018 / 15:48

1 answer

Format date from the SQL SERVER Database Problems alignment dropdown menu

score 0 · Accepted Answer

I broke my head to find the problem, the problem was aggregate same. Somehow Rmarkdown does not work with multiple aggregate in an instance, debugging the code I verified that this function was not necessary for the function of the script and that I only needed the melt() function. I then cut this function from my code, I used the magrittr package to use the% >% as forward-pipe operator and made the proper settings and adaptations.

 melted1 <- dados %>% melt(id.vars = "dia")

One tip, aggregate is very slow, using a large mass of data will weigh heavily on R rendering (which is not as efficient anymore). I recommend that you use the packages dplyr and tidyr to bypass, vi test on a stack post User Usa has proved that dplyr is 20 times faster.