0
내 반짝이는 몇 가지 문제가 있습니다. 다차원 스케일링 결과를 나타 내기 위해 플롯을 사용합니다. 아래 코드는 내 코드입니다. 내 질문에 대한 답변은 좋을 것입니다. 미리 감사드립니다.반짝이는 문제가 있습니다.
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) 호버 텍스트가 표식 텍스트와 다를 수 있습니다. 나는.marker = "text", text = 이니셜 hoverinfo = "텍스트", 텍스트 = 붙여 넣기 ("", Player, "Country :", Country)) 아마도 이니셜의 흔적을 추가하는 것이 옵션 일 수 있습니까?
d) 색상 벡터가 제대로 작동하지 않습니다. 소녀와 소년 모두를 음모로 선택하면 효과가 있습니다. 그러나 예를 들어 여아를 선택하는 경우 색상을 선택할 때 더 이상 금색이나 파란색이 아닙니다. 나는 소녀들 (Sex column = 'F')이 금으로 그려졌고 수컷은 푸른 색으로되어 있다고 분명히 말하고 싶다. 여기 나는 음모가 아닌 음모를 꾸미기 위해 : player.col = rep ("gold", nrow (playerData)) # 모든 행에 금색을 입히게하십시오. male = which (playerData $ Sex == "M") player.col [남성] = "파란색"# 색상이 행 = '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