Работа с размером бара и итогами, когда позиция ggplot «складывается» в сплит-чартах - PullRequest
Новая
       7

Работа с размером бара и итогами, когда позиция ggplot «складывается» в сплит-чартах

0 голосов
/ 21 февраля 2020

При использовании стиля «стек» (не «dodge»), как с geom_bar или geom_col, итоги скомпрометированы с масштабом журнала . Мне удается представить правильное итоговое значение простым способом (разделенная диаграмма), когда ОДНО из значений заметно чаще, чем другие, см. Обходной путь (не журнал). Но общая проблема остается для других случаев и логарифмических масштабов . Я бы попросил универсальное -автоматическое решение.

РЕДАКТИРОВАТЬ: После прочтения ggplot scale_y_log10 () проблема , я обнаружил, что нет смысла использовать журнал. Таким образом, ответ на этот вопрос должен заключаться в том, как обобщить разделенный подход = обходной путь - не только для одной частой группы -. 

mydf2<-data.frame(date=c(rep("2020-02-01",25),rep("2020-02-01",25),rep("2020-02-02",35),rep("2020-02-02",40) ),
                  value= c(rep(LETTERS[1],39),rep(LETTERS[1:3],4),rep(LETTERS[1],39),rep(LETTERS[2],35) ) , stringsAsFactors = FALSE)

dateValueCount<-setDT(mydf2)[, .N, by=.(date, value)]
dateValueCount
#          date value  N
# 1: 2020-02-01     A 43
# 2: 2020-02-01     B  4
# 3: 2020-02-01     C  3
# 4: 2020-02-02     C  1
# 5: 2020-02-02     A 39
# 6: 2020-02-02     B 35

library(scales)
prevalent1<-ggplot(mydf2, aes(date, fill = value)) + 
  geom_bar() + scale_y_continuous(breaks= breaks_pretty())

prevalent1log<-ggplot(mydf2, aes(date, fill = value)) + 
  geom_bar() +  scale_y_continuous(trans='log2', breaks = log_breaks(7), 
                                   labels= label_number_auto()
  )
# total Problem, real totals are 50 and 75
{
  require(grid)
  grid.newpage()
  pushViewport(viewport(layout = grid.layout(1, 2)))
  pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 1))
  print(prevalent1,newpage=F) 
  popViewport()
  pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 1))
  print( prevalent1log, newpage = F )
}

enter image description here

обходной путь (только для одного преобладающего значения).

Ответ должен решить 2-ю дату и все возможные случаи превышения порога 

mydf3<-mydf2[which(mydf2$date=="2020-02-01")]

dateValueCount3<-dateValueCount[which(dateValueCount$date=="2020-02-01"),]
# get the most frequent per group

mydf3Max<-dateValueCount3[, .SD[  N== max(N) ]  , by=date]  
mydf3Max

#          date value  N
# 1: 2020-02-01     A 43


# totals per group
dateCount<-mydf3[, .N, by=.(date)]
dateCount
#          date  N
# 1: 2020-02-01 50

# transfer column to previous table
mydf3Max$totalDay <- dateCount$N[match(mydf3Max$date, dateCount$date)]

threshold <- 10 # splitting threshold

# remove groups with total lower than threshold
mydf3Max<-mydf3Max[which(mydf3Max$totalDay>threshold),]

# the final height of A will be dependent on the values of B and C
mydf3Max$diff<-mydf3Max$totalDay-mydf3Max$N

# shrinkFactor for the upper part of the plot which begins in threshold
shrinkFactor<-.05

# part of our frequent value (A) count must not be shrinked
mydf3Max$notshrink <- threshold - mydf3Max$diff

# part of A data (> threshold) must be shrinked
mydf3Max$NToShrink<-mydf3Max$N-mydf3Max$notshrink

mydf3Max$NToShrinkShrinked<-mydf3Max$NToShrink*shrinkFactor

# now sum the not-shrinked part with the shrinked part to obtain the transformed height
mydf3Max$NToShrinkShrinkedPlusBase<-mydf3Max$NToShrinkShrinked+mydf3Max$notshrink

# transformation function  - works for "dodge" position
# https://stackoverflow.com/questions/44694496/y-break-with-scale-change-in-r
trans <- function(x){pmin(x,threshold) + shrinkFactor*pmax(x-threshold,0)}
# dateValueCount3$transN <- trans(dateValueCount3$N)

setDF(dateValueCount3)
setDF(mydf3Max)

# pass transformed column to original d.f.
dateValueCount3$N2 <- mydf3Max$NToShrinkShrinkedPlusBase[match(interaction( dateValueCount3[c("value","date")]) ,
                                                              interaction( mydf3Max[c("value","date") ] )  )]

# substitute real N with transformed values
dateValueCount3[which(!is.na(dateValueCount3$N2)),]$N <- dateValueCount3[which(!is.na(dateValueCount3$N2)),]$N2

yticks <- c(0, 2,4,6,8,10,20,30,40,50)

ggplot(data=dateValueCount3, aes(date, N, group=value, fill=value)) + #group=longName
  geom_col(position="stack") +
  geom_rect(aes(xmin=0, xmax=3, ymin=threshold, ymax=threshold+.1), fill="white") +
  scale_y_continuous(breaks = trans(yticks), labels= yticks)

enter image description here

...