r 常见绘图任务的语法与ggplot2和plotly

Posted 2021-05-23

## section 1: dygraphs ####

# plotting stock prices

library(ggplot2)
library(xts)
library(dygraphs)

# Get stock data from Yahoo Finance
# Use this link for details on how to specify time period
# https://code.google.com/p/yahoo-finance-managed/wiki/csvHistQuotesDownload
avgo_url <- "http://real-chart.finance.yahoo.com/table.csv?s=AVGO&a=04&b=28&c=2015&d=09&e=05&f=2015&g=d&ignore=.csv"
swks_url <- "http://real-chart.finance.yahoo.com/table.csv?s=swks&a=04&b=28&c=2015&d=09&e=05&f=2015&g=d&ignore=.csv"

yahoo.read <- function(url){
  dat <- read.table(url,header=TRUE,sep=",")
  df <- dat[,c(1,5)]
  df$Date <- as.Date(as.character(df$Date))
  return(df)}

avgo  <- yahoo.read(avgo_url)
swks <- yahoo.read(swks_url)

# dygraph() needs xts time series objects
avgo_xts <- xts(avgo$Close/tail(avgo$Close, n = 1),order.by=avgo$Date,frequency=365)
swks_xts <- xts(swks$Close/tail(swks$Close, n = 1),order.by=swks$Date,frequency=365)

stocks <- cbind(avgo_xts,swks_xts)

dygraph(stocks,ylab="Close", 
        main="avgo and Linkedin Closing Stock Prices") %>%
  dySeries("..1",label="avgo") %>%
  dySeries("..2",label="swks") %>%
  dyOptions(colors = c("blue","brown")) %>%
  dyRangeSelector()

## section 2: plotly ####

# use ggplotly to wrap a ggplot object; remove legend

ggplotly(
ggplot() + 
  geom_line(data = sim.prices.long.select, aes(x = Delmo, y = Price, group = SimNo), 
                     color = 'dodgerblue', size = 0.1) +
  geom_line(data = sim.prices.long.select, aes(x = Delmo, y = Forward_Price),
            color = 'black', size = 0.5, position = 'identity') + 
  scale_x_date(expand = c(0,0), date_breaks = '1 month', labels = date_format('%y-%m')) +
  facet_grid(Component + Segment ~., scales = 'free_y') + 
  theme(legend.position = 'none', axis.text.x = element_text(angle = 90))
) %>% config(displayModeBar = F)  # removes the interaction bar
             

# use drop down menus to update data on a single chart

p <- plot_ly(df, x = ~ Jan18, type = "histogram") %>%
  layout(
    title = "Drop down menus - Styling",
    yaxis = list(title = "count"),
    updatemenus = list(
      list(
        buttons = list(
          list(method = "restyle",
               args = list("x", list(df$Jan18)),  # put it in a list
               label = "Show Jan"),
          list(method = "restyle",
               args = list("x", list(df$Feb18)),
               label = "Show Feb")))
    ))

# add overlaying histograms using a for loop, change legend

p <- plot_ly(df[Delmo == as.Date('2018-01-01'),], x = ~ pkPrice, 
             type = 'histogram', name = as.character('2018-01-01'), alpha = 0.5, 
             autobinx = FALSE, xbins = list(start = 0, end = 200, size = 2.5))

for (i in 2:length(unique(df$Delmo))){
  p <- add_histogram(p, df[Delmo == unique(df$Delmo)[i], pkPrice], 
                     type = 'histogram', name = as.character(unique(df$Delmo)[i])) %>%
                     layout(barmode = 'overlay', legend = list(orientation = 'h', xanchor = 'center'))
}

# Use plotly::subplot to arrange multiple plots and add annotations
subplot(p1, p2, p3, nrows = 3, margin = 0.05, shareX = FALSE) %>% 
  layout(annotations = list(
  list(x = 1, y = 0.1, text = "Off Peak Distribution", xref = 'paper', yref = 'paper', showarrow = FALSE),
  list(x = 1, y = 0.5, text = "Peak Power Distribution", xref = 'paper', yref = 'paper', showarrow = FALSE),
  list(x = 1, y = 0.9, text = "NG Distribution", xref = 'paper', yref = 'paper', showarrow = FALSE))

## section 3: ggplot2, gridExtra ####
         
# axis and tick text formatting
ggplot(rslts.gas.both[which(rslts.gas.both$Component == "TRZ6  "),], 
       aes(x=Date, y=Price)) + 
  geom_line() + facet_grid(. ~ Year, scales = "free_x") + 
  coord_cartesian(ylim = c(0, 20))  +
  theme(axis.text.x = element_text(angle = 90))

# Density (bar) chart example
cf.plot.dtm <- ggplot(cf.summary, aes(x = idx, y = diff_to_mean)) + 
  geom_bar(stat = "identity") + 
  theme(legend.position = 'bottom', axis.text.x = element_text(angle = 90)) + 
  scale_y_continuous(labels = percent) + facet_grid (plant ~.)
  
# Multiple line chart (with grouping) example
graph.forecast_ <- ggplot (forecast_[which(forecast_$plant == "Langford"),], 
                           aes(x = hour, y = trans_mw, group = month, colour = month)) +
                  geom_smooth(se=FALSE) + facet_grid(peakday ~ .) + ggtitle ("Langford") +
                  scale_x_continuous(breaks = seq (1, 24, 4), minor_breaks = NULL)
                                                        
# More scale_ examples
cor.plot <- ggplot(concord.cor, aes(x = yearmon, y = correlation, 
                                    group = plant, color = plant, fill = plant)) + 
  geom_bar(stat = 'identity', position = 'dodge') + 
  theme(legend.position = 'bottom', axis.text.x = element_text(angle = 90)) +
  scale_x_date(expand = c(0,0), labels = date_format('%y-%m'), breaks = '1 month') +
  scale_y_continuous(labels=percent)
         
# Even more scaling and theming examples
ng.plot <- ggplot(sim.returns.final.ng, aes(x = Monthsout, y = averageLoss)) + geom_line() +
  scale_x_date(date_breaks = "1 month", date_labels = "%b %Y", minor_breaks = NULL) +
  scale_y_continuous(limits = c(0, max(sim.returns.final.ng$averageLoss)+0.005), 
                     breaks = seq(0, max(sim.returns.final.ng$averageLoss)+0.005, 0.005),
                     minor_breaks = NULL) +
  theme(axis.text.x = element_text(angle = 90))        

ggplot(wind.plot.data, aes(x = ForwardDate, y = cum_Budget_Gen)) + 
   geom_ribbon(aes(ymin = cumMin, ymax = cumMax), fill = 'grey70') +
   geom_ribbon(aes(ymin = cum_Blend_P95_Gen, ymax = cum_Blend_P5_Gen), fill = 'gold') +
   geom_line(aes(y = cum_Actual_Gen, group = 1, colour = 'cum_Actual_Gen'), size = 1) + 
   geom_line(aes(y = cum_Budget_Gen, group = 1, colour = 'cum_Budget_Gen'), size = 1) +
   scale_color_manual(values = c('blue', 'black'),
                      labels = c('actual', 'budget')) + 
   scale_x_date(date_labels = "%b", date_breaks = '1 month') + xlab("Month") + 
   scale_y_continuous(name = 'Cumulative Generation', labels = comma) +
   labs(caption = paste("Probability of meeting budget by year end is ", 
                        round(wind.plot.data[12, c('probFail'), with = FALSE], 0),
                        "%", sep = "")) +
   ggtitle(paste(project.list[i])) +
   theme(legend.position = 'bottom', legend.title = element_blank(), plot.title = element_text(hjust = 0.5)))

# multiple charts using gridExtra::grid.arrange
moneyness.dens <- ggplot(all.sim.out.summary, aes(x = daysinmoney)) + geom_density() +
  ggtitle("density of days in the money")
margin.dens <- ggplot(all.sim.out.summary, aes(x = avemargin)) + geom_density() +
  ggtitle("density of ave margin")
grid.arrange (moneyness.dens, margin.dens, ncol = 2)\
         
# multiple charts using grid::pushViewport
pushViewport(viewport(layout = grid.layout(nrow =2, ncol = 2)))
print(p1, vp = viewport(layout.pos.row = 1, layout.pos.col = c(1,2)))
print(p2, vp = viewport(layout.pos.row = 2, layout.pos.col = 1))
print(p3, vp = viewport(layout.pos.row = 2, layout.pos.col = 2))

# chart with data table
# a) for data table
data_table <- ggplot(pred.wind.probs.t, aes(x = Month, y = as.factor(Stat), label = round(Pred_Gen, digits = 0))) + geom_text(size = 2) + 
  theme(pane
Layout <- grid.layout(nrow = 2, ncol = 1, heights = unit(c(2, 0.25), c('null', 'null')))
vplayout <- function(...) {l.grid.major = element_blank(), legend.position = 'none', axis.text.x = element_blank(), axis.ticks = element_blank(), 
        plot.margin = unit(c(-0.5, 1, 0, 1.5), 'line')) + xlab('') + ylab('') # margin: top right bottom left

# b) for boxplot below data table
data_plot <- ggplot(pred.wind, aes(x = Month, y = Predicted_Gen, group = Month)) + geom_boxplot() + geom_jitter(width = 0.2) +
  scale_x_continuous(breaks = seq(1:12), labels = month.abb) + xlab('') + 
  scale_y_continuous('Predicted Generation', labels = comma)

  grid.newpage()
  pushViewport(viewport(layout = Layout))
}
subplot <- function(x, y) viewport(layout.pos.row = x,
                                   layout.pos.col = y)
mmplot <- function(a, b){
  vplayout()
  print(a, vp = subplot(1, 1))
  print(b, vp = subplot(2, 1))
}
mmplot(data_plot, data_table)
         
# use factors for ordering and flip axes
temp4.summary <- temp4.summary[with(temp4.summary, order(rank_mean)),]
temp4.summary$BOOK <- factor(temp4.summary$BOOK, levels = temp4.summary$BOOK)
p <- ggplot(temp4.summary, aes(x = BOOK, y = mean/10^6)) + geom_bar(stat = 'identity') + 
  geom_errorbar(aes(ymin = pctDn/10^6, ymax = mean/10^6, color = 'red')) +
  labs(title = "Summary distribution by mean rank", x = "Book", y = "$MM") + 
  coord_flip() + theme(legend.position = 'none')
         
# Add caption using gridExtra::arrangeGrob and grid::grid.draw (continued)
footnote <- "Footnote1\nFootnote2"
g <- arrangeGrob(p, bottom = textGrob(footnote, x = 0, hjust = -0.1,
                                       vjust = 0.1, gp = gpar(fontface = "italic", fontsize = 12)))
grid.draw(g)

## section 4: animation ####
dlist <- as.numeric(unlist(test[, .(DELMO)]))
test.plot <- function(i){
  ggplot(data = test[DELMO <= dlist[i]],
       aes(x = DELMO, y = meanPrice, group = SEG, color = SEG)) + geom_line(size = 1) +
  scale_x_date(breaks = seq(as.Date(min(dlist)), as.Date(max(dlist)), '1 month'),
               date_labels = '%m/%y', limits = c(min(as.Date(dlist)), max(as.Date(dlist)))) +
    theme(axis.text.x = element_text(angle = 90)) + ylim(c(0, 100)) +
    labs(x = "month", y = "average price", title = "PJM West Historical RT Prices",
         caption="\naverage monthly prices from real time LMPs", subtitle = "write somthing here")
}

oopt <- ani.options(interval = 0.15)
saveGIF({for (i in 1:length(dlist)){
  g <- test.plot(i)
  print(g)
  print(i)
  ani.pause()
}
  }, movie.name = 'historical monthly average lmp.gif', ani.width = 750, ani.height = 400)