thothal's questions

免责声明。我正在处理这个问题R，但这个问题实际上是一个一般性问题（我只是比在 vanilla JS 中plotly生成图表更快）。R

我有以下代码，它在鼠标悬停时在条形图周围添加边框。这按预期工作，但是只有当我将鼠标悬停在轨迹的第一个条形图上（并因此成为边框）时，图例才会更改。

我希望它根本不改变（首选解决方案），或者无论我将鼠标悬停在轨迹的哪个栏上，都会将边框添加到图例中。

library(plotly)
library(htmlwidgets)
set.seed(29042025)
d <- expand.grid(a = LETTERS[1:3], b = letters[1:2])
d$c <- sample(10, 6)

plot_ly(d) %>%
  add_bars(x = ~ c, y = ~ a, color = ~ b) %>%
  onRender("function(el, x) {
   el.on('plotly_hover', function(data){
     const color = Array(3).fill('undefined');
     const width = Array(3).fill('undefined');
     const pos = data.points[0].pointNumber;
     color[pos] = 'black';
     width[pos] = 2;
     Plotly.restyle(el, {'marker.line': null});
     Plotly.restyle(el, {'marker.line.color': [color], 'marker.line.width': [width]}, [data.points[0].curveNumber]);
   });
  }")

假设我有以下数据结构：

library(dplyr)
d <- tibble(x = paste0("x", 1:3), 
            op = c("f", "g", "h"), 
            y = paste0("y", 1:3), 
            res = paste0("z", 1:3))

我想创建一个cmd包含未评估调用的新列，它最终应如下所示：

(D <- d %>%
  mutate(cmd = list(quote(z1 <- f(x1, y1)), 
                    quote(z2 <- g(x2, y2)), 
                    quote(z3 <- h(x3, y3)))))
# # A tibble: 3 × 5
#   x     op    y     res   cmd       
#   <chr> <chr> <chr> <chr> <list>    
# 1 x1    f     y1    z1    <language>
# 2 x2    g     y2    z2    <language>
# 3 x3    h     y3    z3    <language>

但我当然不想对这些行进行硬编码，而是想从相应的行中提取这些值d，但我没有成功：

d %>%
  rowwise() %>%
  mutate(cmd = list(expr(!!sym(res) <- !!sym(op)(!!sym(x), !!sym(y)))))

结果：

Error: object 'res' not found

我将如何实现这个目标？

NB cmd最终将在定义参数和函数的环境中进行评估，因此从概念上讲类似于：

e <- list2env(list(x1 = 1, x2 = 2, x3 = 3, y1 = 2, y2 = 2, y3 = 3, 
              f = \(x, y) x + y, g = \(x, y) x - y, h = \(x, y) x * y))

eval(D$cmd[[1]], e)
e$z1
# [1] 3

我正在尝试实现一个子类tbl来调整数据打印方式。代码是包的一部分。

我已阅读文档并使用了以下几行：

as_data_test <- function(...) {
  tibble::new_tibble(..., class = "data_test")
}

tbl_format_header.data_test <- function(x, setup, ...) {
  cli::style_italic("A Data Test = ", setup$tbl_sum)
}

然后我使用它devtools::load_all(".")来加载包。但是当我尝试打印我的data_test对象时，它不使用自定义tbl_format_header函数：

devtools::load_all(".")
# i Loading datatesteR
as_data_test(mtcars)
# # A tibble: 32 x 11
#      mpg   cyl  disp    hp  drat    wt  qsec    vs    am  gear  carb
#    <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
#  1  21       6  160    110  3.9   2.62  16.5     0     1     4     4
#  2  21       6  160    110  3.9   2.88  17.0     0     1     4     4
#  3  22.8     4  108     93  3.85  2.32  18.6     1     1     4     1
#  4  21.4     6  258    110  3.08  3.22  19.4     1     0     3     1
#  5  18.7     8  360    175  3.15  3.44  17.0     0     0     3     2
#  6  18.1     6  225    105  2.76  3.46  20.2     1     0     3     1
#  7  14.3     8  360    245  3.21  3.57  15.8     0     0     3     4
#  8  24.4     4  147.    62  3.69  3.19  20       1     0     4     2
#  9  22.8     4  141.    95  3.92  3.15  22.9     1     0     4     2
# 10  19.2     6  168.   123  3.92  3.44  18.3     1     0     4     4
# # i 22 more rows
# # i Use `print(n = ...)` to see more rows

如您所见，仅打印了默认标头。 调用browser确认tbl_format_header.data_test我的方法从未被调度。 如果我直接将相同的代码放入 R 控制台，一切都会顺利运行。

如何在devtools工作流程中获得自定义打印？

假设我有一个reactive返回 的控件data.frame。我希望我的某些控件仅依赖于其列的子集，也就是说，只有当任何“相关”列（此处rel_1和rel_2）中的值发生变化时，它才会触发，而“不相关”列（此处irr_1和irr_2）中的更改不应触发刷新。

我以为创建一个reactive只返回相关列的按钮就可以解决问题，但以下代码显示所有按钮都会触发刷新verbatimTextOutput。我的预期是，按下“更改不相关列”按钮不会触发刷新，因为相关列中的值保持不变。

library(shiny)
library(DT)
library(dplyr)
library(glue)

dat <- tibble(
  rel_1 = LETTERS[1:3],
  rel_2 = letters[1:3],
  irr_1 = 1:3,
  irr_2 = 101:103
)

ui <- fluidPage(
  fluidRow(
    column(
      width = 4,
      actionButton("chng_all", "Change All Columns")
    ),
    column(
      width = 4,
      actionButton("chng_irr", "Change Irrelevant Columns")
    ),
    column(
      width = 4,
      actionButton("chng_rel", "Change Relevant Columns")
    )
  ),
  fluidRow(
    column(
      width = 12,
      DTOutput("tbl")
    )    
  ),
  fluidRow(
    column(
      width = 12,
      verbatimTextOutput("dbg")
    )    
  )
)

server <- function(input, output, session) {
  my_data <- reactiveVal(dat)
  
  change_values <- function(data, cols) {
    data %>% 
      mutate(
        across(all_of(cols),
               ~ if (is.numeric(.x)) sample(100, 3) else sample(LETTERS, 3))
      )
  }
  
  relevant_data <- reactive(
    my_data() %>% 
      select(starts_with("rel"))
  )
  
  observe({
    my_data(change_values(my_data(), c(paste0("irr_", 1:2),
                                       paste0("rel_", 1:2))))
  }) %>% 
    bindEvent(input$chng_all)
  
  observe({
    my_data(change_values(my_data(), paste0("irr_", 1:2)))
  }) %>% 
    bindEvent(input$chng_irr)
  
  observe({
    my_data(change_values(my_data(), paste0("rel_", 1:2)))
  }) %>% 
    bindEvent(input$chng_rel)
  
  output$tbl <- renderDT(
    datatable(my_data())
  )
  
  output$dbg <- renderPrint({
    glue("Relevant Data Last Changed: {Sys.time()}")
  }) %>% 
    bindEvent(relevant_data())
  
}

shinyApp(ui, server)

在这个问题Name output of pmap on tibble中，我询问如何正确命名调用的输出pmap并得到了一个很好的答案，我认为我理解了。

然而，当我进一步研究这种行为时，我不再确定我是否理解其内在原理：

library(purrr)
library(tibble)
params <- tibble(nm = LETTERS[1:2], x = 1:2, y = 2:3, z = 1:2)

## 1. setting names on the first argument gives the expected results
params %>%
  mutate(nm = set_names(nm)) %>% 
  pmap(function(nm, x, y, ...) {
    x + y
  }) %>%
  names()
# [1] "A" "B"


## 2. actually it does not need to be the first element
params %>%
  mutate(nm = set_names(nm)) %>% 
  pmap(function(x, y, nm, ...) {
    x + y
  }) %>%
  names()
# [1] "A" "B"

## 3. however, setting names on `x` does not work
params %>%
  mutate(x = set_names(x, nm)) %>% 
  pmap(function(x, y, nm, ...) {
    x + y
  }) %>%
  names()
# NULL

## 4. I thought maybe because they disappear during the addition `+`, but nope
params %>%
  mutate(z = set_names(z, nm)) %>% 
  pmap(function(x, y, nm, ...) {
    x + y
  }) %>%
  names()
# NULL

## 5. Ok maybe a catch all argument `...` prohibits this behaviour, but no
params %>%
  mutate(z = set_names(z, nm)) %>% 
  pmap(function(x, y, nm, z) {
    x + y
  }) %>%
  names()
# NULL

## 6. It seems that names on a character vector work even if not referenced directly
params %>%
  mutate(nm = set_names(nm)) %>% 
  pmap(function(x, y, ...) {
    x + y
  }) %>%
  names()
# [1] "A" "B"

有人可以告诉我电话中的名字最终是如何确定的吗[p]map？

我想循环 a 的行tibble，一列应保存输出中相应槽应具有的名称，其他列是函数的参数。

我知道如何解决这个问题，但我想知道是否有可能在函数内部pmap进行命名？

library(purrr)
library(tibble)

params <- tibble(nm = LETTERS[1:2], x = 1:2, y = 2:3)

## this has one addional level of nesting
pmap(params, function(nm, x, y) {
  set_names(list(x + y), nm)
}) # %>% flatten would remove the unnecessary level

## correct format but mixes tidyverse syntax with base syntax
map(split(params, params$nm), ~ .x$x + .x$y)

## correct format & tidyverse syntax but naming must happen **outside**
pmap(params, function(nm, x, y) {
  x + y
}) %>%
  set_names(params$nm)

预期结果与版本 2 或 3 中的tidyverse风格相同，但无需事后重命名结果。

目标

最终我想要得到这样的东西（忘记周围的白色边框是由于剪切造成的）：

约束条件

这些元素必须位于以下标记内，我无法轻易更改：

<div style="position:absolute;top:15px;right:15px;bottom:15px;left:15px">
  <div style="display:-webkit-flex;display:-ms-flexbox;display:flex;-webkit-flex-direction:column;-ms-flex-direction:column;flex-direction:column;width:100%;height:100%;">
     <div style="position:relative;-webkit-flex:1;-ms-flex:1;flex:1;width:100%;height:100%;">
        <div style="position:absolute;top:0;left:0;right:0;bottom:0;">
          <!-- place elements here -->
        </div>
     </div>
  </div>
</div>

我尝试过的

<div class="split-container">
  <div class="split-heading">
    <h3>Heading</h3>
  </div>
  <div class="split-content">
    <p>Content</p>
  </div>
</div>

.split-container {
  display: flex;
  height: 100%;
}

.split-heading {
  background-color: rgb(198,89,17);
  color: #fff;
  padding: 0 5px; /* Add padding to the sides */
}

.split-heading > h3 {
  transform: rotate(-90deg);
  transform-origin: bottom right;
}

.split-content {
  flex-grow: 100;
  background-color: rgb(244,176,132);
  color: #fff;
}

结果

https://codepen.io/thothal/pen/qBwxEKO

问题

• 标题 div 应该只占据所需的空间（现在太宽了）
• 标题应垂直和水平居中
• 内容应垂直居中