我的 Shiny 使用 plotly 呈现多维缩放结果时遇到了一些问题。下面是我的代码。我的任何问题的答案都会很棒，在此先感谢。
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) 如何将动作按钮 (go) 'Plot Players' 进一步向下移动，使其不会被向下滚动列表阻止？
b) 我希望数据表能够适应用户的缩放。我可以让它为 plotly_click 工作（调整到用户的点击），但不适用于 plotly_relayout 或 plotly_zoom。或者尝试使用缩放点对表格中的点进行排序（即显示表格顶部的缩放点）而不是尝试让表格仅显示缩放点会是一个更简单的选择吗？
c）悬停文本是否可能与标记文本不同。即我想要： marker = "text", text = Initials hoverinfo = "text", text = paste ("", Player, "Country: " , Country )) 也许添加首字母的痕迹可能是一种选择？
d) 颜色矢量工作不正常。如果您选择同时绘制女孩和男孩，它会起作用。但是，如果您只选择女孩，例如当您选择颜色时，颜色不再是金色或蓝色。我想明确地说女孩（性别列='F'）用金色绘制，男性用蓝色绘制。在这里，我为一个非情节情节做了它： player.col = rep("gold", nrow(playerData)) # 让所有 dat 行都涂成金色 male = which(playerData$Sex=="M") player. col[male] = "blue" # 将此行着色 = '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