Data :
https://www.kaggle.com/wood2174/mapkickstarter
So i have a map im making with shiny and plotly and id like to click on a state and then pull up that state to get info on the counties in that state. Well iv seen other linked plot examples in plotly but I am not sure how to set up my map in this way. this is my plot before clicking. 
This is my map after iv clicked a state:
I am pretty sure I am not passing arguments the correct way between the two using the event_data argument.
The argument i am passing is going to be the name of the state and that name will be pout into my function called CT as a character as to call up the state name so i can find the county data from clicked on state, the other, data and pop are two other data frames being passed into the function.
This is what the function douse outside of shiny server and it produces and interactive hover map:
Code:
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)
