情节在闪亮的问题

我的 Shiny 遇到了一些问题，它使用情节来呈现多维缩放结果。下面是我的代码。我的任何问题的答案都会很棒，提前感谢。

library(shinythemes)
library(devtools)
library(shiny)
library(knitr)
library(plotly)
library(DT)
library(shinydashboard)
library(dplyr)    

# UI for People
shinyUI(dashboardPage(skin="yellow", dashboardHeader(title = "MDS"),
dashboardSidebar(fluidRow(column(12,selectInput("position", label = "Choose    Position", choices = c("Forward" = "Forward", "Back" = "Back")))),
                 uiOutput("Player"),
                 fluidRow(column(12, offset = 3, actionButton("go", "Plot Players", style = "color: #00004c;")))),
dashboardBody(fluidRow(column(12, plotlyOutput("plot"))),
              fluidRow(column(2, checkboxInput("checkbox", "See Player Details", value = FALSE))),
              fluidRow(column(12, DT::dataTableOutput('tableData'))))                 ))

# Server for people
shinyServer(function(input, output) {
People <- read.csv("People.csv", header = TRUE)
Forward = People[People$Position == "Forward",]
Back = People[People$Position == "Back",]
# Changing factors to characters
People$Initials = as.character(People$Initials)
People$Player = as.character(People$Player)
output$Player <- renderUI({
players = People[People$Position == input$position,1]  
players1 = c("All Players", players)
selectInput("players", "Select Players", players1, multiple = TRUE) })
# Presaved data sets by column value Position
positionInput <- reactive ({
switch(input$data,
       "Forward" = Forward,
       "Back" = Back)})
data <- eventReactive(input$go, {
if (is.null(input$players)) return()
else if(input$position == 'Forward')
{if (input$players=="All Players"){
    Dataplayers = Forward
    players.rows = row.names(Forward)
    cms = cmdscale(dist(Forward[, c(7:10)]), k=2, eig=TRUE)
    p1 <- cms$points[players.rows,1] 
    p2 <- cms$points[players.rows,2]
    xlim = c(min(cms$points[,1]), max(cms$points[,1]))
    ylim = c(min(cms$points[,2]), max(cms$points[,2]))
    df = isolate(cbind(p1, p2, Dataplayers))
    info = list(df = df, players.rows = players.rows, xlim = xlim, ylim = ylim, Dataplayers = Dataplayers)
    return(info)
  }
  picked = isolate(input$players)  # Return on selected players
  Dataplayers = Forward[Forward$Player %in% picked,]
  players.rows = row.names(Forward[Forward$Player %in% picked,])
  cms = cmdscale(dist(Forward[, c(7:10)]), k=2, eig=TRUE)
  p1 <- cms$points[players.rows,1] 
  p2 <- cms$points[players.rows,2]
  xlim = c(min(cms$points[,1]), max(cms$points[,1]))
  ylim = c(min(cms$points[,2]), max(cms$points[,2]))
  df = isolate(cbind(p1, p2, Dataplayers))
  info = list(df = df, players.rows = players.rows, xlim = xlim, ylim = ylim, Dataplayers = Dataplayers)
  return(info)
}
else if(input$position == 'Back')
{
  if (input$players=="All Players"){
    Dataplayers = Back
    players.rows = row.names(Back)
    cms = cmdscale(dist(Back[, c(7:10)]), k=2, eig=TRUE)
    p1 <- cms$points[players.rows,1] 
    p2 <- cms$points[players.rows,2]
    xlim = c(min(cms$points[,1]), max(cms$points[,1]))
    ylim = c(min(cms$points[,2]), max(cms$points[,2]))
    df = isolate(cbind(p1, p2, Dataplayers))
    info = list(df = df, players.rows = players.rows, xlim = xlim, ylim = ylim, Dataplayers = Dataplayers)
    return(info)
  }
  picked = isolate(input$players)  # Return on selected players
  Dataplayers = Back[Back$Player %in% picked,]
  players.rows = row.names(Back[Back$Player %in% picked,])
  cms = cmdscale(dist(Back[, c(7:10)]), k=2, eig=TRUE)
  p1 <- cms$points[players.rows,1] 
  p2 <- cms$points[players.rows,2]
  xlim = c(min(cms$points[,1]), max(cms$points[,1]))
  ylim = c(min(cms$points[,2]), max(cms$points[,2]))
  df = isolate(cbind(p1, p2, Dataplayers))
  info = list(df = df, players.rows = players.rows, xlim = xlim, ylim = ylim, Dataplayers = Dataplayers)
  return(info)
 }})

output$plot <- renderPlotly({
if (is.null(data())) return() # i.e. if action button is not pressed
else if(input$position == 'Forward'){
  playerData = data()$df
  ax <- list(
    zeroline = FALSE,
    showline = TRUE,
    showticklabels = FALSE,
    mirror = "ticks",
    gridcolor = toRGB("white"),
    zerolinewidth = 0,
    linecolor = toRGB("black"),
    linewidth = 2
  )
  p = plot_ly(playerData, x = p1, y = p2, mode = "markers",
              color = Sex, colors=c("blue","goldenrod2"),
              hoverinfo = "text", text = paste ("", Player , "<br>" , "Country: " , Country ),
              source = "mds") %>%
    layout(plot_bgcolor='transparent') %>% 
    layout(paper_bgcolor='transparent') %>%
    config(displayModeBar = T) %>% # Keep Mode bar
    layout(xaxis = ax, yaxis = ax) # No Axis
  p
}
else if(input$position == 'Back'){
  playerData = data()$df
  ax <- list(
    zeroline = FALSE,
    showline = TRUE,
    showticklabels = FALSE,
    mirror = "ticks",
    gridcolor = toRGB("white"),
    zerolinewidth = 0,
    linecolor = toRGB("black"),
    linewidth = 2
  )
  p = plot_ly(playerData, x = p1, y = p2, mode = "markers",
              color = Sex, colors=c("blue","goldenrod2"),
              hoverinfo = "text", text = paste ("", Player , "<br>" , "Country: " , Country ),
              source = "mds") %>%
    layout(plot_bgcolor='transparent') %>% 
    layout(paper_bgcolor='transparent') %>%
    config(displayModeBar = T) %>% # Kepp Mode bar
    layout(xaxis = ax, yaxis = ax) # No Axis
  p
}})

 output$tableData <- DT::renderDataTable({
 if (is.null(data())) return()
 if(input$checkbox==FALSE) return(NULL)
 # Try to get the zoomed data
 event.data <- event_data("plotly_zoom", source = "mds")
 # "plotly_relayout" "plotly_zoom"  # : These aren't working
 # Row numbers
 # print(event.data$pointNumber + 1)
 playerData = data()$Dataplayers
 # playerData = print(playerData[event.data$pointNumber + 1,]) # This returns each row as it is clicked. One row at a time can be seen
 playerData %>%
   select(c(1:10)) %>% 
   DT::datatable(rownames= FALSE, options = list(lengthMenu = c(5, 10), pageLength = 10))})
})

好的，所以，

a）如何进一步向下移动动作按钮（转到）"绘图玩家"，使其不会被向下滚动列表阻止？

b）我希望数据表根据用户的缩放进行调整。我可以让它适用于plotly_click（根据用户的点击进行调整），但不适用于plotly_relayout或plotly_zoom。或者尝试使用缩放点对表中的点进行排序（即显示表格顶部的缩放点）而不是尝试让表格仅显示缩放点会更简单吗？

c）悬停文本是否可能与标记文本不同。即我想要：标记 = "文本"，文本 = 首字母缩写悬停信息 = "文本"，文本 = 粘贴（"，播放器， "国家： " ，国家））也许添加首字母缩写的痕迹可能是一种选择？

d）颜色矢量无法正常工作。如果你选择同时绘制女孩和男孩，它会起作用。但是，如果您只选择女孩，例如当您选择颜色时，颜色不再是金色或蓝色。我想明确地说，女孩（性别列="F"）用金色绘制，男性用蓝色绘制。在这里，我这样做是为了一个非情节情节： player.col = rep（"gold"， nrow（playerData）） # 让所有 dat 行都涂成金色 male = which（playerData$=="M"） player.col[male] = "蓝色" # 颜色此行 = 'M' 蓝色 - 不是金色

正如你所看到的，如果男孩和女孩没有一起绘制，颜色是粉红色的......

非常感谢

以下是运行代码的数据：

           Player Initials Age   Country Sex Position Score Score2 Score3 Score4
1    Emily Duffy       ED  22   Ireland   F  Forward     9      3      2      5
2     Jim Turner       JT  26   England   M  Forward     8      4      6      5
3  Rachael Neill       RN  17 Australia   F  Forward     9      6      7      5
4    Andrew Paul       AP  45     Wales   M  Forward     5      7      4      5
5    Mark Andrew       MA  34   Ireland   M  Forward     5      8      5      4
6     Peter Bell       PB  56     Spain   M  Forward     5      7      6      3
7        Amy Coy       AC  77    France   F  Forward     6      6      7      5
8    James Leavy       JL  88  Portugal   M  Forward    10      7      4      5
9   John Connors       JC  87   Hungary   M  Forward     9      7      3      6
10  Paula Polley       PP  62    Russia   F  Forward     8      8      2      6
11  Sarah Turner       ST  23     China   F  Forward    10      9      5      6
12 Kerry McGowan     KMcG  27     Japan   F  Forward     7      6      6      6
13       Liz Foy       LF  71   England   F  Forward     5      6      7      6
14    Ann Mercer       AM  19      Peru   F     Back     4      6      9      6
15 Pete Morrison       PM  70    Norway   M     Back     7      6      8      6
16    Emma Duffy       ED  69    Poland   F     Back     8      6      7      4
17     Lucy Paul       LP  38   Iceland   F     Back     8      4      5      6
18 Rebecca Coyle       PC  43 Greenland   F     Back     9      4      6      6
19     Ben Carey       BC  45   Holland   M     Back     5      3      6      6

对于你的第一个问题，我会像这样尝试 smt：

  dashboardSidebar(
    fluidRow(
    column(6,selectInput("position", label = "Choose    Position", 
    choices = c("Forward" = "Forward", "Back" = "Back"))),
    column(6, offset = 3, actionButton("go", "Plot Players", style = "color: #00004c;"))),
    fluidRow(uiOutput("Player")))

相关内容

最新更新

热门标签：