【发布时间】：2017-01-27 09:19:30
【问题描述】：
我正在构建一个关于选举行为的闪亮仪表板， 我有 3 个小部件：性别、地区和政治党派，用户可以选择性别或/和地区或/和政治党派，仪表板将根据选择的输入显示一个情节，我在框中放了一个单选按钮在允许用户选择堆积条形图类型的绘图中：位置=“堆栈”或“填充”，我添加了一个操作按钮和隔离（）函数，以便页面上的所有输入不发送更新到服务器，直到按下按钮。但是，我希望指示堆叠条形图类型的单选按钮不被隔离：这是我使用的代码 R：
数据框
pff <- read.table(header=TRUE, text='
REGION Q99 Q101
Tunis Nahdha Femme
Tunis Jabha Femme
Tunis NidaaTounes Homme
Tunis Nepasvoter Femme
Tunis Nepasvoter Homme
Tunis Nepasvoter Femme
Tunis NidaaTounes Homme
Tunis Nepasvoter Homme
Tunis Nahdha Femme
Tunis NidaaTounes Femme
Tunis CPR Femme
Tunis Nahdha Femme
Tunis Autres Homme
Tunis Nepasvoter Homme
Tunis Nepasvoter Femme
Tunis Nahdha Homme
Tunis Jabha Homme
Tunis Nepasvoter Femme
Tunis Nahdha Homme
Tunis Nahdha Femme
Tunis JabhaChaabia Homme
Tunis Autres Femme
Tunis Nepasvoter Femme
Tunis NidaaTounes Femme
Tunis Nepasvoter Homme
Tunis NidaaTounes Femme
Tunis Nepasvoter Homme
Tunis NidaaTounes Homme
Tunis Jabha Femme
Tunis NidaaTounes Homme
Tunis Autres Homme
Tunis Nahdha Femme
Tunis Nahdha Homme
Tunis Autres Femme
Tunis Jabha Homme
Tunis Nepasvoter Femme
Tunis Nepasvoter Homme
Tunis CPR Femme
Tunis Nahdha Homme
Tunis Nepasvoter Femme
Tunis Nepasvoter Homme
Tunis Nepasvoter Femme
Tunis Nahdha Homme
Tunis NidaaTounes Femme
Tunis CPR Homme
Tunis CPR Femme
Tunis Nepasvoter Homme
Tunis Autres Homme
Tunis Nahdha Homme
Tunis NidaaTounes Homme
Tunis Nahdha Femme
Tunis Autres Femme
Tunis Nepasvoter Femme
Ariana Nahdha Femme
Ariana CPR Femme
Ariana Nahdha Femme
Ariana Nepasvoter Homme
Ariana NidaaTounes Homme
Ariana CPR Homme
Ariana Nepasvoter Homme
Ariana Nahdha Homme
Ariana Nepasvoter Femme
Ariana NidaaTounes Homme
Ariana CPR Homme
Ariana NidaaTounes Homme
Ariana NidaaTounes Homme
Ariana NidaaTounes Homme
Ariana CPR Femme
Ariana Nahdha Femme
Ariana CPR Femme
Ariana Nahdha Homme
Ariana Nahdha Homme
Ariana CPR Homme
Ariana Nahdha Homme
Ariana Nepasvoter Homme
Ariana NidaaTounes Homme
Ariana NidaaTounes Homme
Ariana Nahdha Homme ')
服务器
library(shiny)
library(ggplot2)
library(ggalt)
library(dplyr)
library(foreign)
library(plotly)
library(scales)
shinyServer(function(input, output) {
dataa<-reactive({
within(as.data.frame(pff),
Q99 <- factor(Q99,
levels=names(sort(table(Q99),
decreasing=FALSE))))})
partii2=reactive({
filter(dataa(), Q99 %in% input$parti, REGION %in% input$region)
})
output$plot1=renderPlotly({
input$action
isolate(
if(!is.null(input$parti) && !is.null(input$region) && input$genre=="Tous"){
if((length(input$region))==1)
{
g <- ggplot(partii2(), aes(x = Q99, y =(..count..)/sum(..count..)))
g <- g + geom_bar(fill="#0f00ee") + labs(title=paste("Vote dans la région de", input$region,"pour",input$parti,sep = " ")) +labs(x="Parti politique", y="")+coord_flip()+scale_y_continuous(labels = percent)+ theme_bw()+theme(panel.border = element_rect(colour = "white"))
}
else{
g <- ggplot(dataa(), aes(x = REGION, y =(..count..)/1200, fill=Q99))
g <- g + geom_bar(position=input$position) + labs(title="vote") +labs(x=" ", y=" ")+labs(fill="Parti Politique")+scale_y_continuous(labels = percent)+ theme_bw()+theme(panel.border = element_rect(colour = "white")) +coord_flip() + geom_text(aes( label = scales::percent(round((..count..)/1200,3 )),y=(..count..)/1200 ),stat= "count", size=4, position = "stack")
}
}
)
})
})
Ui
library(shiny)
library(shinydashboard)
library(foreign)
library(plotly)
shinyUI(dashboardPage(skin = "blue",
dashboardHeader(title = h4("Élections",style = "color:white"),
titleWidth = 300
),
dashboardSidebar(id="",
tags$head(
tags$script(
HTML(
"
$(document).ready(function(){
// Bind classes to menu items, easiet to fill in manually
var ids = ['Enquête','dashboard','Prédiction','Données','Échantillon'];
for(i=0; i<ids.length; i++){
$('a[data-value='+ids[i]+']').addClass('my_subitem_class');
}
// Register click handeler
$('.my_subitem_class').on('click',function(){
// Unactive menuSubItems
$('.my_subitem_class').parent().removeClass('active');
})
})
"
)
)),
sidebarMenu(
menuItem(h4(strong("Enquête")), tabName = "Enquête",
menuSubItem("Données",tabName = "Données"),
menuSubItem("Échantillon",tabName = "Échantillon")),
menuItem(h4(strong("Dashboard")), tabName = "dashboard"),
menuItem(h4(strong("Prédiction")), tabName = "Prédiction"))
),
dashboardBody(
tabItems(
tabItem(tabName = "dashboard",h2("Le comportement électoral des citoyens tunisiens", align="center",style = "color:blue"),
fluidRow(
tiltle="filtre",
column(width=4,
box(
title = "Filtre",
status = "primary",
width = 8,
solidHeader = TRUE,
background="navy",
box(
solidHeader = FALSE,
width = 8,
background = "navy" ,
radioButtons("genre", "Genre", c("Homme","Femme","Tous"),"Tous")
),
box(
solidHeader = FALSE,
width = 12,
background = "navy",
selectizeInput("region", label = "Région",
choices = levels(pff$REGION),
selected = "Ariana", multiple=TRUE)
),
box(
solidHeader = FALSE,
width = 12,
background = "navy",
selectizeInput("parti", label = "Parti politique",
choices = levels(pff$Q99),
selected = "CPR", multiple=TRUE)
),
box(
actionButton("action","Mettre à jour!"),
#submitButton("Mettre à jour!",icon("refresh")),
background = "navy"
)
)
),
box(
solidHeader = FALSE ,width = 8,height = 500,
collapsible = TRUE,align="center",
radioButtons("position", "", c("fill","stack"), selected = "fill", inline = TRUE, width = NULL),
plotlyOutput('plot1', height = 400,width = "100%")
)
)# end of fluidrow
)
))))
【问题讨论】：
标签： r shiny shinydashboard