将工作中的highcharter图集成到Shiny App中

bjp0bcyl  于 2023-03-10  发布在  其他
关注(0)|答案(1)|浏览(133)

我正在尝试将以下内容集成到应用程序中：
代码将两个绘图存储到全局环境中，我似乎无法通过Shiny应用程序访问它们。我的总体目标是在Shiny应用程序中有相同的输出。

library(highcharter)
library(tidyverse)
library(htmltools)

imap(unique(df$type), function(j, k) {                   # index & type in df
  plt <- df %>% filter(type == j) %>%                    # filter for the type
    hchart("point", regression = T,                      # add poly reg line
           regressionSettings = list(color = "red", type = "polynomial",
                                     hideInLegend = T),  # no legend
           hcaes(x = mts2, y = price)) %>% 
    hc_add_dependency("plugins/highcharts-regression.js") %>%  # tie-in reg dep
    hc_xAxis(min = 5, max = 160, crosshair = T) %>%      # all w/ same x rng
    hc_tooltip(useHTML = T, crosshair = T)
  assign(paste0("plt", k), plt, envir = .GlobalEnv)      # add plot to env
})

browsable(tagList(
  tags$script(HTML("
  setTimeout(function() {                                   /* using id from div */
    $('#hc_container').bind('mousemove touchmove touchstart', function(e) {
      var chart, point, i, event;
      for (i = 0; i < Highcharts.charts.length; i++) {      /* loop through both charts */
          chart = Highcharts.charts[i];                     /* identify the chart */
          event = chart.pointer.normalize(e.originalEvent); /* find chart coordinates */
          point = chart.series[1].searchPoint(event, true); /* get closest point; reg line only */
          if (point) {                                      /* if point found, tip it */
              point.highlight(e);
          }
      }
    });
  }, 500);
  Highcharts.Point.prototype.highlight = function(event) { /* executes tooltip from trigger */
    event = this.series.chart.pointer.normalize(event);    /* capture that event occurred */
    this.onMouseOver();                                    /* show marker */
    this.series.chart.tooltip.refresh(this);               /* show tooltip */
    this.series.chart.xAxis[0].drawCrosshair(event, this); /* show crosshair */
  };
  Highcharts.Pointer.prototype.reset = function() {        /* vigilant tooltip */
    return null;
  };
")),
  div(id = "hc_container",     # this id is used in the JQuery/Javascript above
      div(plt1, style = 'height:50%; width: 100%;'), # first plot
      div(plt2, style = 'height:50%; width: 100%;'), # second plot
      style = "height:100%; width:100%;")))          # container styles

闪亮应用程序（不工作）：

library(shiny)
library(highcharter)
library(tidyverse)
library(htmltools)

ui_MODULE <- function(id) {
  ns <- NS(id)

  browsable(tagList(
    tags$script(HTML("
  setTimeout(function() {                                   /* using id from div */
    $('#hc_container').bind('mousemove touchmove touchstart', function(e) {
      var chart, point, i, event;
      for (i = 0; i < Highcharts.charts.length; i++) {      /* loop through both charts */
          chart = Highcharts.charts[i];                     /* identify the chart */
          event = chart.pointer.normalize(e.originalEvent); /* find chart coordinates */
          point = chart.series[1].searchPoint(event, true); /* get closest point; reg line only */
          if (point) {                                      /* if point found, tip it */
              point.highlight(e);
          }
      }
    });
  }, 500);
  Highcharts.Point.prototype.highlight = function(event) { /* executes tooltip from trigger */
    event = this.series.chart.pointer.normalize(event);    /* capture that event occurred */
    this.onMouseOver();                                    /* show marker */
    this.series.chart.tooltip.refresh(this);               /* show tooltip */
    this.series.chart.xAxis[0].drawCrosshair(event, this); /* show crosshair */
  };
  Highcharts.Pointer.prototype.reset = function() {        /* vigilant tooltip */
    return null;
  };
")),
    div(id = "hc_container",     # this id is used in the JQuery/Javascript above
        div(plt1, style = 'height:50%; width: 100%;'), # first plot
        div(plt2, style = 'height:50%; width: 100%;'), # second plot
        style = "height:100%; width:100%;")))          # container styles

}

server_MODULE <- function(id){
  moduleServer(id, function(input, output, session){

    imap(unique(df$type), function(j, k) {                   # index & type in df
      plt <- df %>% filter(type == j) %>%                    # filter for the type
        hchart("point", regression = T,                      # add poly reg line
               regressionSettings = list(color = "red", type = "polynomial",
                                         hideInLegend = T),  # no legend
               hcaes(x = mts2, y = price)) %>%
        hc_add_dependency("plugins/highcharts-regression.js") %>%  # tie-in reg dep
        hc_xAxis(min = 5, max = 160, crosshair = T) %>%      # all w/ same x rng
        hc_tooltip(useHTML = T, crosshair = T)
      assign(paste0("plt", k), plt, envir = .GlobalEnv)      # add plot to env
    })
  }
  )
}

ui <- fluidPage(

  ui_MODULE("regOutputModule")

)

server <- function(input, output) {

  server_MODULE("regOutputModule")

}

shinyApp(ui = ui, server = server)

数据：

df = structure(list(price = c(1600, 1200, 249000, 288000, 775000, 
350000, 715000, 330000, 375000, 925, 1250, 300000, 425000, 489000, 
1200, 550000, 1895, 310000, 289000, 450000, 1250, 288000, 1000, 
600, 1100, 350000, 1200, 339000, 405000, 427000, 299000, 218000, 
159900, 360000, 365000, 725, 405000, 300000, 715000, 1300, 1400, 
1500, 415000, 1500, 663, 350000, 365000, 230000, 515000, 259000, 
310000, 405000, 288000, 350000, 288000, 1300, 350000, 1350, 715000, 
350000, 715000, 185000, 2200, 288000, 353800, 290000, 229000, 
365000, 1900, 1300, 590000, 180000, 1050, 1900, 1100, 1950, 288000, 
1995, 112000, 369000, 593000, 550000, 365000, 715000, 1800, 713000, 
1100, 260000, 375000, 715000, 338000, 288000, 1900, 288000, 2800, 
2450, 1990, 260000, 415000, 745000), habs = c(1, 1, 1, 4, 3, 
4, NA, 4, 2, 2, 2, 2, 4, 3, 3, 4, 2, 2, 3, 4, 1, 4, 1, 1, 2, 
5, 3, 4, 3, 4, 2, 2, NA, 4, 3, 1, 3, 3, 3, 3, 3, 2, 4, 2, 1, 
3, 3, 3, 2, 1, 2, 3, 4, 4, 4, 3, 4, 3, NA, 3, 3, 1, 3, 4, 1, 
4, 3, 3, 1, 2, 3, 2, 1, 1, 2, 2, 4, 2, 1, 3, 2, 4, 3, 3, 2, 3, 
3, NA, 2, 3, 3, 4, 1, 4, 4, 4, 1, NA, 4, 3), mts2 = c(70, 65, 
55, 76, 121, 87, 109, 85, 81, 46, 65, 55, 100, 102, 65, 122, 
66, 51, 85, 99, 50, 75, 55, 10, 75, 87, 71, 75, 83, 118, 85, 
57, 45, 112, 63, 40, 83, 75, 109, 91, 74, 58, 100, 75, 42, 82, 
90, 65, 104, 52, 55, 83, 79, 87, 76, 77, 87, 88, 109, 83, 109, 
46, 145, 76, 40, 66, 63, 90, 45, 65, 115, 44, 46, 45, 73, 90, 
79, 110, 42, 81, 73, 115, 94, 109, 70, 104, 75, 58, 80, 109, 
92, 79, 45, 76, 122, 160, 47, 58, 100, 104), type = c("alquiler", 
"alquiler", "comprar", "comprar", "comprar", "comprar", "comprar", 
"comprar", "comprar", "alquiler", "alquiler", "comprar", "comprar", 
"comprar", "alquiler", "comprar", "alquiler", "comprar", "comprar", 
"comprar", "alquiler", "comprar", "alquiler", "alquiler", "alquiler", 
"comprar", "alquiler", "comprar", "comprar", "comprar", "comprar", 
"comprar", "comprar", "comprar", "comprar", "alquiler", "comprar", 
"comprar", "comprar", "alquiler", "alquiler", "alquiler", "comprar", 
"alquiler", "alquiler", "comprar", "comprar", "comprar", "comprar", 
"comprar", "comprar", "comprar", "comprar", "comprar", "comprar", 
"alquiler", "comprar", "alquiler", "comprar", "comprar", "comprar", 
"comprar", "alquiler", "comprar", "comprar", "comprar", "comprar", 
"comprar", "alquiler", "alquiler", "comprar", "comprar", "alquiler", 
"alquiler", "alquiler", "alquiler", "comprar", "alquiler", "comprar", 
"comprar", "comprar", "comprar", "comprar", "comprar", "alquiler", 
"comprar", "alquiler", "comprar", "comprar", "comprar", "comprar", 
"comprar", "alquiler", "comprar", "alquiler", "alquiler", "alquiler", 
"comprar", "comprar", "comprar")), row.names = c(NA, -100L), class = c("tbl_df", 
"tbl", "data.frame"))

编辑：
当我尝试将该函数应用于一些“动态”过滤数据时，我得到了一些错误：
我有以下内容：

server_filter_regressions <- function(id, data) {
  moduleServer(
    id,
    function(input, output, session) {
      ns <- session$ns

      filteredData = reactive({
        data %>%
          filter(provincia == input$provinceSelect &
                   municipio == input$municipioSelect &
                   distrito == input$distritoSelect &
                   zona == input$zonaSelect
          )
      })
      
      observe(
        print(filteredData())
      )
      
      
      imap(unique(filteredData()$type), function(j, k) { # index & type in df
        output[[paste0("plt", k)]] <- renderHighchart({
          filteredData() %>%
            filter(type == j) %>% # filter for the type
            hchart("point",
                   regression = T, # add poly reg line
                   regressionSettings = list(
                     color = "red", type = "polynomial",
                     hideInLegend = T
                   ), # no legend
                   hcaes(x = mts2, y = price)
            ) %>%
            hc_add_dependency("plugins/highcharts-regression.js") %>% # tie-in reg dep
            hc_xAxis(min = 5, max = 160, crosshair = T) %>% # all w/ same x rng
            hc_tooltip(useHTML = T, crosshair = T)
        })
      })
      
    }
  )
}

我得到这个错误：

Masking (modules:highcharter):
  `%>%` from: modules:magrittr

Listening on http://127.0.0.1:5715
Warning: Error in .getReactiveEnvironment()$currentContext: Operation not allowed without an active reactive context.
• You tried to do something that can only be done from inside a reactive consumer.
  59: <Anonymous>
  58: signalCondition
  57: signal_abort
  56: rlang::abort
  55: .getReactiveEnvironment()$currentContext
  54: getCurrentContext
  53: .dependents$register
  52: filteredData
  46: module [server/serverRegressions.R#101]
  41: callModule
  40: moduleServer
  39: server_regressions$server_filter_regression [server/serverRegressions.R#81]
  38: server [/home/matt/Desktop/realEstate/Real Estate Analytica/RealEstate/app.R#180]
   1: runApp
Error in .getReactiveEnvironment()$currentContext() : 
  Operation not allowed without an active reactive context.
• You tried to do something that can only be done from inside a reactive consumer.
✔ The provincias were observed and the updateSelectInput was updated to provincias: 
 The NS id is:  filterPropertiesMainPage 
✔ After observing the selection of provincias, the municipios dropdown is updated: 
The NS id is: filterPropertiesMainPage
✔ The municipio dropdown was selected and now the distrito dropdown is update: 
.The NS id is: filterPropertiesMainPage
✔ The distrito dropdown was selected and now the zona dropdown is update: 
.The NS id is: filterPropertiesMainPage
# A tibble: 0 × 32
# … with 32 variables: price <dbl>, direccion <chr>, provincia <chr>, municipio <chr>, distrito <chr>, zona <chr>, collectionDate <date>, collectionTime <dttm>,
#   individualPropertyPageToCollect <chr>, habs <dbl>, baños <dbl>, mts2 <dbl>, Terraza <lgl>, Calefacción2 <lgl>, Planta2 <chr>, Tipo de inmueble <chr>, Antigüedad <chr>, Planta <chr>,
#   Parking <chr>, Amueblado <chr>, Estado <chr>, Ascensor <chr>, Orientación <chr>, Agua caliente <chr>, Calefacción <chr>, NA <lgl>, price_mts_sqrd <dbl>, type <chr>, Depósito <chr>,
#   Gastos de comunidad <chr>, Mascotas <chr>, Europe/Madrid <lgl>
# ℹ Use `colnames()` to see all variable names

编辑2：
我的结构和代码如下所示：
服务器R

server_filter_regressions <- function(id, data) {
  moduleServer(
    id,
    function(input, output, session) {
      ns <- session$ns

      filteredData = reactive({
        data %>%
          filter(provincia == input$provinceSelect &
                   municipio == input$municipioSelect &
                   distrito == input$distritoSelect &
                   zona == input$zonaSelect
          )
      })

      observe(
        print(filteredData())
      )

      observe({imap(unique(filteredData()$type), function(j, k) { # index & type in df
        output[[paste0("plt", k)]] <- renderHighchart({
          filteredData() %>%
            filter(type == j) %>% # filter for the type
            hchart("point",
                   regression = T, # add poly reg line
                   regressionSettings = list(
                     color = "red", type = "polynomial",
                     hideInLegend = T
                   ), # no legend
                   hcaes(x = mts2, y = price)
            ) %>%
            hc_add_dependency("plugins/highcharts-regression.js") %>% # tie-in reg dep
            hc_xAxis(min = 5, max = 160, crosshair = T) %>% # all w/ same x rng
            hc_tooltip(useHTML = T, crosshair = T)
        })
      })
      })

    }
  )
}

用户界面

ui_filter_regression <- function(id){
  ns <- NS(id)
  tagList(
    tags$script(
      HTML("
        setTimeout(function() {                                   /* using id from div */
          $('#hc_container').bind('mousemove touchmove touchstart', function(e) {
            var chart, point, i, event;
            for (i = 0; i < Highcharts.charts.length; i++) {      /* loop through both charts */
                chart = Highcharts.charts[i];                     /* identify the chart */
                event = chart.pointer.normalize(e.originalEvent); /* find chart coordinates */
                point = chart.series[1].searchPoint(event, true); /* get closest point; reg line only */
                if (point) {                                      /* if point found, tip it */
                    point.highlight(e);
                }
            }
          });
        }, 500);
        Highcharts.Point.prototype.highlight = function(event) { /* executes tooltip from trigger */
          event = this.series.chart.pointer.normalize(event);    /* capture that event occurred */
          this.onMouseOver();                                    /* show marker */
          this.series.chart.tooltip.refresh(this);               /* show tooltip */
          this.series.chart.xAxis[0].drawCrosshair(event, this); /* show crosshair */
        };
        Highcharts.Pointer.prototype.reset = function() {        /* vigilant tooltip */
          return null;
        };
      ")
    ),
    titlePanel("Highcharts"),
    div(
      id = "hc_container", # this id is used in the JQuery/Javascript above
      div(
        highchartOutput(ns("plt1")),
        style = "height:50%; width: 100%;"
      ), # first plot
      div(
        highchartOutput(ns("plt2")),
        style = "height:50%; width: 100%;"
      ), # second plot
      style = "height:100%; width:100%;"
    )
  )
}

然后我在App里叫它：
用户界面回归〈-模块：：使用（“用户界面/用户界面回归.R”）服务器回归〈-模块：：使用（“服务器/服务器回归.R”）

shinyApp(
  ui = dashboardPage(

...

ui_regressions$ui_filter_regression("filterPropertiesMainPage")

...

)
),
 server = function(input, output) {
    server_regressions$server_filter_regression("filterPropertiesMainPage", data)
}
r

1条答案

按热度按时间
oogrdqng

oogrdqng1#

简单地将交互式脚本中的代码 Package 在一个漂亮的应用程序或漂亮的模块中是行不通的。在交互式脚本中，您首先在全局环境中创建图表，然后再显示它们。基本上，您也可以对漂亮的应用程序执行相同的操作。但实际上，当您启动应用程序时，plt1和plt2并不存在，并且当您尝试在UI中调用这些对象时，会收到错误。
总的来说，我认为没有理由在全局环境中创建绘图，相反，我建议使用renderHighchart在服务器模块中创建输出对象，然后使用highchartOutput在用户界面中显示这些对象：

library(shiny)
library(highcharter)
library(tidyverse)
library(htmltools)

ui_MODULE <- function(id) {
  ns <- NS(id)

  tagList(
    tags$script(
      HTML("
        setTimeout(function() {                                   /* using id from div */
          $('#hc_container').bind('mousemove touchmove touchstart', function(e) {
            var chart, point, i, event;
            for (i = 0; i < Highcharts.charts.length; i++) {      /* loop through both charts */
                chart = Highcharts.charts[i];                     /* identify the chart */
                event = chart.pointer.normalize(e.originalEvent); /* find chart coordinates */
                point = chart.series[1].searchPoint(event, true); /* get closest point; reg line only */
                if (point) {                                      /* if point found, tip it */
                    point.highlight(e);
                }
            }
          });
        }, 500);
        Highcharts.Point.prototype.highlight = function(event) { /* executes tooltip from trigger */
          event = this.series.chart.pointer.normalize(event);    /* capture that event occurred */
          this.onMouseOver();                                    /* show marker */
          this.series.chart.tooltip.refresh(this);               /* show tooltip */
          this.series.chart.xAxis[0].drawCrosshair(event, this); /* show crosshair */
        };
        Highcharts.Pointer.prototype.reset = function() {        /* vigilant tooltip */
          return null;
        };
      ")
    ),
    titlePanel("Highcharts"),
    div(
      id = "hc_container", # this id is used in the JQuery/Javascript above
      div(
        highchartOutput(ns("plt1")),
        style = "height:50%; width: 100%;"
      ), # first plot
      div(
        highchartOutput(ns("plt2")),
        style = "height:50%; width: 100%;"
      ), # second plot
      style = "height:100%; width:100%;"
    )
  )
}

server_MODULE <- function(id) {
  moduleServer(id, function(input, output, session) {
    imap(unique(df$type), function(j, k) { # index & type in df
      output[[paste0("plt", k)]] <- renderHighchart({
        df %>%
          filter(type == j) %>% # filter for the type
          hchart("point",
            regression = T, # add poly reg line
            regressionSettings = list(
              color = "red", type = "polynomial",
              hideInLegend = T
            ), # no legend
            hcaes(x = mts2, y = price)
          ) %>%
          hc_add_dependency("plugins/highcharts-regression.js") %>% # tie-in reg dep
          hc_xAxis(min = 5, max = 160, crosshair = T) %>% # all w/ same x rng
          hc_tooltip(useHTML = T, crosshair = T)
      })
    })
  })
}

ui <- fluidPage(
  ui_MODULE("regOutputModule")
)

server <- function(input, output, session) {
  server_MODULE("regOutputModule")
}

shinyApp(ui, server)

赞(0）分享  回复(0）举报  2023-03-10
我来回答

相关问题

    查看更多

    热门标签

    更多
    JavaquerypythonNode开发语言requestUtil数据库Table后端算法LoggerMessageElementParser

    最新问答

    更多
    • 蜀ICP备2022004421号-2 NULL123 https://www.null123.com © All rights reserved
    • 本站内容来源互联网,如果侵犯您的权益请联系我们删除, 联系方式：448109455@qq.com