サイド パネルの [地域を選択] という前の入力フィールドに基づいて、国のプロット用に [国を選択] という 2 番目の入力フィールドを作成しました。
updateSelectInput を使用して、指定されたデータ テーブルの「国」列を、各「地域」(列でもある) が選択された後に表示される名前として使用しました。
何らかの理由で、私が作成した「性別」と呼ばれるタブの 1 つで動作します。これは、使用されるデータ テーブルが異なることを除いて、まったく同じ形式です。「高等教育」タブの「性別」タブにコードのチャンクをほとんどコピーして貼り付けました。しかし、「高等教育」タブの場合、特定の地域を選択すると、「国の選択」のドロップダウン メニューが空白になりますが、その地域のリストにあると思われる最初の国のプロットが読み込まれていることがわかります。 .
因子と文字を切り替えて、変数「国」の型をいじってみました。現在、コードは「性別」タブでのみ機能します。私は機知に富んでいます。
誰かが私のコードの問題点を見つけることができますか?
データセットは次のようになります。
iso3 region participation country male female lower class
ALB region2 0.5262631 Albania 0.5834176 0.4702970 0.4285714
AND region1 0.6699900 Andorra 0.7236581 0.6160000 0.4117647
ARG region4 0.2857675 Argentina 0.3109277 0.2631020 0.2270694
「性別タブ」のデータセットは次のとおりです。
data.frame': 85 obs. of 4 variables:
$ region : Factor w/ 7 levels "region1","region2",..: 2 1 4 2 7 3 5 3 2 2 ...
$ country: Factor w/ 85 levels "Albania","Algeria",..: 1 3 4 5 6 7 13 8 12 10 ...
$ male : num 0.58 0.72 0.31 1 0.67 0.45 0.41 0.62 0.21 0.53 ...
$ female : num 0.47 0.62 0.26 1 0.67 0.4 0.24 0.38 0.16 0.35 ...
最高学歴タブのデータセットは次のとおりです。
'data.frame': 85 obs. of 8 variables:
$ region : Factor w/ 7 levels "region1","region2",..: 2 1 4 2 7 3 5 3 2 2
$ country : Factor w/ 85 levels "Albania","Algeria",..: 1 3 4 5 6 7 13 8
$ Primary : num 0.456 0.525 0.215 1 0.519 ...
$ Secondary.incomplete : num 0.489 0.614 0.337 0.995 0.727 ...
$ Secondary.vocational : num 0.561 0.681 0.324 1 0.768 ...
$ Secondary.preparatory: num 0.583 0.632 0.492 0.998 0.793 ...
$ Tertiary.incomplete : num 0.696 0.732 0.545 0.981 0.802 ...
$ Tertiary : num 0.728 0.833 0.625 0.997 0.854 ...
ui.R
library(shiny)
dataset <- wvs_c
shinyUI(fluidPage(
pageWithSidebar(
headerPanel("Membership in Associations in 85 countries using World Values Survey,
1981-2007"),
sidebarPanel(
selectInput("region", "Select a region:",
list("All World"= "the world",
"North America & Western Europe"="region1",
"Central Europe"="region2",
"Asia"="region3",
"Latina America & Caribbean"="region4",
"Sub-Saharan Africa"="region5",
"Middle East & Northern Africa"="region6",
"Oceania"="region7"),
selected= "the World" )
),
mainPanel(
h4("testing"),
tabsetPanel(
id = 'dataset',
tabPanel('Map', plotOutput("map")
, helpText("Probability of being a member of an association, types of
association included are
sports, arts, labor, politics, environment, women's rights, human rights,
charity, and other.")),
tabPanel('Gender', dataTableOutput('mytable'),
selectInput('country', 'Select a Country:',
names(wvs_c$country), selected=names(wvs_c$country)[1]),
plotOutput("myplot")
),
tabPanel('Highest education attained', dataTableOutput('mytable1'),
selectInput('country', 'Select a Country:',
names(wvs_c$country), selected=names(wvs_c$country)[1]),
plotOutput("myplot1")
)
),
p("Above is a graphical representation of rate of being an associational member.")
)
)))
サーバー.R
library(rworldmap)
library(plyr)
library(reshape)
library(ggplot2)
wvs_c <- read.csv("./wvs_c")
wvs_c <- wvs_c[, -1]
shinyServer(function(input,output,session) {
gender <- wvs_c[,c(2, 4:6)]
highested <- wvs_c[,c(2, 4, 12:17)]
colnames(highested) <- c("region", "country", "Primary", "Secondary.incomplete",
"Secondary.vocational","Secondary.preparatory",
"Tertiary.incomplete", "Tertiary")
# Create a second field of input "Select a country" based on the first input field
"Select a region"
observe({
region = input$region
updateSelectInput(session, "country",
choices = levels(as.factor(as.character(wvs_c$country[wvs_c$region==region]))),
selected = levels(as.factor(as.character(wvs_c$country[wvs_c$region==region])))[1]
)
})
# Create charts for each country's gender breakdown
selectedPlot <- reactive({
if (input$region == "the world") {
#for regional average of gender
test<- aggregate(gender[, c("male", "female")], by =
list(as.character(gender$region)), function(x) c(mean=mean(x)))
colnames(test)[1] <- "region"
test2 <- melt(test[,c('region','male','female')],id.vars = 1)
## codes for ggplot using "test2", works
} else {
region = input$region
country = input$country
cbbPalette <- c("#01DFD7", "#F78181")
x <- gender[(gender$country== country),]
x <- melt(x[,c('country','male','female')], id.vars = 1)
x1 <- ggplot(data=x, aes(x=variable, y=value))
x1 <- x1 + geom_bar(aes(fill = variable), position="dodge", stat="identity") +
scale_fill_manual(values=cbbPalette)
x1 <- x1 + labs(y = 'Percent of members', x = '') + theme(axis.text.x =
element_blank()) + ylim(0, 1) + theme(legend.title=element_blank())
x1
}
})
output$myplot = renderPlot({
selectedPlot()
}
)
# Create charts for each country's educational level breakdown
selectedPlot1 <- reactive({
if (input$region == "the world") {
test3 <- aggregate(highested_data[, c('Primary', 'Secondary.incomplete',
'Secondary.vocational','Secondary.preparatory', 'Tertiary.incomplete',
'Tertiary')], by = list(as.character(highested_data$region)), function(x)
c(mean=mean(x)))
colnames(test3)[1] <- "region"
test3 <- melt(test3[, c
('region','Primary','Secondary.incomplete','Secondary.vocational'
,'Secondary.preparatory','Tertiary.incomplete','Tertiary')],
id.vars = 1)
## codes for ggplot using "test3", works
} else {
region = input$region
country = input$country
cbbPalette1 <- c("#F7BE81", "#F79F81", "#82FA58", "#04B486", "#00BFFF",
"#01A9DB")
y <- highested[(highested$country == country),]
y <-melt(y[,
c('country','Primary','Secondary.incomplete','Secondary.vocational'
,'Secondary.preparatory','Tertiary.incomplete','Tertiary')], id.vars = 1)
y1 <- ggplot(data=y, aes(x=variable, y=value))
y1 <- y1 + geom_bar(aes(fill = variable), position="dodge", stat="identity")
+ scale_fill_manual(values=cbbPalette1)
y1 <- y1 + labs(y = 'Percent of members', x = '') + theme(axis.text.x =
element_blank()) + ylim(0, 1) +
theme(legend.title=element_blank())
y1
}
})
output$myplot1 = renderPlot({
selectedPlot1()
}
)