如何在一个面上对值的多面条形图进行排序？

Question

我正在尝试根据其中一个方面的值来排序垂直刻面条形图（3个方面）的条形。具体来说，我希望最左边面板中的条形按减少值排序。我的数据基于多期基金回报。句点长度是一个方面;股票代码列表涵盖所有方面。我发现了很多类似的例子，但我无法重新排序x轴标签才能正常工作。我在更长的股票代码列表中使用下面的代码，但这应该是一个有效的例子：

require('ggplot2')
require('reshape2')
require('tseries')

symbs = c("XLE", "XLV", "XLK", "XLB", "SPY")
desc = c("Energy", "HealthCare", "Tech", "Materials", "S&P")
data = cbind(symbs, desc)

indexTickers = data[,1]
indexNames = data[,2]

latestDate =Sys.Date()

dailyPrices = lapply(indexTickers, function(ticker) get.hist.quote(instrument= ticker, start = "2012-01-01", 
                    end = latestDate, quote="Close", provider = "yahoo", origin="1970-01-01", compression = "d", retclass="zoo"))
perf5Day = lapply(dailyPrices, function(x){(x-lag(x,k=-5))/lag(x,k=-5)})
perf20Day = lapply(dailyPrices, function(x){(x-lag(x,k=-20))/lag(x,k=-20)})
perf60Day = lapply(dailyPrices, function(x){(x-lag(x,k=-60))/lag(x,k=-60)})

names(perf5Day) = indexTickers
names(perf20Day) = indexTickers
names(perf60Day) = indexTickers

perfsMerged = lapply(indexTickers, function(spdr){merge(perf5Day[[spdr]],perf20Day[[spdr]],perf60Day[[spdr]])})
perfNames = c('1Week','1Month','3Month')
perfsMerged = lapply(perfsMerged, function(x){
  names(x)=perfNames
  return(x)
})

latestDataPoints = t(sapply(perfsMerged, function(x){return(x[nrow(x)])}))

namesAndTickers = paste(indexNames, paste(' (',indexTickers,')',sep=''), sep='')

latestDataPoints = data.frame(cbind(namesAndTickers,latestDataPoints))

latestDataPoints[2:4] <- lapply( latestDataPoints[2:4], function(x) 
  as.numeric(as.character(x)))

names(latestDataPoints) = c('Ticker','5 Day','20 Day','60 Day')

drm = melt(latestDataPoints, id.vars=c('Ticker'))
posNeg =  ifelse(drm$value >= 0, 'pos','neg')

pcts = paste(round(100*drm$value, 2), "%", sep="")
drm = cbind(drm, posNeg, pcts)
names(drm) = c('Ticker','Period','Value','Sign','Pct')

ordered = drm[drm$Period=="5 Day",]
ordered = ordered[order(-ordered$Value),]
orderedSymbs = ordered$Ticker
orderedSymbs = c(orderedSymbs, orderedSymbs, orderedSymbs)

p = ggplot(drm, aes(x=reorder(Ticker, orderedSymbs),y=Value,fill=Sign)) + geom_bar(stat='identity') + facet_grid(. ~ Period,scales='free_y') + 
  coord_flip() + scale_fill_manual(values=c('pos'='darkgreen','neg'='red'),guide=FALSE) +
  ggtitle("Performances of Top Etfs by Trading Volume")

p = p + theme(plot.title = element_text(vjust = 2, size=rel(1.8), 
              face="bold"), axis.text.x=element_text(color='orangered4',size=rel(1.2)), 
              axis.text.y=element_text(color='orangered4',size=rel(1.2)), axis.title.x = element_blank(), 
              axis.title.y = element_blank(), strip.text.x = element_text(size=rel(1.2)))

p

Answer 1

这是工作版本。 除了代码的一些外观变化（我通常使用），唯一的主要变化是在进入ggplot之前重新排列因素。 希望这有帮助

require('ggplot2')
require('reshape2')
require('tseries')

symbs = c("XLE", "XLV", "XLK", "XLB", "SPY")
desc = c("Energy", "HealthCare", "Tech", "Materials", "S&P")
data = cbind(symbs, desc)

indexTickers = data[,1]
indexNames = data[,2]

latestDate =Sys.Date()

dailyPrices = lapply(indexTickers, function(ticker) get.hist.quote(instrument= ticker, start = "2012-01-01", 
                                                                   end = latestDate, quote="Close", provider = "yahoo", origin="1970-01-01", compression = "d", retclass="zoo"))
perf5Day = lapply(dailyPrices, function(x){(x-lag(x,k=-5))/lag(x,k=-5)})
perf20Day = lapply(dailyPrices, function(x){(x-lag(x,k=-20))/lag(x,k=-20)})
perf60Day = lapply(dailyPrices, function(x){(x-lag(x,k=-60))/lag(x,k=-60)})

names(perf5Day) = indexTickers
names(perf20Day) = indexTickers
names(perf60Day) = indexTickers

perfsMerged = lapply(indexTickers, function(spdr){merge(perf5Day[[spdr]],perf20Day[[spdr]],perf60Day[[spdr]])})
perfNames = c('1Week','1Month','3Month')
perfsMerged = lapply(perfsMerged, function(x){
  names(x)=perfNames
  return(x)
})

latestDataPoints = t(sapply(perfsMerged, function(x){return(x[nrow(x)])}))

namesAndTickers = paste(indexNames, paste(' (',indexTickers,')',sep=''), sep='')

latestDataPoints = data.frame(cbind(namesAndTickers,latestDataPoints))

latestDataPoints[2:4] <- lapply( latestDataPoints[2:4], function(x) 
  as.numeric(as.character(x)))

names(latestDataPoints) = c('Ticker','5 Day','20 Day','60 Day')

drm = melt(latestDataPoints, id.vars=c('Ticker'))
posNeg =  ifelse(drm$value >= 0, 'pos','neg')

pcts = paste(round(100*drm$value, 2), "%", sep="")
drm = cbind(drm, posNeg, pcts)
names(drm) = c('Ticker','Period','Value','Sign','Pct')

ordered = drm[drm$Period=="5 Day",]
ordered = ordered[order(-ordered$Value),]
orderedSymbs = ordered$Ticker

这是更改

# commented out this
# orderedSymbs = c(orderedSymbs, orderedSymbs, orderedSymbs)
# added this line, see http://www.r-bloggers.com/reorder-factor-levels-2/ for details
drm$Ticker = factor(drm$Ticker, levels(drm$Ticker)[as.numeric(orderedSymbs)])

这里有一些小修改

p = ggplot(drm, 
           aes(x=Ticker,
           y=Value,fill=Sign)
)

p = p + geom_bar(stat='identity') + facet_grid(. ~ Period,scales='free_y') 
p = p + coord_flip() + scale_fill_manual(values=c('pos'='darkgreen','neg'='red'),guide=FALSE) 
p = p + ggtitle("Performances of Top Etfs by Trading Volume")

p = p + theme(plot.title = element_text(vjust = 2, size=rel(1.8), face="bold"), axis.text.x=element_text(color='orangered4',size=rel(1.2)), axis.text.y=element_text(color='orangered4',size=rel(1.2)), axis.title.x = element_blank(), axis.title.y = element_blank(), strip.text.x = element_text(size=rel(1.2)))
print(p)