文章/答案/技术大牛

发布

社区首页 >问答首页 >添加一个交互式按钮来切换映射到r中的哪个变量填充ggplotly

问添加一个交互式按钮来切换映射到r中的哪个变量填充ggplotly
EN

Stack Overflow用户

提问于 2021-03-03 08:02:15

回答 2查看 89关注 0票数 2

使用相同的数据集，我生成了两个不同的平铺图，如下所示：

数据：

> dput(coupler.graph)
structure(list(Category = c("HBC", "TC", "BSC", "GSC", "GSC", 
"SSC", "SSC", "GSC", "GSC", "SSC", "SSC", "SSC", "HBC", "TC", 
"BSC", "BSC", "GSC", "GSC", "SSC", "HBC", "HBC", "TC", "TC", 
"BSC", "GSC", "GSC", "GSC", "GSC", "GSC", "TC", "BSC", "BSC", 
"GSC", "GSC"), `Bar Size` = c("No. 5", "No. 5", "No. 5", "No. 5", 
"No. 5", "No. 6", "No. 6", "No. 6", "No. 6", "No. 8", "No. 8", 
"No. 8", "No. 8", "No. 8", "No. 8", "No. 8", "No. 8", "No. 8", 
"No. 10", "No. 10", "No. 10", "No. 10", "No. 10", "No. 10", "No. 10", 
"No. 10", "No. 10", "No. 11", "No. 11", "No. 18", "No. 18", "No. 18", 
"No. 18", "No. 18"), `No. Bars` = c(3, 9, 3, 6, 6, 85, 85, 7, 
7, 90, 90, 90, 7, 9, 6, 6, 21, 21, 9, 22, 22, 27, 27, 13, 25, 
25, 25, 8, 8, 4, 4, 4, 4, 4), Failure = c("Bar fracture", "Bar fracture", 
"Bar fracture", "Bar pullout", "Bar fracture", "Bar pullout", 
"Bar fracture", "Coupler failure", "Bar fracture", "Coupler failure", 
"Bar pullout", "Bar fracture", "Bar fracture", "Bar fracture", 
"Bar pullout", "Bar fracture", "Bar fracture", "Bar pullout", 
"Coupler failure", "Coupler failure", "Bar fracture", "Coupler failure", 
"Bar fracture", "Bar fracture", "Bar pullout", "Bar fracture", 
"Coupler failure", "Bar fracture", "Coupler failure", "Coupler failure", 
"Bar fracture", "Bar pullout", "Bar fracture", "Coupler failure"
), x = c("1-3", "7-9", "1-3", "5-7", "5-7", "30-90", "30-90", 
"5-7", "5-7", "30-90", "30-90", "30-90", "5-7", "7-9", "5-7", 
"5-7", "20-30", "20-30", "7-9", "20-30", "20-30", "20-30", "20-30", 
"11-15", "20-30", "20-30", "20-30", "7-9", "7-9", "3-5", "3-5", 
"3-5", "3-5", "3-5")), row.names = c(NA, -34L), class = c("tbl_df", 
"tbl", "data.frame"))

第一个图显示了样本的数量：

labels1 <- factor(c("0", "1-3", "3-5", "5-7", "7-9",
            "9-11", "11-15",  "15-20","20-90"), levels = 
              c("0", "1-3", "3-5", "5-7", "7-9",
            "9-11", "11-15",  "15-20","20-30","30-90"))
values1 <- c("white", "#ffffd9", "#edf8b1", "#c7e9b4", "#7fcdbb",
            "#41b6c4", "#1d91c0",  "#225ea8", "#253494","#081d58")

bar_list = c("No. 5", "No. 6",  "No. 8",  "No. 10", "No. 11", "No. 14", "No. 18")

plot1 <- ggplot(coupler.graph) + aes(x = Category, y = fct_inorder(`Bar Size`), fill = factor(x, 
                                    levels = c("0", "1-3", "3-5", "5-7", "7-9",
                                               "9-11", "11-15",  "15-20","20-30", "30-90"))) +
 geom_tile(width=0.9, height=0.9) + theme_classic() + scale_fill_manual(labels = factor(labels1), values = values1) +
 labs(x = "Splicer Type", y = "Bar Size") + scale_y_discrete(limits = bar_list) +
 theme(plot.title = element_blank(), axis.text =  element_text(color = "black", size = 12), axis.ticks.x = element_blank(),
       axis.line = element_line(color = "black", size = 0.2), axis.ticks.y = element_line(color = "black", size = 0.2),
       axis.title.y = element_text(color = "black", size = 16, margin = margin(0,40,0,0)), 
       axis.title.x = element_text(color = "black", size = 16, margin = margin(35,0,0,0)),
       legend.title = element_blank(), legend.text = element_text(color = "black", size = 12)) 

ggplotly(
  p = ggplot2::last_plot(),
  width = NULL,
  height = NULL,
  tooltip = c("Category", "Failure"),
  dynamicTicks = FALSE,
  layerData = 1,
  originalData = TRUE,) %>% add_annotations( text="Number of\nSpecimens", xref="paper", yref="paper",
                  x=1.1, xanchor="left", y=0.8, yanchor="bottom", font = list(size = 18),
                  legendtitle=TRUE, showarrow=FALSE ) %>%
  layout(yaxis = list(title = list(text = "Bar Size", standoff = 30L)),
             xaxis = list(title = list(text = "Bar Size",standoff = 30L)),
             legend = list(orientation = "v", x = 1.1, y = 0.13))

得到的结果是：

第二个图显示了故障类型：

values2 <-  c("Bar fracture" = "red", "Bar pullout" = "blue", "Coupler failure" = "yellow")

plot2 <- ggplot(coupler.graph) + aes(x = Category, y = fct_inorder(`Bar Size`), fill = Failure) +
 geom_tile(width=0.9, height=0.9) + theme_classic() + scale_fill_manual(values = values2) +
 labs(x = "Splicer Type", y = "Bar Size") + scale_y_discrete(limits = bar_list) +
 theme(plot.title = element_blank(), axis.text =  element_text(color = "black", size = 12), axis.ticks.x = element_blank(),
       axis.line = element_line(color = "black", size = 0.2), axis.ticks.y = element_line(color = "black", size = 0.2),
       axis.title.y = element_text(color = "black", size = 16, margin = margin(0,40,0,0)), 
       axis.title.x = element_text(color = "black", size = 16, margin = margin(35,0,0,0)),
       legend.title = element_blank(), legend.text = element_text(color = "black", size = 12)) 

ggplotly(
  p = ggplot2::last_plot(),
  width = NULL,
  height = NULL,
  tooltip = c("Category", "Failure"),
  dynamicTicks = FALSE,
  layerData = 1,
  originalData = TRUE,) %>%
  layout(yaxis = list(title = list(text = "Bar Size", standoff = 30L)),
             xaxis = list(title = list(text = "Bar Size",standoff = 30L)),
             legend = list(orientation = "v", x = 1.1, y = 0.13))

结果图如图所示：

我想在HTML输出中添加一个按钮，就像the example here对不同的图表类型所做的那样，但是要在这两个图之间切换。

ggplot2

plotly

ggplotly

回答 2

Stack Overflow用户

回答已采纳

发布于 2021-03-12 23:29:55

如果你想创建一个静态的html文件，你可以使用一些自定义的js和html来做你想做的事情。为此，您首先需要一个小的helper函数，您只需将其添加到您的markdown-file中：

<script type="text/javascript">
<!--
    function showSolution(){
        first=document.getElementById('first')
        second=document.getElementById('second')
        if(first.style.visibility=='visible'){
            first.style.visibility='hidden';
            first.style.display='none';
            second.style.visibility="visible";
            second.style.display='block';
        }else{
            first.style.visibility="visible";
            first.style.display='block';
            second.style.visibility='hidden';
            second.style.display='none';
        }
    }

    -->

然后你需要一个使用helper-function的按钮：

<input type='button' value='Change plot' onclick='showSolution();'/>

要进行finnish，您只需将您的图形创建块包装到一些div-tag中：

<div id='first' style='visibility:visible;display:block'>
```{r}

labels1 <-因子(c(“0”，"1-3"，"3-5"，"5-7"，"7-9"，

        "9-11", "11-15",  "15-20","20-90"), levels =

          c("0", "1-3", "3-5", "5-7", "7-9",

        "9-11", "11-15",  "15-20","20-30","30-90"))

values1 <- c(“白色”，“#FFFD9”，"#edf8b1"，"#c7e9b4"，"#7fcdbb"，

        "#41b6c4", "#1d91c0",  "#225ea8", "#253494","#081d58")

bar_list =c(“5号”，“6号”，“8号”，“10号”，“11号”，“14号”，“18号”)

plot1 <- ggplot(coupler.graph) + aes(x =类别，y= fct_inorder(Bar Size)，fill =因子(x，

                                levels = c("0", "1-3", "3-5", "5-7", "7-9",

                                           "9-11", "11-15",  "15-20","20-30", "30-90"))) +

geom_tile(width=0.9，height=0.9) + theme_classic() +scale_fill_manual(标签=因子(Labels1)，值= values1) +

Bar_list(x=“拼接器类型”，y=“条码”)+labs(限制=labs)+

主题(plot.title= element_blank()，axis.text = element_text(color =“黑色”，大小= 12)，axis.ticks.x = element_blank()，

   axis.line = element_line(color = "black", size = 0.2), axis.ticks.y = element_line(color = "black", size = 0.2),

   axis.title.y = element_text(color = "black", size = 16, margin = margin(0,40,0,0)),

   axis.title.x = element_text(color = "black", size = 16, margin = margin(35,0,0,0)),

   legend.title = element_blank(), legend.text = element_text(color = "black", size = 12))

ggplotly(

P= ggplot2::last_plot()，

宽度= NULL，

高度= NULL，

工具提示=c(“类别”，“失败”)，

dynamicTicks = FALSE，

layerData = 1，

originalData = TRUE，) %>% add_annotations( text=“规格数”，xref=“纸张”，yref=“纸张”，

              x=1.1, xanchor="left", y=0.8, yanchor="bottom", font = list(size = 18),

              legendtitle=TRUE, showarrow=FALSE ) %>%

layout(yaxis = list(title = list(text = "Bar Size"，standoff = 30L))，

         xaxis = list(title = list(text = "Bar Size",standoff = 30L)),

         legend = list(orientation = "v", x = 1.1, y = 0.13))

</div>


<div id='second' style='visibility:hidden;display:none'>
```{r}

values2 <- c(“拉杆断裂”=“红色”，“拉杆”=“蓝色”，“耦合器故障”=“黄色”)

plot2 <- ggplot(coupler.graph) + aes(x =类别，y= fct_inorder(Bar Size)，fill =失败)+

geom_tile(width=0.9，height=0.9) + theme_classic() + scale_fill_manual(values = values2) +

Bar_list(x=“拼接器类型”，y=“条码”)+labs(限制=labs)+

主题(plot.title= element_blank()，axis.text = element_text(color =“黑色”，大小= 12)，axis.ticks.x = element_blank()，

   axis.line = element_line(color = "black", size = 0.2), axis.ticks.y = element_line(color = "black", size = 0.2),

   axis.title.y = element_text(color = "black", size = 16, margin = margin(0,40,0,0)),

   axis.title.x = element_text(color = "black", size = 16, margin = margin(35,0,0,0)),

   legend.title = element_blank(), legend.text = element_text(color = "black", size = 12))

ggplotly(

P= ggplot2::last_plot()，

宽度= NULL，

高度= NULL，

工具提示=c(“类别”，“失败”)，

dynamicTicks = FALSE，

layerData = 1，

originalData = TRUE，) %>%

layout(yaxis = list(title = list(text = "Bar Size"，standoff = 30L))，

         xaxis = list(title = list(text = "Bar Size",standoff = 30L)),

         legend = list(orientation = "v", x = 1.1, y = 0.13))

</div>

这将产生如下所示的html：

票数 1

Stack Overflow用户

发布于 2021-03-12 06:32:20

如果您愿意考虑使用{shiny}，这里有一种方法，可以根据按钮单击来选择要显示的绘图。

视觉效果

代码

library(shiny)
library(ggplot2)
library(plotly)
library(forcats)



# Load data
coupler.graph <- structure(list(Category = c(
  "HBC", "TC", "BSC", "GSC", "GSC",
  "SSC", "SSC", "GSC", "GSC", "SSC", "SSC", "SSC", "HBC", "TC",
  "BSC", "BSC", "GSC", "GSC", "SSC", "HBC", "HBC", "TC", "TC",
  "BSC", "GSC", "GSC", "GSC", "GSC", "GSC", "TC", "BSC", "BSC",
  "GSC", "GSC"
), `Bar Size` = c(
  "No. 5", "No. 5", "No. 5", "No. 5",
  "No. 5", "No. 6", "No. 6", "No. 6", "No. 6", "No. 8", "No. 8",
  "No. 8", "No. 8", "No. 8", "No. 8", "No. 8", "No. 8", "No. 8",
  "No. 10", "No. 10", "No. 10", "No. 10", "No. 10", "No. 10", "No. 10",
  "No. 10", "No. 10", "No. 11", "No. 11", "No. 18", "No. 18", "No. 18",
  "No. 18", "No. 18"
), `No. Bars` = c(
  3, 9, 3, 6, 6, 85, 85, 7,
  7, 90, 90, 90, 7, 9, 6, 6, 21, 21, 9, 22, 22, 27, 27, 13, 25,
  25, 25, 8, 8, 4, 4, 4, 4, 4
), Failure = c(
  "Bar fracture", "Bar fracture",
  "Bar fracture", "Bar pullout", "Bar fracture", "Bar pullout",
  "Bar fracture", "Coupler failure", "Bar fracture", "Coupler failure",
  "Bar pullout", "Bar fracture", "Bar fracture", "Bar fracture",
  "Bar pullout", "Bar fracture", "Bar fracture", "Bar pullout",
  "Coupler failure", "Coupler failure", "Bar fracture", "Coupler failure",
  "Bar fracture", "Bar fracture", "Bar pullout", "Bar fracture",
  "Coupler failure", "Bar fracture", "Coupler failure", "Coupler failure",
  "Bar fracture", "Bar pullout", "Bar fracture", "Coupler failure"
), x = c(
  "1-3", "7-9", "1-3", "5-7", "5-7", "30-90", "30-90",
  "5-7", "5-7", "30-90", "30-90", "30-90", "5-7", "7-9", "5-7",
  "5-7", "20-30", "20-30", "7-9", "20-30", "20-30", "20-30", "20-30",
  "11-15", "20-30", "20-30", "20-30", "7-9", "7-9", "3-5", "3-5",
  "3-5", "3-5", "3-5"
)), row.names = c(NA, -34L), class = c(
  "tbl_df",
  "tbl", "data.frame"
))



# make plot 1
labels1 <- factor(
  c("0", "1-3", "3-5", "5-7", "7-9", "9-11", "11-15", "15-20", "20-90"),
  levels = c("0", "1-3", "3-5", "5-7", "7-9", "9-11", "11-15", "15-20", "20-30", "30-90")
)

values1 <- c(
  "white", "#ffffd9", "#edf8b1", "#c7e9b4", "#7fcdbb",
  "#41b6c4", "#1d91c0", "#225ea8", "#253494", "#081d58"
)

bar_list <- c("No. 5", "No. 6", "No. 8", "No. 10", "No. 11", "No. 14", "No. 18")

ggplot1 <- ggplot(
  coupler.graph,
  aes(
    x = Category,
    y = fct_inorder(`Bar Size`),
    fill = factor(x, levels = c("0", "1-3", "3-5", "5-7", "7-9", "9-11", "11-15", "15-20", "20-30", "30-90"))
  )
) +
  geom_tile(width = 0.9, height = 0.9) +
  theme_classic() +
  scale_fill_manual(labels = factor(labels1), values = values1) +
  labs(x = "Splicer Type", y = "Bar Size") +
  scale_y_discrete(limits = bar_list) +
  theme(
    plot.title = element_blank(), axis.text = element_text(color = "black", size = 12), axis.ticks.x = element_blank(),
    axis.line = element_line(color = "black", size = 0.2), axis.ticks.y = element_line(color = "black", size = 0.2),
    axis.title.y = element_text(color = "black", size = 16, margin = margin(0, 40, 0, 0)),
    axis.title.x = element_text(color = "black", size = 16, margin = margin(35, 0, 0, 0)),
    legend.title = element_blank(), legend.text = element_text(color = "black", size = 12)
  )

ggplotly1 <- ggplotly(
  p = ggplot1,
  width = NULL,
  height = NULL,
  tooltip = c("Category", "Failure"),
  dynamicTicks = FALSE,
  layerData = 1,
  originalData = TRUE,
) %>%
  add_annotations(
    text = "Number of\nSpecimens", xref = "paper", yref = "paper",
    x = 1.1, xanchor = "left", y = 0.8, yanchor = "bottom", font = list(size = 18),
    legendtitle = TRUE, showarrow = FALSE
  ) %>%
  layout(
    yaxis = list(title = list(text = "Bar Size", standoff = 30L)),
    xaxis = list(title = list(text = "Bar Size", standoff = 30L)),
    legend = list(orientation = "v", x = 1.1, y = 0.13)
  )



# make plot 2
values2 <- c("Bar fracture" = "red", "Bar pullout" = "blue", "Coupler failure" = "yellow")

ggplot2 <- ggplot(coupler.graph) +
  aes(x = Category, y = fct_inorder(`Bar Size`), fill = Failure) +
  geom_tile(width = 0.9, height = 0.9) +
  theme_classic() +
  scale_fill_manual(values = values2) +
  labs(x = "Splicer Type", y = "Bar Size") +
  scale_y_discrete(limits = bar_list) +
  theme(
    plot.title = element_blank(), axis.text = element_text(color = "black", size = 12), axis.ticks.x = element_blank(),
    axis.line = element_line(color = "black", size = 0.2), axis.ticks.y = element_line(color = "black", size = 0.2),
    axis.title.y = element_text(color = "black", size = 16, margin = margin(0, 40, 0, 0)),
    axis.title.x = element_text(color = "black", size = 16, margin = margin(35, 0, 0, 0)),
    legend.title = element_blank(), legend.text = element_text(color = "black", size = 12)
  )

ggplotly2 <- ggplotly(
  p = ggplot2,
  width = NULL,
  height = NULL,
  tooltip = c("Category", "Failure"),
  dynamicTicks = FALSE,
  layerData = 1,
  originalData = TRUE,
) %>%
  layout(
    yaxis = list(title = list(text = "Bar Size", standoff = 30L)),
    xaxis = list(title = list(text = "Bar Size", standoff = 30L)),
    legend = list(orientation = "v", x = 1.1, y = 0.13)
  )



ui <- fluidPage(
    titlePanel("Swap Plotlies"),
    sidebarLayout(
        sidebarPanel(
            flowLayout(
                actionButton("show_plot_1", "Show Plot 1"),
                actionButton("show_plot_2", "Show Plot 2")
            )
        ),
        mainPanel(
            uiOutput("plot_hole")
        )
    )
)

server <- function(input, output) {
    
    observeEvent(input$show_plot_1, { 
        output$plot_hole <- renderUI({ plotlyOutput("plot_1") })
    })
    
    observeEvent(input$show_plot_2, { 
        output$plot_hole <- renderUI({ plotlyOutput("plot_2") })
    })
    
    output$plot_1 <- renderPlotly({ ggplotly1 })
    
    output$plot_2 <- renderPlotly({ ggplotly2 })
}

shinyApp(ui = ui, server = server)

票数 1

页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持

原文链接：

https://stackoverflow.com/questions/66448838

复制

相似问题

问添加一个交互式按钮来切换映射到r中的哪个变量填充ggplotly
EN

回答 2

Stack Overflow用户

Stack Overflow用户

社区

活动

圈层

关于

腾讯云开发者

热门产品

热门推荐

更多推荐

问添加一个交互式按钮来切换映射到r中的哪个变量填充ggplotlyEN

回答 2

Stack Overflow用户

Stack Overflow用户

社区

活动

圈层

关于

腾讯云开发者

热门产品

热门推荐

更多推荐

问添加一个交互式按钮来切换映射到r中的哪个变量填充ggplotly
EN