Buat objek ggplotly dengan subtitle

Oct 30 2020

Saya merencanakan Scatterplot dengan ggplot()sebagai berikut:

library(data.table)
library(plotly)
library(ggplot2)
library(lubridate)

dt.allData <- data.table(date = seq(as.Date('2020-01-01'), by = '1 day', length.out = 365),
                         DE = rnorm(365, 4, 1), Austria = rnorm(365, 10, 2), 
                         Czechia = rnorm(365, 1, 2), check.names = FALSE)

## Calculate Pearson correlation coefficient: ##
corrCoeff <- cor(dt.allData$Austria, dt.allData$DE,  method = "pearson", use = "complete.obs")
corrCoeff <- round(corrCoeff, digits = 2)

## Linear regression function extraction by creating linear model: ##
regLine <- lm(DE ~ Austria, data = dt.allData)

## Extract k and d values for the linear function f(x) = kx+d: ##
k <- round(regLine$coef[2], digits = 5) d <- round(regLine$coef[1], digits = 2)
linRegFunction <- paste0("y = ", d, " + (", k, ")x")

## PLOT: ##
p1 <- ggplot(data = dt.allData, aes(x = Austria, y = DE, 
                                    text = paste("Date: ", date, '\n',
                                                 "Austria: ", Austria, "MWh/h", '\n',
                                                 "DE: ", DE, "\u20ac/MWh"),
                                    group = 1)
      ) +
      geom_point(aes(color = ifelse(date >= now()-weeks(5), "#419F44", "#F07D00"))) +
      scale_color_manual(values = c("#F07D00", "#419F44")) +
      geom_smooth(method = "lm", se = FALSE, color = "#007d3c") +
      annotate("text", x = 10, y = 10,
               label = paste("\u03c1 =", corrCoeff, '\n',
                             linRegFunction), parse = TRUE) +
      theme_classic() +
      theme(legend.position = "none") +
      theme(panel.background = element_blank()) +
      xlab("Austria") +
      ylab("DE")+
      ggtitle("DE vs Austria") +
      theme(plot.title = element_text(hjust = 0.5, face = "bold"))

# Correlation plot converting from ggplot to plotly: #
plot <- plotly::ggplotly(p1, tooltip = "text")

yang memberikan plot berikut di sini:

Saya gunakan annotate()untuk mewakili koefisien korelasi dan fungsi regresi. Saya menentukan koordinat xdan ysecara manual sehingga output teks ditampilkan di tengah di atas. Karena saya memiliki beberapa tabel data dt.allDatayang memiliki skala sumbu berbeda, saya ingin mendefinisikan di plot bahwa teks harus selalu ditampilkan di tengah di atas, tergantung pada skala sumbu tanpa menentukan xdan ymengoordinasikan secara manual sebelumnya.

Jawaban

4 ismirsehregal Oct 30 2020 at 16:56

Saya sarankan menggunakan ggtitledan hjust = 0.5:

Edit: menggunakan plotly::layoutdan spantag untuk membuat judul:

library(data.table)
library(ggplot2)
library(plotly)
library(lubridate)

dt.allData <- data.table(date = seq(as.Date('2020-01-01'), by = '1 day', length.out = 365),
                         DE = rnorm(365, 4, 1), Austria = rnorm(365, 10, 2), 
                         Czechia = rnorm(365, 1, 2), check.names = FALSE)

## Calculate Pearson correlation coefficient: ##
corrCoeff <- cor(dt.allData$Austria, dt.allData$DE,  method = "pearson", use = "complete.obs")
corrCoeff <- round(corrCoeff, digits = 2)

## Linear regression function extraction by creating linear model: ##
regLine <- lm(DE ~ Austria, data = dt.allData)

## Extract k and d values for the linear function f(x) = kx+d: ##
k <- round(regLine$coef[2], digits = 5) d <- round(regLine$coef[1], digits = 2)
linRegFunction <- paste0("y = ", d, " + (", k, ")x")

## PLOT: ##
p1 <- ggplot(data = dt.allData, aes(x = Austria, y = DE, 
                                    text = paste("Date: ", date, '\n',
                                                 "Austria: ", Austria, "MWh/h", '\n',
                                                 "DE: ", DE, "\u20ac/MWh"),
                                    group = 1)
) +
  geom_point(aes(color = ifelse(date >= now()-weeks(5), "#419F44", "#F07D00"))) +
  scale_color_manual(values = c("#F07D00", "#419F44")) +
  geom_smooth(method = "lm", formula = 'y ~ x', se = FALSE, color = "#007d3c") +
  # ggtitle(label = paste("My pretty useful title", '\n', "\u03c1 =", corrCoeff, '\n', linRegFunction)) +
  theme_classic() +
  theme(plot.title = element_text(hjust = 0.5)) +
  theme(legend.position = "none") +
  theme(panel.background = element_blank()) +
  xlab("Austria") +
  ylab("DE")

# Correlation plot converting from ggplot to plotly: #
# using span tag (directly in control of font-size):
span_plot <- plotly::ggplotly(p1, tooltip = "text") %>% layout(
    title = paste(
      '<b>My pretty useful title</b>',
      '<br><span style="font-size: 15px;">',
      '\u03c1 =<i>',
      corrCoeff,
      '</i><br>',
      linRegFunction,
      '</span>'
    ),
    margin = list(t = 100)
  )
span_plot

Edit: menambahkan supalternatif sesuai jawaban ini

# using sup tag:
sup_plot <- plotly::ggplotly(p1, tooltip = "text") %>% layout(
    title = paste(
      '<b>My pretty useful title</b>',
      '<br><sup>',
      "\u03c1 =<i>",
      corrCoeff,
      '</i><br>',
      linRegFunction,
      '</sup>'
    ),
    margin = list(t = 100)
  )
sup_plot

BrianLang Oct 30 2020 at 16:42

Pertama, saya akan mulai dengan melihat apakah sesuatu seperti ini dapat membantu Anda:

annotate("text", 
         x = mean(dt.allData$Austria, na.rm = TRUE), y = max(dt.allData$DE, na.rm = TRUE),
         label = paste("\u03c1 =", 
                       corrCoeff, '\n',
                       linRegFunction), 
         parse = TRUE,
         hjust = .5)

dan kemudian, dalam kasus di mana Anda ingin melihat daftar x,ypasangan, Anda akhirnya ingin beralih ke pemrograman fungsional di mana Anda meneruskan xkolom x1, x2, x3dan ykolom y1, y2, y3ke mapfungsi yang kemudian menarik informasi yang relevan dari setiap pasangan. dan plot mereka.