Ich habe ein paar Probleme mit meinem Shiny, die Plotly verwendet, um die Multidimensional Scaling Ergebnisse zu präsentieren. Unten ist mein Code. Eine Antwort auf alle meine Fragen wäre großartig, danke im Voraus.Plotly in Shiny Probleme
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))})
})
Ok so,
a) Wie kann ich die Aktionstaste bewegen (go) 'Plot des Spieler weiter nach unten, so dass es nicht von der Scroll-Down-Liste gesperrt ist?
b) Ich möchte die Datentabelle an den Zoom des Benutzers anpassen. Ich kann es für plotly_click (Anpassung an den Klick des Benutzers) arbeiten, aber nicht für plotly_relayout oder plotly_zoom. Oder wäre es eine einfachere Möglichkeit zu versuchen, die gezoomten Punkte zu verwenden, um die Punkte in der Tabelle anzuordnen (d. H. Gezoomte Punkte an der Spitze der angezeigten Tabelle) anstatt zu versuchen, dass die Tabelle nur die gezoomten Punkte zeigt?
c) Ist es möglich, dass der Hover-Text vom Markentext abweicht? I.e. Ich möchte: marker = "text", text = Initialen Hoverinfo = "Text", Text = Einfügen ("", Player, "Land:", Land)) Vielleicht eine Spur von Initialen hinzufügen könnte eine Option sein?
d) Der Farbvektor funktioniert nicht richtig. Wenn Sie wählen, um Mädchen und Jungen zu plotten, funktioniert es. Wenn Sie jedoch nur Mädchen wählen, zum Beispiel wenn Sie die Farbe auswählen, ist nicht mehr Gold oder Blau. Ich möchte ausdrücklich sagen, dass Mädchen (Sex column = 'F') in Gold und Männer in Blau dargestellt sind. Hier habe ich es für einen Plotplot gemacht: player.col = rep ("gold", nrow (playerData)) # lass alle Reihen von dat goldfarben sein male = was (playerData $ Sex == "M") player.col [männlich] = "blau" # color this rows = 'M' blau - nicht gold
Wie Sie sehen können, wenn beide Jungen und Mädchen nicht zusammen geplottet werden, sind die Farben rosa ....
Vielen dank
Hier werden die Daten um den Code auszuführen:
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