首页 > 解决方案 > 如何在 R fmsb 中为 R Shiny 移动雷达图/蜘蛛图标签,使标签不与绘图重叠?

问题描述

fmsb我有一个闪亮的应用程序,它使用基于用户在简短测验中输入的包创建蜘蛛图。但是,其中 2 个标签与情节重叠,我找不到将它们移到更远的方法。

在此处输入图像描述

我试过玩这个paxislabels论点,但我无法弄清楚,帮助文档或这个伟大的教程在这部分不清楚。我希望水平标签像垂直标签一样——在情节之外。

这是一个可重现的示例:


library(shiny)
library(fmsb)
library(ggplot2)

ui <- fluidPage(


    sidebarLayout(
        sidebarPanel(                     selectInput("q1", label = "question 1", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
                                          selectInput("q2", label = "question 2", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
                                          selectInput("q3", label = "question 3", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
                                          selectInput("q4", label = "question 4", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
                                          selectInput("q5", label = "question 5", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
                                          selectInput("q6", label = "question 6", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
                                          selectInput("q7", label = "question 7", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
                                          actionButton("submit", "Submit")),

        mainPanel(
            mainPanel(plotOutput("spider_chart"))
        )
    )
)

server <- function(input, output) {
    
    data_scores <- reactive({
        
        #Make tibble of raw data
        raw_data <- tibble(`Variable 1` = sum(c(as.numeric(input$q1), as.numeric(input$q2), na.rm = T)),
                              `Variable 2` = sum(c(as.numeric(input$q2), as.numeric(input$q3)), na.rm = T),
                              `Variable 3` = sum(c(as.numeric(input$q4), as.numeric(input$q5)), na.rm = T),
                              `Variable 4` = sum(c(as.numeric(input$q5), as.numeric(input$q6), as.numeric(input$q7)), na.rm = T))
    
        #fbsm needs the first 2 rows to be the max and min values
        min_max <- tibble(`Variable 1` = c(2, 0),
                          `Variable 2` = c(2, 0),
                          `Variable 3` = c(2, 0),
                          `Variable 4` = c(3, 0))
        
        min_max %>%
            full_join(raw_data)
        
    })
    
#This is the section that needs to be updated
    output$spider_chart <- renderPlot({
        req(input$submit)
        
        colors_border=rgb(.5, 0, .5, .9)
        colors_in=rgb(.5, 0, .5, .5)
        
        # plot with default options:
        radarchart(data_scores(), 
                   #custom polygon
                   pcol=  colors_border, pfcol=colors_in , plwd=4 , plty=1,
                   #custom the grid
                   cglcol="grey", cglty=1, axislabcol="grey",cglwd=0.8, paxislabels = c(10, 10, 10, 10),
                   #custom labels
                   vlcex= 1.2
        )  })

}

# Run the application 
shinyApp(ui = ui, server = server)

标签: rshinydata-visualizationaxis-labelsradar-chart

解决方案


我直接写信给 fmsb 的创建者 Minato Nakazawa,他提供了一个非常容易实现的答案。简而言之,所有标签的行为都像一般的文本字符串,所以他建议使用vlabelradarchart()调用中的参数重命名变量,并在两个水平轴标题中添加空格,并且成功了!下面是添加 10 个空格后的样子:

在此处输入图像描述

这是添加的完整代码:


library(shiny)
library(fmsb)
library(ggplot2)

ui <- fluidPage(


    sidebarLayout(
        sidebarPanel(                     selectInput("q1", label = "question 1", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
                                          selectInput("q2", label = "question 2", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
                                          selectInput("q3", label = "question 3", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
                                          selectInput("q4", label = "question 4", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
                                          selectInput("q5", label = "question 5", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
                                          selectInput("q6", label = "question 6", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
                                          selectInput("q7", label = "question 7", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
                                          actionButton("submit", "Submit")),

        mainPanel(
            mainPanel(plotOutput("spider_chart"))
        )
    )
)

server <- function(input, output) {
    
    data_scores <- reactive({
        
        #Make tibble of raw data
        raw_data <- tibble(`Variable 1` = sum(c(as.numeric(input$q1), as.numeric(input$q2), na.rm = T)),
                              `Variable 2` = sum(c(as.numeric(input$q2), as.numeric(input$q3)), na.rm = T),
                              `Variable 3` = sum(c(as.numeric(input$q4), as.numeric(input$q5)), na.rm = T),
                              `Variable 4` = sum(c(as.numeric(input$q5), as.numeric(input$q6), as.numeric(input$q7)), na.rm = T))
    
        #fbsm needs the first 2 rows to be the max and min values
        min_max <- tibble(`Variable 1` = c(2, 0),
                          `Variable 2` = c(2, 0),
                          `Variable 3` = c(2, 0),
                          `Variable 4` = c(3, 0))
        
        min_max %>%
            full_join(raw_data)
        
    })
    
#This is the section that needs to be updated
    output$spider_chart <- renderPlot({
        req(input$submit)
        
        colors_border=rgb(.5, 0, .5, .9)
        colors_in=rgb(.5, 0, .5, .5)
        
        # plot with default options:
        radarchart(data_scores(), 
                   #custom polygon
                   pcol=  colors_border, pfcol=colors_in , plwd=4 , plty=1, vlabels = c("Variable 1", "Variable 2          ", "Variable 3", "          Variable 4"),
                   #custom the grid
                   cglcol="grey", cglty=1, axislabcol="grey",cglwd=0.8, paxislabels = c(10, 10, 10, 10),
                   #custom labels
                   vlcex= 1.2
        )  })

}

# Run the application 
shinyApp(ui = ui, server = server)

非常感谢 Minato Nakazawa 创建了这个包并及时回复了我的询问。


推荐阅读