|
|
Line 35: |
Line 35: |
| library(OpasnetUtils) | | library(OpasnetUtils) |
| library(OpasnetUtilsExt) | | library(OpasnetUtilsExt) |
| + | |
| + | objects.latest("Op_en6007", code_name = "answer") # [[OpasnetUtils/Drafts]]; we need MyPointsKML and ova2spat. |
| | | |
| shp<-readOGR('PG:host=localhost user=postgres dbname=spatial_db','kuopio_house') | | shp<-readOGR('PG:host=localhost user=postgres dbname=spatial_db','kuopio_house') |
| + | |
| + | shp <- shp[1:100 , ] # Save only 100 buildings for demonstration |
| + | |
| plotvar<-shp@data$ika | | plotvar<-shp@data$ika |
| nclr<-8 | | nclr<-8 |
Line 46: |
Line 51: |
| proj4string(shp)<-("+init=epsg:3067") | | proj4string(shp)<-("+init=epsg:3067") |
| shp2<-spTransform(shp,epsg4326String) | | shp2<-spTransform(shp,epsg4326String) |
− |
| |
| | | |
| kmlname<-"Kuopio house data" | | kmlname<-"Kuopio house data" |
Line 53: |
Line 57: |
| name<-paste("ika value: ", shp2$ika) | | name<-paste("ika value: ", shp2$ika) |
| description <- paste("<b>Value:</b>",shp2$ika,"<br><b>Description:</b>",shp2$kayttotark) | | description <- paste("<b>Value:</b>",shp2$ika,"<br><b>Description:</b>",shp2$kayttotark) |
− |
| |
− |
| |
− | MyPointKML<-function(obj = NULL, kmlname = "", kmldescription = "", name = NULL, description = "", icon = "http://maps.google.com/mapfiles/kml/pal4/icon24.png",col=NULL)
| |
− | {
| |
− | if (is.null(obj))
| |
− | return(list(header = c("<?xml version=\"1.0\" encoding=\"UTF-8\"?>",
| |
− | "<kml xmlns=\"http://earth.google.com/kml/2.2\">",
| |
− | "<Document>", paste("<name>", kmlname, "</name>",
| |
− | sep = ""), paste("<description><![CDATA[", kmldescription,
| |
− | "]]></description>", sep = "")), footer = c("</Document>",
| |
− | "</kml>")))
| |
− | if (class(obj) != "SpatialPointsDataFrame")
| |
− | stop("obj must be of class 'SpatialPointsDataFrame' [package 'sp']")
| |
− | if (is.null(name)) {
| |
− | name = c()
| |
− | for (i in 1:nrow(obj)) name <- append(name, paste("site",
| |
− | i))
| |
− | }
| |
− | if (length(name) < nrow(obj)) {
| |
− | if (length(name) > 1)
| |
− | warning("kmlPoints: length(name) does not match nrow(obj). The first name will be replicated.")
| |
− | name <- rep(name, nrow(obj))
| |
− | }
| |
− | if (length(description) < nrow(obj)) {
| |
− | if (length(description) > 1)
| |
− | warning("kmlPoints: length(description) does not match nrow(obj). The first description will be replicated.")
| |
− | description <- rep(description, nrow(obj))
| |
− | }
| |
− | if (length(icon) < nrow(obj)) {
| |
− | if (length(icon) > 1)
| |
− | warning("kmlPoints: length(icon) does not match nrow(obj). Only the first one will be used.")
| |
− | icon <- icon[1]
| |
− | }
| |
− | col2kmlcolor <- function(col) paste(rev(sapply(col2rgb(col, TRUE), function(x) sprintf("%02x", x))), collapse = "")
| |
− | kml <- kmlStyle <- ""
| |
− | kmlHeader <- c("<?xml version=\"1.0\" encoding=\"UTF-8\"?>","<kml xmlns=\"http://earth.google.com/kml/2.2\">", "<Document>")
| |
− | kmlFooter <- c("</Document>", "</kml>")
| |
− | #for (i in 1:nrow(obj)) {
| |
− | for (i in 1:100) {
| |
− | point <- obj[i, ]
| |
− | pt_name = name[i]
| |
− | pt_description = description[i]
| |
− | pt_style <- paste("#style", ifelse(length(icon) == 1, 1, i), sep = "")
| |
− | kml <- append(kml, "<Placemark>")
| |
− | kml <- append(kml, paste(" <description><![CDATA[",pt_description, "]]></description>", sep = ""))
| |
− | #kml <- append(kml, "<Style><IconStyle>")
| |
− | #kml <- append(kml, paste("<color>", col2kmlcolor(col[i]), "</color>", sep =""))
| |
− | #kml <- append(kml, paste(" <Icon><href>", icon, "</href></Icon>", sep = ""))
| |
− | #kml <- append(kml, "<scale>0.300000</scale>")
| |
− | #kml <- append(kml, "</IconStyle></Style>")
| |
− | kml <- append(kml, " <Point>")
| |
− | kml <- append(kml, " <coordinates>")
| |
− | kml <- append(kml, paste(point@coords[1], point@coords[2], sep = ","))
| |
− | kml <- append(kml, " </coordinates>")
| |
− | kml <- append(kml, " </Point>")
| |
− | kml <- append(kml, "</Placemark>")
| |
− | }
| |
− |
| |
− | return(paste(paste(c(kmlHeader, kmlStyle, kml, kmlFooter), sep = "", collapse = "\n"), collapse="\n", sep = ""))
| |
− |
| |
− | }
| |
− |
| |
− |
| |
| | | |
| data <- MyPointKML(shp2,kmlname,kmldescription,name,description,icon,colcode) | | data <- MyPointKML(shp2,kmlname,kmldescription,name,description,icon,colcode) |
Line 209: |
Line 150: |
| library(classInt) | | library(classInt) |
| library(OpasnetUtilsExt) | | library(OpasnetUtilsExt) |
| + | |
| + | objects.latest("Op_en6007", code_name = "answer") # [[OpasnetUtils/Drafts]]; we need MyPointsKML and ova2spat. |
| | | |
| shp<-readOGR('PG:host=localhost user=postgres dbname=spatial_db','kuopio_house') | | shp<-readOGR('PG:host=localhost user=postgres dbname=spatial_db','kuopio_house') |
Line 227: |
Line 170: |
| name<-paste("ika value: ", shp2$ika) | | name<-paste("ika value: ", shp2$ika) |
| description <- paste("<b>Value:</b>",shp2$ika,"<br><b>Description:</b>",shp2$kayttotark) | | description <- paste("<b>Value:</b>",shp2$ika,"<br><b>Description:</b>",shp2$kayttotark) |
− |
| |
− |
| |
− | MyPointKML<-function(obj = NULL, kmlname = "", kmldescription = "", name = NULL, description = "", icon = "http://maps.google.com/mapfiles/kml/pal4/icon24.png",col=NULL)
| |
− | {
| |
− | if (is.null(obj))
| |
− | return(list(header = c("<?xml version=\"1.0\" encoding=\"UTF-8\"?>",
| |
− | "<kml xmlns=\"http://earth.google.com/kml/2.2\">",
| |
− | "<Document>", paste("<name>", kmlname, "</name>",
| |
− | sep = ""), paste("<description><![CDATA[", kmldescription,
| |
− | "]]></description>", sep = "")), footer = c("</Document>",
| |
− | "</kml>")))
| |
− | if (class(obj) != "SpatialPointsDataFrame")
| |
− | stop("obj must be of class 'SpatialPointsDataFrame' [package 'sp']")
| |
− | if (is.null(name)) {
| |
− | name = c()
| |
− | for (i in 1:nrow(obj)) name <- append(name, paste("site",
| |
− | i))
| |
− | }
| |
− | if (length(name) < nrow(obj)) {
| |
− | if (length(name) > 1)
| |
− | warning("kmlPoints: length(name) does not match nrow(obj). The first name will be replicated.")
| |
− | name <- rep(name, nrow(obj))
| |
− | }
| |
− | if (length(description) < nrow(obj)) {
| |
− | if (length(description) > 1)
| |
− | warning("kmlPoints: length(description) does not match nrow(obj). The first description will be replicated.")
| |
− | description <- rep(description, nrow(obj))
| |
− | }
| |
− | if (length(icon) < nrow(obj)) {
| |
− | if (length(icon) > 1)
| |
− | warning("kmlPoints: length(icon) does not match nrow(obj). Only the first one will be used.")
| |
− | icon <- icon[1]
| |
− | }
| |
− | col2kmlcolor <- function(col) paste(rev(sapply(col2rgb(col, TRUE), function(x) sprintf("%02x", x))), collapse = "")
| |
− | kml <- kmlStyle <- ""
| |
− | kmlHeader <- c("<?xml version=\"1.0\" encoding=\"UTF-8\"?>","<kml xmlns=\"http://earth.google.com/kml/2.2\">", "<Document>")
| |
− | kmlFooter <- c("</Document>", "</kml>")
| |
− | #for (i in 1:nrow(obj)) {
| |
− | for (i in 1:100) {
| |
− | point <- obj[i, ]
| |
− | pt_name = name[i]
| |
− | pt_description = description[i]
| |
− | pt_style <- paste("#style", ifelse(length(icon) == 1, 1, i), sep = "")
| |
− | kml <- append(kml, "<Placemark>")
| |
− | kml <- append(kml, paste(" <description><![CDATA[",pt_description, "]]></description>", sep = ""))
| |
− | #kml <- append(kml, "<Style><IconStyle>")
| |
− | #kml <- append(kml, paste("<color>", col2kmlcolor(col[i]), "</color>", sep =""))
| |
− | #kml <- append(kml, paste(" <Icon><href>", icon, "</href></Icon>", sep = ""))
| |
− | #kml <- append(kml, "<scale>0.300000</scale>")
| |
− | #kml <- append(kml, "</IconStyle></Style>")
| |
− | kml <- append(kml, " <Point>")
| |
− | kml <- append(kml, " <coordinates>")
| |
− | kml <- append(kml, paste(point@coords[1], point@coords[2], sep = ","))
| |
− | kml <- append(kml, " </coordinates>")
| |
− | kml <- append(kml, " </Point>")
| |
− | kml <- append(kml, "</Placemark>")
| |
− | }
| |
− |
| |
− | return(paste(paste(c(kmlHeader, kmlStyle, kml, kmlFooter), sep = "", collapse = "\n"), collapse="\n", sep = ""))
| |
− |
| |
− | }
| |
− |
| |
− |
| |
| | | |
| data <- MyPointKML(shp2,kmlname,kmldescription,name,description,icon,colcode) | | data <- MyPointKML(shp2,kmlname,kmldescription,name,description,icon,colcode) |
All pieces of the puzzle exist already.