数据 ：
https://www.kaggle.com/wood2174/mapkickstarter
所以我有一张我正在制作的地图，上面有光泽和情节，我喜欢点击一个州，然后拉起该州以获取该州各县的信息。好吧，我在 plotly 中看到了其他链接的绘图示例，但我不确定如何以这种方式设置我的地图。这是我点击之前的情节。
这是我点击一个州后的地图：
我很确定我没有使用 event_data 参数在两者之间以正确的方式传递参数。我传递的参数将是州的名称，该名称将作为一个字符放入我的名为 CT 的函数中，以调用州名，以便我可以从单击的州中找到县数据，另一个， data 和 pop 是传递给函数的另外两个数据帧。这就是闪亮服务器之外的功能，它产生和交互式悬停地图：
代码：
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)
