R 编辑shiny.tag元素

R 编辑shiny.tag元素,r,shiny,R,Shiny,背景 我想更改shinydashboard::box的一些元素。比方说,我想更改用于折叠框(collapsable=TRUE)的图标。查看输出,我需要做的就是相应地更改标记: (b <- box(collapsible = T)) # <div class="col-sm-6"> # <div class="box"> # <div class="box-header"> # <div class="box-tools pul

背景

我想更改
shinydashboard::box
的一些元素。比方说,我想更改用于折叠
框(collapsable=TRUE)
的图标。查看输出,我需要做的就是相应地更改
标记:

(b <- box(collapsible = T))
# <div class="col-sm-6">
#   <div class="box">
#    <div class="box-header">
#       <div class="box-tools pull-right">
#         <button class="btn btn-box-tool" data-widget="collapse">
#           <i class="fa fa-minus"></i> ## change to <i class="fa fa-times">
#         </button>
#       </div>
#    </div>
#    <div class="box-body"></div>
#   </div>
# </div>
我在想,是否有更简单的方法?理想情况下类似于
jQuery
语法的东西


另一个选择是编写我自己的
函数,但我希望避免代码重复。

您可以编写一个助手函数来编辑生成的HTML。我们可以使用
xml2
中的函数来解析和编辑html。比如说

swap_node <- function(x, xpath, newval) {
  parsed <- xml2::read_html(as.character(x))  
  oldnode <- xml2::xml_find_all(parsed, xpath)
  newnode <- xml2::read_html(as.character(newval))
  xml2::xml_replace(oldnode, newnode)
  shiny::HTML(as.character(xml2::xml_find_first(parsed, "//body/*")))
}

swap_node这里有一个函数,用于在搜索具有给定属性的给定类型的标记时导航
对象。如果找到它,它将被具有新属性的新标记替换:

searchreplaceit <- function(branch, whattag, whatattribs, totag, toattribs) {
    if ("name" %in% names(branch)) {
        if ((branch$name == whattag)&&(identical( branch$attribs[names(whatattribs)], whatattribs))) {
            branch$name    <- totag
            branch$attribs <- modifyList(branch$attribs, toattribs)
        }
    }
    if (class(branch)=="shiny.tag") {
        if (length(branch$children)>0) for (i in 1: length(branch$children)) {
            if (!(is.null(branch$children[[i]]))) {
                branch$children[[i]] = searchreplaceit(branch$children[[i]], whattag, whatattribs, totag, toattribs)
        } }
    } else if (class(branch)=="list") {
        if (length(branch)>0) for (i in 1:length(branch) ) {
            if (!(is.null(branch[[i]]))) {
                branch[[i]] <- searchreplaceit(branch[[i]], whattag, whatattribs, totag, toattribs)
        } }
    } 
    return(branch)
}
搜索将一直进行,直到扫描完整个对象

唯一的困难是(1)ShinyObject生成的对象将
shinny.tag
list
子对象交织在一起;(2) 某些元素有时为空


该函数是一个递归函数;对于访问过的任何分支(类
shinny.tag的对象)或子列表,它都会返回修改过的元素。

Ok,非常有用,谢谢分享。在这种情况下,我想我会求助于
jQuery
。除非有人对对象而不是字符串提出解决方案,否则我很乐意接受这个答案。
b <- shinydashboard::box(collapsible = T)
swap_node(b, "//i", shiny::tags$i(class="fa fa-times"))
searchreplaceit <- function(branch, whattag, whatattribs, totag, toattribs) {
    if ("name" %in% names(branch)) {
        if ((branch$name == whattag)&&(identical( branch$attribs[names(whatattribs)], whatattribs))) {
            branch$name    <- totag
            branch$attribs <- modifyList(branch$attribs, toattribs)
        }
    }
    if (class(branch)=="shiny.tag") {
        if (length(branch$children)>0) for (i in 1: length(branch$children)) {
            if (!(is.null(branch$children[[i]]))) {
                branch$children[[i]] = searchreplaceit(branch$children[[i]], whattag, whatattribs, totag, toattribs)
        } }
    } else if (class(branch)=="list") {
        if (length(branch)>0) for (i in 1:length(branch) ) {
            if (!(is.null(branch[[i]]))) {
                branch[[i]] <- searchreplaceit(branch[[i]], whattag, whatattribs, totag, toattribs)
        } }
    } 
    return(branch)
}
b <- shinydashboard::box(collapsible = T)
searchreplaceit(b, "i", list(class="fa fa-minus"), "i", list(class="XXX"))
# <div class="col-sm-6">
#   <div class="box">
#     <div class="box-header">
#       <div class="box-tools pull-right">
#         <button class="btn btn-box-tool" data-widget="collapse">
#           <i class="XXX" role="presentation" aria-label="minus icon"></i>
#         </button>
#       </div>
#     </div>
#     <div class="box-body"></div>
#   </div>
# </div>