绘制数据时开罗错误

时间:2016-10-15 16:25:35

标签: r data-visualization

我正在尝试按照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运行代码。

如何解决此错误?

0 个答案:

没有答案