データ ：
https://www.kaggle.com/wood2174/mapkickstarter
だから私は光沢のある陰謀で作っている地図を持っていて、州をクリックしてからその州を引き上げてその州の郡に関する情報を得るのが好きです。よく iv プロットで他のリンクされたプロットの例を見ましたが、この方法でマップを設定する方法がわかりません。これはクリックする前の私のプロットです。
これは、iv が状態をクリックした後の私のマップです。
event_data 引数を使用して、2 つの間で正しい方法で引数を渡していないと確信しています。私が渡している引数は州の名前になり、その名前は、州名を呼び出すための文字として CT と呼ばれる私の関数に突き出されるので、クリックされた州から郡データを見つけることができます。 data と pop は、関数に渡される他の 2 つのデータ フレームです。これは、光沢のあるサーバーの外側で関数 douse を実行し、インタラクティブなホバー マップを生成するものです。
コード：
ui <- fluidPage(mainPanel(
navbarPage(
"Kickstarter",
navbarMenu(
"Maps",
tabPanel("US Map", plotlyOutput(
"plotMap", height = 900, width = 1200
)),
tabPanel("County Map",
plotlyOutput("Smap"),
plotlyOutput("Cmap"))
),
tabPanel(
"Interaction",
plotlyOutput("plotInt", height = 900, width = 1200)
),
navbarMenu(
"Barplots",
tabPanel("Citys", plotlyOutput(
"plotBar1", height = 900, width = 1200
)),
tabPanel(
"Catigories",
plotlyOutput("plotBar2", height = 900, width = 1200)
)
)
)
))
server <- function(input, output, session) {
#add reactive data information. Dataset = built in diamonds data
H <- read_csv("C:/Users/clint/Documents/R/Personal work/Masters Project/MasterKickstarter.csv")
M <- read_csv("C:/Users/clint/Documents/R/Personal work/Masters Project/data sets/Mapping.csv")
C <- read_csv("C:/Users/clint/Documents/R/Personal work/Masters Project/data sets/County.csv")
H <- as.data.frame(H)
M <- as.data.frame(M)
C <- as.data.frame(C)
### Plotting top twenty citys for a kick ###
# calculate frequencies
tab <- table(H$City)
# sort
tab_s <- sort(tab)
# extract 10 most frequent nationalities
top10 <- tail(names(tab_s), 25)
# subset of data frame
d_s <- subset(H, City %in% top10)
# order factor levels
d_s$City <- factor(d_s$City, levels = rev(top10))
#function for capitalization
simpleCap <- function(x) {
s <- strsplit(x, " ")[[1]]
paste(toupper(substring(s, 1, 1)),
substring(s, 2),
sep = "",
collapse = " ")
}
M$code <- state.abb[match(M$State, state.name)]
#making temp sets that fit for interactive maps
H = H[!duplicated(H[, "City"], fromLast = T), ]
H$State <- sapply(as.character(H$State), simpleCap)
H$code <- state.abb[match(H$State, state.name)]
H$City <- factor(H$City)
#making quartiles for plotting size
H$q <-
with(H, cut(All_Time_Backers_city, quantile(All_Time_Backers_city)))
levels(H$q) <-
paste(c("1st", "2nd", "3rd", "4th", "5th"), "Quantile")
H$q <- as.ordered(H$q)
CT <- function(r,data,pop){
cali <- map_data("county") %>%
filter(region == r)
cali_pop <- left_join(cali, pop, by = c("subregion","region"))
cali_pop$pop_cat <- with(cali_pop,
(paste0(cali_pop$subregion, "<br />",
round(cali_pop$MedianBackers), "Median Backers ||",round(cali_pop$MedianUSD),"MedianUSD","<br />",
round(cali_pop$MeanBackers), "Mean Backers ||",round(cali_pop$MeanUSD),"MeanUSD","<br />",
(cali_pop$TotalBackers), "Total Backers ||",(cali_pop$TotalUSD), "TotalUSD")))
cali_pop[is.na(cali_pop)] <- 0
cali_pop$pop_cat <- as.factor(cali_pop$pop_cat)
p <- cali_pop %>%
group_by(group) %>%
plot_ly(x = ~long, y = ~lat, color = ~pop_cat, colors = c('#ffeda0','#f03b20')) %>%
add_polygons(line = list(width = 0.4),showlegend = FALSE) %>%
add_polygons(
fillcolor = 'transparent',
line = list(color = 'black', width = 0.5),
showlegend = FALSE
) %>%
layout(
title = "Backers by County",
titlefont = list(size = 10),
xaxis = list(title = "", showgrid = FALSE,
zeroline = FALSE, showticklabels = FALSE),
yaxis = list(title = "", showgrid = FALSE,
zeroline = FALSE, showticklabels = FALSE)
)
p
}
output$Smap <- renderPlotly({
M$hover <- with(M, paste(State))
# give state boundaries a white border
l <- list(color = toRGB("white"), width = 2)
# specify some map projection/options
g <- list(
scope = 'north america',
showland = TRUE,
landcolor = toRGB("grey83"),
subunitcolor = toRGB("white"),
countrycolor = toRGB("white"),
showlakes = TRUE,
lakecolor = toRGB("white"),
showsubunits = TRUE,
showcountries = TRUE,
resolution = 50,
projection = list(type = 'conic conformal',
rotation = list(lon = -100)),
lonaxis = list(
showgrid = TRUE,
gridwidth = 0.5,
range = c(-140,-55),
dtick = 5
),
lataxis = list(
showgrid = TRUE,
gridwidth = 0.5,
range = c(15, 70),
dtick = 5
)
)
# Plotting a US interactive map
p <- plot_geo(source = "CCM") %>%
add_trace(M,
z = ~ M$`Mean Bakers`,
text = ~ M$hover,
x = ~M$State,
locations = ~ M$code,
locationmode = "USA-states"
) %>%
colorbar(title = "Money") %>%
layout(
title = 'Kickstarter USA',
geo = g
)
p
})
output$Cmap <- renderPlotly({
s <- event_data("plotly_click", source = "CCM")
if (length(s)){
var <- s[["x"]]
d <- setNames(M[var], "x")
CT(d,H,C)
}
})
output$plotBar1 <- renderPlotly({
p1 <- d_s %>% count(City, status) %>%
plot_ly(x = ~ City,
y = ~ n,
color = ~ status)
p1
})
output$plotBar2 <- renderPlotly({
p2 <- H %>% count(Categories, status) %>%
plot_ly(x = ~ Categories,
y = ~ n,
color = ~ status)
p2
})
output$plotMap <- renderPlotly({
#preparing the hover text
M$hover <- with(
M,
paste(
State,
'<br>',
"Pledges_total",
M$`Total Pledged`,
"Backers_total",
M$`Total Backers`,
"<br>",
"Mean_pledges",
M$`Mean Campaign USD`,
"Mean_backers",
M$`Mean Bakers`,
"<br>",
"Median Goal %",
M$`Median Percent of Goal`,
"Number of projects",
M$`Projects Per`
)
)
g <- list(
scope = 'north america',
showland = TRUE,
landcolor = toRGB("grey83"),
subunitcolor = toRGB("white"),
countrycolor = toRGB("white"),
showlakes = TRUE,
lakecolor = toRGB("white"),
showsubunits = TRUE,
showcountries = TRUE,
resolution = 50,
projection = list(type = 'conic conformal',
rotation = list(lon = -100)),
lonaxis = list(
showgrid = TRUE,
gridwidth = 0.5,
range = c(-140,-55),
dtick = 5
),
lataxis = list(
showgrid = TRUE,
gridwidth = 0.5,
range = c(15, 70),
dtick = 5
)
)
#plotting an interactive map for states and cities
p <- plot_geo(H, sizes = c(5, 250)) %>%
add_markers(
x = ~ H$Longitude,
y = ~ H$Latitude,
size = ~ H$All_Time_Backers_city,
color = ~ q,
text = ~ paste(H$City, "<br />",
H$All_Time_Backers_city, "Backers")
) %>%
add_trace(M,
z = ~ M$`Mean Campaign USD`,
text = ~ M$hover,
locations = ~ M$code
,
locationmode = "USA-states"
) %>%
layout(title = 'Backers City All Time', geo = g)
p
})
output$plotInt <- renderPlotly({
p <- H %>%
plot_ly() %>%
add_trace(
type = 'parcoords',
line = list(
color = ~ backers_count,
colorscale = 'Jet',
showscale = TRUE,
reversescale = TRUE,
cmin = 2,
cmax = 1500
),
dimensions = list(
list(
range = c(0, 92),
constrantrange = c(0, 30),
label = 'Time',
values = ~ Length_of_kick
),
list(
range = c(0, 2000),
constraintrange = c(0, 1000),
label = 'Pledge USD',
values = ~ Pledge_per_person
),
list(
range = c(0, 8000000),
constrantrange = c(0, 3000000),
label = 'Population',
values = ~ MasterKickstarter$City_Pop
),
list(
range = c(0, 1600),
constraintrange = c(0, 500),
label = 'Days Making',
values = ~ Days_spent_making_campign
),
list(
tickvals = c(1, 2, 3, 4, 5),
ticktext = c('cancled', 'failed', 'live', 'successful', 'suspended'),
label = 'Status',
values = ~ as.integer(as.factor(status))
),
list(
range = c(0, 1000000),
constraintrange = c(0, 300000),
label = 'Goal',
values = ~ goal
),
list(
tickvals = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15),
ticktext = c(
'art',
'comics',
'crafts',
'dance',
'design',
'fasion',
'film',
'food',
'games',
'journalism',
'music',
'photogaphy',
'publishing',
'technology',
'theator'
),
label = 'Catigories',
values = ~ as.integer(as.factor(Categories))
),
list(
range = c( ~ min(Prct_goal), 1200),
constraintrange = c(0, 500),
label = 'Prct goal',
values = ~ Prct_goal
)
)
)
p
})
}
shinyApp(ui, server)