我正在尝试按照THIS页面上描述的代码和步骤进行操作。
分为两部分:
第1部分
library(foreach)
library(doParallel)
library(data.table)
library(raster)
# Time the code
start <- proc.time()
if (!file.exists("./DataSets")) {
dir.create("./DataSets")
}
# Data Source:
# http://sedac.ciesin.columbia.edu/data/set/gpw-v3-population-count/data-download
# Format: .ascii, 1/2 degree, 2000
population.file <- "./Canada/VoteDensityRaster64Bit.tif"
# Load the raster file
population.raster <- raster(population.file)
# Convert the raster file to a points file
population.points <- rasterToPoints(population.raster)
all.data <- as.data.table(population.points)
setnames(all.data, c("x", "y", "population"))
# If you have your data in a CSV file, use this instead
# file <- "./DataSets/NBBuildingsWGS84.csv"
# all.data <- data.table(fread(file))
# The following are used to manipulate various data sets
# colnames(all.data) <- c("Name", "Mass", "Latitude", "Longitude") # Meteorites
# all.data$X <- as.numeric(all.data$X)
# all.data$Y <- as.numeric(all.data$Y)
# all.data$Mass <- as.numeric(all.data$Mass)
startEnd <- function(lats, lngs) {
# Find the "upper left" (NW) and "bottom right" (SE) coordinates
# of a set of data.
#
# Args:
# lats: A list of latitude coordinates
# lngs: A list of longitude coordinates
#
# Returns:
# A list of values corresponding to the northwest-most and
# southeast-most coordinates
# Convert to real number and remove NA values
lats <- na.omit(as.numeric(lats))
lngs <- na.omit(as.numeric(lngs))
topLat <- max(lats)
topLng <- min(lngs)
botLat <- min(lats)
botLng <- max(lngs)
return(c(topLat, topLng, botLat, botLng))
}
startEndVals <- startEnd(all.data$y, all.data$x)
remove(startEnd)
startLat <- startEndVals[1]
endLat <- startEndVals[3]
startLng <- startEndVals[2]
endLng <- startEndVals[4]
remove(startEndVals)
interval.v.num = 200.0
interval.h.num = 800.0
interval.v <- (startLat - endLat) / interval.v.num
interval.h <- (endLng - startLng) / interval.h.num
remove(num_intervals)
lat.list <- seq(startLat, endLat + interval.v, -1*interval.v)
# testLng <- -66.66152983 # Fredericton
# testLat <- 45.96538183 # Fredericton
# Prepare the data to be sent in
# If you have a value you want to sum, use this
data <- all.data[,list(x, y, population)]
# If you want to perform a count, use this
# data <- all.data[,list(x, y)]
# data[,Value:=1]
sumInsideSquare <- function(pointLat, pointLng, data) {
# Sum all the values that fall within a square on a map given a point,
# an interval of the map, and data that contains lat, lng and the values
# of interest
setnames(data, c("lng", "lat", "value"))
# Get data inside lat/lon boundaries
lng.interval <- c(pointLng, pointLng + interval.h)
lat.interval <- c(pointLat - interval.v, pointLat)
data <- data[lng %between% lng.interval][lat %between% lat.interval]
return(sum(data$value))
}
# Debugging
# squareSumTemp <- sumInsideSquare(testLat, testLng, interval, data)
# Given a start longitude and an end longitude, calculate an array of values
# corresponding to the sums for that latitude
calcSumLat <- function(startLng, endLng, lat, data) {
row <- c()
lng <- startLng
while (lng < endLng) {
row <- c(row, sumInsideSquare(lat, lng, data))
lng <- lng + interval.h
}
return(row)
}
# Debugging
# rowTemp <- calcSumLat(startLng, endLng, testLat, interval, data)
# write.csv(rowTemp, file = "Temp.csv", row.names = FALSE)
# Set up parallel computing with the number of cores you have
cl <- makeCluster(detectCores(), outfile = "./Progress.txt")
registerDoParallel(cl)
all.sums <- foreach(lat=lat.list, .packages=c("data.table")) %dopar% {
lat.data <- calcSumLat(startLng, endLng, lat, data)
# Progress indicator that works on Mac/Windows
print((startLat - lat)/(startLat - endLat)*100) # Prints to Progress.txt
lat.data
}
stopCluster(cl = cl)
# Convert to data frame
all.sums.table <- as.data.table(all.sums)
# Save to disk so I don't have to run it again
if (!file.exists("./GeneratedData")) {
dir.create("./GeneratedData")
}
output.file <- "./GeneratedData/VoteDensityHighRes.csv"
write.csv(all.sums.table, file = output.file, row.names = FALSE)
# End timer
totalTime <- proc.time() - start
print(totalTime)
# remove(cl, endLat, endLng, startLat, startLng, lat.list, start, calcSumLat, sumInsideSquare, interval)
第2部分
library(graphics)
library(tcltk)
library(pracma)
# Load the data generated by 01GenerateData.R
plot.data <- read.csv("GeneratedData/VoteDensityHighRes.csv", header=TRUE, stringsAsFactors=FALSE)
# Add padding above/below where there was data
# On top
top.padding <- 1:23
for (i in top.padding) {
plot.data <- cbind(0, plot.data)
}
# On bottom
bottom.padding <- 1:23
for (i in bottom.padding) {
plot.data <- cbind(plot.data, 0)
}
# On left
zero.row <- vector(mode="integer", length=dim(plot.data)[1])
left.padding <- 1:10
for (i in left.padding) {
plot.data <- rbind(zero.row, plot.data)
}
# On right
right.padding <- 1:10
for (i in left.padding) {
plot.data <- rbind(plot.data, zero.row)
}
max <- max(plot.data) # Max value in the data, used for scaling
plottingHeight <- 1000 # Arbitrary number that provides the graph's height
scaleFactor <- 300 # Discovered through trial and error to keep the graph in the boundaries
gap <- plottingHeight / length(plot.data) # Space between lines
# Output the file to a 36 inch by 24 inch SVG canvas
plot.width = 36
plot.height = 24
svg(filename = "./TestPlots/CanadaSG03.svg", pointsize=12, width=plot.width, height=plot.height)
# Create a blank plot
yVals <- as.vector(plot.data[[1]] / max * scaleFactor)
plot(0, 0, xlim=c(0, length(yVals)), ylim=c(0,1100), type="n", las=1, xlab=NA, ylab=NA, bty="n", axes=FALSE)
plotting.threshold <- 0.1
plot.length = length(plot.data)
# Progress bar
pb = tkProgressBar(title = "Plot Progress", label = "", min = 1, max = plot.length, initial = 1, width = 300)
# Plot each line
for (i in 1:plot.length) {
# Grabs a row of data
yVals <- as.vector(plot.data[[i]] / max * scaleFactor)
xVals <- c(0:(length(yVals) - 1))
yVals.smooth = savgol(yVals, 3, forder=4)
polygon(xVals, yVals.smooth + plottingHeight, border = NA, col = "#ffffff")
lines(xVals, yVals.smooth + plottingHeight, col="#cccccc", lwd=1.5)
# Plot the peaks with a darker line.
j <- 2 # Skip padding
while (j <= (length(yVals.smooth) - 2)) {
if ((yVals.smooth[j]) > plotting.threshold | (yVals.smooth[j+1]) > plotting.threshold) {
segments(xVals[j], yVals.smooth[j] + plottingHeight, xVals[j+1], yVals.smooth[j+1] + plottingHeight, col="#000000", lwd=1.5)
} else { } # Do nothing
j <- j + 1
}
plottingHeight <- plottingHeight - gap
# Update the progress bar
info <- sprintf("%d%% Complete", round(i / plot.length * 100))
setTkProgressBar(pb, i, title="Progress", info)
}
dev.off()
Sys.sleep(1)
close(pb) # Close the progress bar after a couple seconds
在第二部分的代码部分运行之前,一切都运行良好:
yVals <- as.vector(plot.data[[1]] / max * scaleFactor)
plot(0, 0, xlim=c(0, length(yVals)), ylim=c(0,1100), type="n", las=1,xlab=NA, ylab=NA, bty="n", axes=FALSE)
我收到以下错误消息:
Error in plot.new() : cairo error 'error while writing to output stream'
我在Windows 10上使用R 3.3.1和Rstudio,我也尝试使用R 2.15.3运行代码。
如何解决此错误?