我正在开发一个闪亮的应用程序,它可以让您知道哪些地方适合您居住,这是正确的工作应用程序:
到目前为止我很喜欢它,但我真的更希望有一个可以放大的传单地图而不是静态地图,但到目前为止,我在传单包渲染或更新栅格时遇到了很多问题。如果您需要这些文件,github 存储库就是这个 repository
这是应用程序现在的代码服务器:
library(shiny)
library(raster)
library(rworldmap)
library(rgdal)
library(dplyr)
data("countriesCoarse")
uno <- readRDS("uno.rds")
World <- getData('worldclim', var='bio', res=10)
cities <- readRDS("cities.rds")
shinyServer(function(input, output) {
output$distPlot <- renderPlot({
uno[World[[10]] > ifelse(input$degrees == "Celcius", (input$MaxTempC*10), (((input$MaxTempF-32)*5/9)*10))] <- NA
uno[World[[11]] < ifelse(input$degrees == "Celcius", (input$MinTempC*10), (((input$MinTempF-32)*5/9)*10))] <- NA
uno[World[[1]] < ifelse(input$degrees == "Celcius", min(input$RangeTempC*10), min(((input$RangeTempF-32)*5/9)*10))] <- NA
uno[World[[1]] > ifelse(input$degrees == "Celcius", max(input$RangeTempC*10), max(((input$RangeTempF-32)*5/9)*10))] <- NA
uno[World[[12]] < ifelse(input$degrees == "Celcius", min(input$RangePPC), min(input$RangePPF*25.4))] <- NA
uno[World[[12]] > ifelse(input$degrees == "Celcius", max(input$RangePPC), max(input$RangePPF*25.4))] <- NA
plot(uno, col ="red", legend = FALSE)
plot(countriesCoarse, add = TRUE)
})
output$downloadPlot <- downloadHandler(
filename = function() { paste("WhereToLive", '.png', sep='') },
content = function(file) {
png(file)
uno[World[[10]] > ifelse(input$degrees == "Celcius", (input$MaxTempC*10), (((input$MaxTempF-32)*5/9)*10))] <- NA
uno[World[[11]] < ifelse(input$degrees == "Celcius", (input$MinTempC*10), (((input$MinTempF-32)*5/9)*10))] <- NA
uno[World[[1]] < ifelse(input$degrees == "Celcius", min(input$RangeTempC*10), min(((input$RangeTempF-32)*5/9)*10))] <- NA
uno[World[[1]] > ifelse(input$degrees == "Celcius", max(input$RangeTempC*10), max(((input$RangeTempF-32)*5/9)*10))] <- NA
uno[World[[12]] < ifelse(input$degrees == "Celcius", min(input$RangePPC), min(input$RangePPF*25.4))] <- NA
uno[World[[12]] > ifelse(input$degrees == "Celcius", max(input$RangePPC), max(input$RangePPF*25.4))] <- NA
plot(uno, col ="red", legend = FALSE)
plot(countriesCoarse, add = TRUE)
dev.off()
})
output$visFun <- renderDataTable({
uno[World[[10]] > ifelse(input$degrees == "Celcius", (input$MaxTempC*10), (((input$MaxTempF-32)*5/9)*10))] <- NA
uno[World[[11]] < ifelse(input$degrees == "Celcius", (input$MinTempC*10), (((input$MinTempF-32)*5/9)*10))] <- NA
uno[World[[1]] < ifelse(input$degrees == "Celcius", min(input$RangeTempC*10), min(((input$RangeTempF-32)*5/9)*10))] <- NA
uno[World[[1]] > ifelse(input$degrees == "Celcius", max(input$RangeTempC*10), max(((input$RangeTempF-32)*5/9)*10))] <- NA
uno[World[[12]] < ifelse(input$degrees == "Celcius", min(input$RangePPC), min(input$RangePPF*25.4))] <- NA
uno[World[[12]] > ifelse(input$degrees == "Celcius", max(input$RangePPC), max(input$RangePPF*25.4))] <- NA
cities$exists <- extract(uno, cities[,2:3])
cities <- filter(cities, exists == 1)
cities <- cities[,c(1,4,5,6)]
cities <- filter(cities, pop > min(as.numeric(as.character(input$Population))))
cities <- filter(cities, pop < max(as.numeric(as.character(input$Population))))
cities
})
output$downloadData <- downloadHandler(
filename = function() { paste("cities", '.csv', sep='') },
content = function(file) {
uno[World[[10]] > ifelse(input$degrees == "Celcius", (input$MaxTempC*10), (((input$MaxTempF-32)*5/9)*10))] <- NA
uno[World[[11]] < ifelse(input$degrees == "Celcius", (input$MinTempC*10), (((input$MinTempF-32)*5/9)*10))] <- NA
uno[World[[1]] < ifelse(input$degrees == "Celcius", min(input$RangeTempC*10), min(((input$RangeTempF-32)*5/9)*10))] <- NA
uno[World[[1]] > ifelse(input$degrees == "Celcius", max(input$RangeTempC*10), max(((input$RangeTempF-32)*5/9)*10))] <- NA
uno[World[[12]] < ifelse(input$degrees == "Celcius", min(input$RangePPC), min(input$RangePPF*25.4))] <- NA
uno[World[[12]] > ifelse(input$degrees == "Celcius", max(input$RangePPC), max(input$RangePPF*25.4))] <- NA
cities$exists <- extract(uno, cities[,2:3])
cities <- filter(cities, exists == 1)
cities <- filter(cities$pop > min(input$Population))
cities <- filter(cities$pop < max(input$Population))
cities <- cities[,c(1,4,5,6)]
write.csv(cities, file)
}
)
})
用户界面:
library(shiny)
library(raster)
library(rworldmap)
library(rgdal)
data("countriesCoarse")
shinyUI(fluidPage(
titlePanel("Where should you live according to your climate preferences?"),
sidebarLayout(
sidebarPanel(
h3("Select your climate preferences"),
p("Using worldclim database, and knowing your climate prefeneces, you can now using this tool get an idea of where in the world you should live."),
p("Just use the sliders to anwer the simple questions we ask and you will get a map together with a downloadable table of where the climate suits you."),
selectInput(inputId = "degrees", label = "Temp units:", choices =
c("Celcius"= "Celcius",
"Fahrenheit" = "Fahrenheit")),
submitButton("Update View", icon("refresh")),
conditionalPanel(condition = "input.degrees == 'Celcius'",
sliderInput(inputId = "MaxTempC",
label = "What's the average maximum temperature you want to endure during the summer?",
min = 0,
max = 50,
value = 30),
sliderInput(inputId = "MinTempC",
label = "What's the average minimum temperature you want to endure during the winter?",
min = -40,
max = 60,
value = 0),
sliderInput(inputId = "RangeTempC",
label = "What's your prefered temperature range?",
min = -10,
max = 30,
value = c(0, 20)),
sliderInput(inputId = "RangePPC",
label = "What's your prefered precipitation range?",
min = 0,
max = 5000,
value = c(0, 5000))),
conditionalPanel(condition = "input.degrees == 'Fahrenheit'",
sliderInput(inputId = "MaxTempF",
label = "What's the average maximum temperature you want to endure during the summer?",
min = 0,
max = 120,
value = 90),
sliderInput(inputId = "MinTempF",
label = "What's the average minimum temperature you want to endure during the winter?",
min = -40,
max = 60,
value = 32),
sliderInput(inputId = "RangeTempF",
label = "What's your prefered temperature range?",
min = -40,
max = 90,
value = c(32, 70)),
sliderInput(inputId = "RangePPF",
label = "What's your prefered precipitation range?",
min = 0,
max = 200,
value = c(0, 200))),
sliderInput(inputId = "Population",
label = "how big of a town do you want to live in (Population)?",
min = 0,
max = 20000000,
value = c(0, 20000000, by = 1)))
,
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot"),
downloadButton('downloadPlot', 'Download Plot'),
dataTableOutput("visFun"),
downloadButton('downloadData', 'Download Table')
)
)
))
到目前为止一切都很好,但是当我尝试将其更改为使用传单地图时,它效果不太好,事实上传单地图没有出现,我已经尝试过:
服务器:
library(shiny)
library(raster)
library(rworldmap)
library(rgdal)
library(dplyr)
library(leaflet)
library(sp)
data("countriesCoarse")
uno <- readRDS("uno.rds")
World <- getData('worldclim', var='bio', res=10)
cities <- readRDS("cities.rds")
shinyServer(function(input, output) {
output$map <- renderLeaflet({
uno[World[[10]] > ifelse(input$degrees == "Celcius", (input$MaxTempC*10), (((input$MaxTempF-32)*5/9)*10))] <- NA
uno[World[[11]] < ifelse(input$degrees == "Celcius", (input$MinTempC*10), (((input$MinTempF-32)*5/9)*10))] <- NA
uno[World[[1]] < ifelse(input$degrees == "Celcius", min(input$RangeTempC*10), min(((input$RangeTempF-32)*5/9)*10))] <- NA
uno[World[[1]] > ifelse(input$degrees == "Celcius", max(input$RangeTempC*10), max(((input$RangeTempF-32)*5/9)*10))] <- NA
uno[World[[12]] < ifelse(input$degrees == "Celcius", min(input$RangePPC), min(input$RangePPF*25.4))] <- NA
uno[World[[12]] > ifelse(input$degrees == "Celcius", max(input$RangePPC), max(input$RangePPF*25.4))] <- NA
l <- leaflet() %>% setView(0, 0, zoom = 1)
l <- l %>% addRasterImage(uno)
l
})
output$downloadPlot <- downloadHandler(
filename = function() { paste("WhereToLive", '.png', sep='') },
content = function(file) {
png(file)
uno[World[[10]] > ifelse(input$degrees == "Celcius", (input$MaxTempC*10), (((input$MaxTempF-32)*5/9)*10))] <- NA
uno[World[[11]] < ifelse(input$degrees == "Celcius", (input$MinTempC*10), (((input$MinTempF-32)*5/9)*10))] <- NA
uno[World[[1]] < ifelse(input$degrees == "Celcius", min(input$RangeTempC*10), min(((input$RangeTempF-32)*5/9)*10))] <- NA
uno[World[[1]] > ifelse(input$degrees == "Celcius", max(input$RangeTempC*10), max(((input$RangeTempF-32)*5/9)*10))] <- NA
uno[World[[12]] < ifelse(input$degrees == "Celcius", min(input$RangePPC), min(input$RangePPF*25.4))] <- NA
uno[World[[12]] > ifelse(input$degrees == "Celcius", max(input$RangePPC), max(input$RangePPF*25.4))] <- NA
plot(uno, col ="red", legend = FALSE)
plot(countriesCoarse, add = TRUE)
dev.off()
})
output$visFun <- renderDataTable({
uno[World[[10]] > ifelse(input$degrees == "Celcius", (input$MaxTempC*10), (((input$MaxTempF-32)*5/9)*10))] <- NA
uno[World[[11]] < ifelse(input$degrees == "Celcius", (input$MinTempC*10), (((input$MinTempF-32)*5/9)*10))] <- NA
uno[World[[1]] < ifelse(input$degrees == "Celcius", min(input$RangeTempC*10), min(((input$RangeTempF-32)*5/9)*10))] <- NA
uno[World[[1]] > ifelse(input$degrees == "Celcius", max(input$RangeTempC*10), max(((input$RangeTempF-32)*5/9)*10))] <- NA
uno[World[[12]] < ifelse(input$degrees == "Celcius", min(input$RangePPC), min(input$RangePPF*25.4))] <- NA
uno[World[[12]] > ifelse(input$degrees == "Celcius", max(input$RangePPC), max(input$RangePPF*25.4))] <- NA
cities$exists <- extract(uno, cities[,2:3])
cities <- filter(cities, exists == 1)
cities <- cities[,c(1,4,5,6)]
cities <- filter(cities, pop > min(as.numeric(as.character(input$Population))))
cities <- filter(cities, pop < max(as.numeric(as.character(input$Population))))
cities
})
output$downloadData <- downloadHandler(
filename = function() { paste("cities", '.csv', sep='') },
content = function(file) {
uno[World[[10]] > ifelse(input$degrees == "Celcius", (input$MaxTempC*10), (((input$MaxTempF-32)*5/9)*10))] <- NA
uno[World[[11]] < ifelse(input$degrees == "Celcius", (input$MinTempC*10), (((input$MinTempF-32)*5/9)*10))] <- NA
uno[World[[1]] < ifelse(input$degrees == "Celcius", min(input$RangeTempC*10), min(((input$RangeTempF-32)*5/9)*10))] <- NA
uno[World[[1]] > ifelse(input$degrees == "Celcius", max(input$RangeTempC*10), max(((input$RangeTempF-32)*5/9)*10))] <- NA
uno[World[[12]] < ifelse(input$degrees == "Celcius", min(input$RangePPC), min(input$RangePPF*25.4))] <- NA
uno[World[[12]] > ifelse(input$degrees == "Celcius", max(input$RangePPC), max(input$RangePPF*25.4))] <- NA
cities$exists <- extract(uno, cities[,2:3])
cities <- filter(cities, exists == 1)
cities <- filter(cities$pop > min(input$Population))
cities <- filter(cities$pop < max(input$Population))
cities <- cities[,c(1,4,5,6)]
write.csv(cities, file)
}
)
})
和
用户界面:
library(shiny)
library(raster)
library(rworldmap)
library(rgdal)
library(leaflet)
data("countriesCoarse")
shinyUI(fluidPage(
titlePanel("Where should you live according to your climate preferences?"),
sidebarLayout(
sidebarPanel(
h3("Select your climate preferences"),
p("Using worldclim database, and knowing your climate prefeneces, you can now using this tool get an idea of where in the world you should live."),
p("Just use the sliders to anwer the simple questions we ask and you will get a map together with a downloadable table of where the climate suits you."),
selectInput(inputId = "degrees", label = "Temp units:", choices =
c("Celcius"= "Celcius",
"Fahrenheit" = "Fahrenheit")),
submitButton("Update View", icon("refresh")),
conditionalPanel(condition = "input.degrees == 'Celcius'",
sliderInput(inputId = "MaxTempC",
label = "What's the average maximum temperature you want to endure during the summer?",
min = 0,
max = 50,
value = 30),
sliderInput(inputId = "MinTempC",
label = "What's the average minimum temperature you want to endure during the winter?",
min = -40,
max = 60,
value = 0),
sliderInput(inputId = "RangeTempC",
label = "What's your prefered temperature range?",
min = -10,
max = 30,
value = c(0, 20)),
sliderInput(inputId = "RangePPC",
label = "What's your prefered precipitation range?",
min = 0,
max = 5000,
value = c(0, 5000))),
conditionalPanel(condition = "input.degrees == 'Fahrenheit'",
sliderInput(inputId = "MaxTempF",
label = "What's the average maximum temperature you want to endure during the summer?",
min = 0,
max = 120,
value = 90),
sliderInput(inputId = "MinTempF",
label = "What's the average minimum temperature you want to endure during the winter?",
min = -40,
max = 60,
value = 32),
sliderInput(inputId = "RangeTempF",
label = "What's your prefered temperature range?",
min = -40,
max = 90,
value = c(32, 70)),
sliderInput(inputId = "RangePPF",
label = "What's your prefered precipitation range?",
min = 0,
max = 200,
value = c(0, 200))),
sliderInput(inputId = "Population",
label = "how big of a town do you want to live in (Population)?",
min = 0,
max = 20000000,
value = c(0, 20000000, by = 1)))
,
# Show a plot of the generated distribution
mainPanel(
leafletOutput("map", width = "100%", height = "100%"),
downloadButton('downloadPlot', 'Download Plot'),
dataTableOutput("visFun"),
downloadButton('downloadData', 'Download Table')
)
)
))
这不会引发任何错误,但地图未渲染,并且我有以下警告
Listening on http://127.0.0.1:7231
Warning in rgdal::rawTransform(projfrom, projto, nrow(xy), xy[, 1], xy[, :
54 projected point(s) not finite
Warning in rgdal::rawTransform(projfrom, projto, nrow(xy), xy[, 1], xy[, :
54 projected point(s) not finite
Warning in rgdal::rawTransform(projfrom, projto, nrow(xy), xy[, 1], xy[, :
54 projected point(s) not finite
问题是你的情节的
height
不能是相对的。
只需替换为绝对值即可显示,例如:
leafletOutput("map", width = "100%", height = 400)