如何在李克特图中嵌入链接，每个李克特项目的单独链接

Question

我正在尝试使用 likert 包和 gridSVG 包的组合将超链接嵌入到 likert 数据图中。我想将每个问题的文本链接到单独的链接，但我遇到了问题。以下代码将单个链接嵌入到每个问题的文本中，但我无法弄清楚如何分别嵌入每个问题，因为这组问题似乎被组合在一起。提前感谢您的意见。

#creates an example plot from sample data from likert package.
require(likert) 
data(pisaitems)
items29 <- pisaitems[,substr(names(pisaitems), 1,5) ==  "ST25Q" ]
names(items29) <- c("Magazines", "Comic books", "Fiction",
               "Non-fiction books", "Newspapers")
l29 <- likert(items29)
summary(l29)
plot(l29)

require(grid)
require(gridSVG)

#identifies grob of question text (all questions are in a single grob)
titleGrobName <- grep("axis-l.3-3-3-3", grid.ls(print=FALSE)$name, value=TRUE)

#embeds link in grob
grid.hyperlink(titleGrobName, "http://www.r-project.org")

#creates svg
gridToSVG("testPlot.svg", "none", "none")

Answer 1

这种分组GROB 并不少见。由于我认为我们不想重写likert 来取消组合这些，因此我们最好通过在grid 之后使用XML 来操作SVG。这是实现此目的的一种方法。

live example

如果您希望此图形成为更大网页的一部分，我们还可以在 HTML/JavaScript 一侧添加链接。

#creates an example plot from sample data from likert package.
require(likert) 
data(pisaitems)
items29 <- pisaitems[,substr(names(pisaitems), 1,5) ==  "ST25Q" ]
names(items29) <- c("Magazines", "Comic books", "Fiction",
                    "Non-fiction books", "Newspapers")
l29 <- likert(items29)
summary(l29)
plot(l29)

# if possible to use htmltools from RStudio
#   install.packages("htmltools")
#  then we can add the links on the
#  XML side instead of in grid
library(XML)
library(htmltools)
library(gridSVG)

# export as XML SVG
likert_svg <- grid.export("", addClasses=TRUE)$svg

# find our axes
nodes <- getNodeSet(
  likert_svg,
  # thanks http://stackoverflow.com/questions/5818681/xpath-how-to-select-node-with-some-attribute-by-index
  "(//x:g[contains(@id,'axis')])[1]//x:tspan",
  "x"
)

lapply(
  nodes,
  function(node){
    # get the text value of the node
    lbl = xmlValue(node)
    # remove the text from our node
    xmlValue(node) <- ""

    # create a <a href=> hyperlink
    #  https://www.w3.org/wiki/SVG_Links
    a_node <- newXMLNode(
      "a",
      #######   change your link here ###########
      attrs = c("xlink:href"=paste0("http://google.com/search?q=",lbl)),
      lbl
    )
    # add our new linked text to the node
    addChildren(node, a_node)
  }
)


# look at it in the browser/RStudio Viewer
browsable(
  HTML(
    saveXML(
      #  export as SVG XML
      likert_svg,
      prefix = ""
    )
  )
)