library("rgdal", lib.loc="~/R/win-library/3.4")
cite(rgdal)
cite("rgdal")
citation("rgdal")
citation("dismo")
install.packages("dismo")
citation("dismo")
install.packages("rJava")
citations("rJava")
citation("rJava")
citation("raster ")
citation("raster")
citation("ENMeval")
install.packages("ENMeval")
citation("ENMeval")
citation("usdm")
install.packages("usdm")
citation("usdm")
citation("psych")
load("K:/i/Documents/Cloud/Qsync/創生プログラム/データ_北大_中川孝介/20170808_投稿用原稿/.RData")
load("~/Cloud/Qsync/創生プログラム/データ_北大_中川孝介/20170808_投稿用原稿/.RData")
windows(width=8,height=6)
p <- ggplot(df.test.3)
p <- p + geom_line(aes(x=x,y=y.nat),size=1,colour="#f39c12")
p <- p + geom_line(aes(x=x,y=y.pl),size=1,colour="#2ecc71")
p <- p + facet_wrap(~val.name,scale="free_x",ncol=3)
p <- p + ylim(c(0.0001,30))
p <- p + scale_y_log10()
p <- p + xlab("")
p <- p + ylab("")
plot(p)
library(ggplot2)
pp.df.density <- data.frame(x=partial.density.max$x,
y.nat=1/(1+exp(-partial.density.max$z[,1]))*100,
y.pl=1/(1+exp(-partial.density.max$z[,2]))*100,
val.name="Density of trees (n/ha)")
#2広葉樹密度
pp.df.bldens <- data.frame(x=partial.bldens.max$x,
y.nat=1/(1+exp(-partial.bldens.max$z[,1]))*100,
y.pl=1/(1+exp(-partial.bldens.max$z[,2]))*100,
val.name="Density of bload-leaved trees (n/ha)")
#3樹高
pp.df.height <- data.frame(x=partial.height.max$x,
y.nat=1/(1+exp(-partial.height.max$z[,1]))*100,
y.pl=1/(1+exp(-partial.height.max$z[,2]))*100,
val.name="Stand height (m)")
#4傾斜
pp.df.slope <- data.frame(x=partial.slope.max$x,
y.nat=1/(1+exp(-partial.slope.max$z[,1]))*100,
y.pl=1/(1+exp(-partial.slope.max$z[,2]))*100,
val.name="Slope angle (°)")
#5TOPEX
pp.df.topex <- data.frame(x=partial.topex.max$x,
y.nat=1/(1+exp(-partial.topex.max$z[,1]))*100,
y.pl=1/(1+exp(-partial.topex.max$z[,2]))*100,
val.name="TOPEX")
#6最大風速
pp.df.windspeed <- data.frame(x=partial.w_max.max$x,
y.nat=1/(1+exp(-partial.w_max.max$z[,1]))*100,
y.pl=1/(1+exp(-partial.w_max.max$z[,2]))*100,
val.name="Maximum wind speed (m/s)")
#すべて結合----
df.test.3 <- rbind(pp.df.windspeed,
pp.df.topex,
pp.df.slope,
pp.df.density,
pp.df.bldens,
pp.df.height
)
windows(width=8,height=6)
p <- ggplot(df.test.3)
p <- p + geom_line(aes(x=x,y=y.nat),size=1,colour="#f39c12")
p <- p + geom_line(aes(x=x,y=y.pl),size=1,colour="#2ecc71")
p <- p + facet_wrap(~val.name,scale="free_x",ncol=3)
p <- p + ylim(c(0.0001,30))
p <- p + scale_y_log10()
p <- p + xlab("")
p <- p + ylab("")
plot(p)
windows(width=8,height=6)
p <- ggplot(df.test.3)
p <- p + geom_line(aes(x=x,y=y.nat),size=1,colour="#212121",lty=6)
p <- p + geom_line(aes(x=x,y=y.pl),size=1,colour="#212121")
p <- p + facet_wrap(~val.name,scale="free_x",ncol=3)
p <- p + ylim(c(0.0001,30))
p <- p + scale_y_log10()
p <- p + xlab("")
p <- p + ylab("")
plot(p)
install.packages(c("car", "coin", "geosphere", "multcomp", "raster", "Rcpp", "RcppEigen", "rgdal", "rgeos", "rlang", "rockchalk", "Rttf2pt1", "stringi", "yaml"))
install.packages(c("BH", "digest", "estimability", "foreach", "htmlwidgets", "iterators", "knitr", "lme4", "MuMIn", "mvtnorm", "party", "quantreg", "Rcpp", "RcppEigen", "reshape2", "rgl", "rlang", "sp", "tibble", "viridisLite", "yaml", "zoo"))
library(rgdal)
library(sp)
data(eberg_contours)
data(SAGA_pal)
names(eberg_contours)
# KML plot with elevations used as 'colour' argument:
kml(eberg_contours, colour_scale = SAGA_pal[[1]], colour = Z, kmz = TRUE)
library(plotKML)
data(eberg_contours)
data(SAGA_pal)
names(eberg_contours)
# KML plot with elevations used as 'colour' argument:
kml(eberg_contours, colour_scale = SAGA_pal[[1]], colour = Z, kmz = TRUE)
str(eberg_contours)
data(eberg)
eberg
unique(eberg$ID)
length((unique(eberg$ID))
length(unique(eberg$ID))
# Plotting a SpatialPointsDataFrame object
library(rgdal)
data(eberg)
eberg <- eberg[runif(nrow(eberg))<.1,]
runif(nrow(eberg))<.1
eberg[runif(nrow(eberg))<.1,]
coordinates(eberg) <- ~X+Y
proj4string(eberg) <- CRS("+init=epsg:31467")
## Not run: # Simple plot
kml(eberg, file = "eberg-0.kml")
str(eberg_contours)
check_projection(eberg)
# not yet ready for export to KML;
parse_proj4(proj4string(eberg))
eberg.geo <- reproject(eberg)
check_projection(eberg.geo)
eberg
names(eberg_contours)
# KML plot with elevations used as 'colour' argument:
kml(eberg_contours, colour_scale = SAGA_pal[[1]], colour = Z, kmz = TRUE)
require(dplyr)
require(ggplot2)
df <- data_frame(x1 = rnorm(5), y1 = rnorm(5)) %>%
group_by(x1, y1) %>%
do(data_frame(component = LETTERS[1:3], value = runif(3))) %>%
mutate(total = sum(value)) %>%
group_by(x1, y1, total)
df
Source: local data frame [15 x 5] Groups: x1, y1, total [5]
df.grobs <- df %>%
do(subplots = ggplot(., aes(1, value, fill = component)) +
geom_col(position = "fill", alpha = 0.75, colour = "white") +
coord_polar(theta = "y") +
theme_void()+ guides(fill = F)) %>%
mutate(subgrobs = list(annotation_custom(ggplotGrob(subplots),
x = x1-total/4, y = y1-total/4,
xmax = x1+total/4, ymax = y1+total/4)))
df.grobs
df.grobs %>%
{ggplot(data = ., aes(x1, y1)) +
scale_x_continuous(expand = c(0.25, 0)) +
scale_y_continuous(expand = c(0.25, 0)) +
.$subgrobs +
geom_text(aes(label = round(total, 2))) +
geom_col(data = df,
aes(0,0, fill = component),
colour = "white")}
cite(geosphere)
cite("geosphere")
citation
citation(geosphere)
install.packages("geosphere")
citation(geosphere)
library(geosphere)
citation(geosphere)
citation("geosphere")
citation(R)
citation
citation()
citation(plotKML3)
citation(plotKML)
install.packages("plotKML")
citation(plotKML)
library(plotKML)
install.packages("FNN")
library(plotKML)
citation(plotKML)
citation("plotKML")
892*squt(2)
squt(2)
892*sqrt(2)
install.packages(c("assertthat", "backports", "Cairo", "callr", "checkmate", "classInt", "cli", "clipr", "coda", "coin", "colorspace", "curl", "data.table", "deldir", "digest", "doParallel", "dplyr", "e1071", "emmeans", "evaluate", "expm", "forcats", "foreach", "formatR", "ggforce", "ggplot2", "glmnet", "glue", "gstat", "gtable", "haven", "highr", "hms", "httpuv", "iterators", "knitr", "kutils", "lavaan", "lazyeval", "lme4", "magick", "maptools", "markdown", "mime", "multcomp", "numDeriv", "openxlsx", "party", "permute", "pillar", "polyclip", "pROC", "processx", "progress", "purrr", "quantreg", "R6", "raster", "Rcpp", "readxl", "rgdal", "rgeos", "rgl", "rJava", "rlang", "rockchalk", "RODBC", "rstudioapi", "sandwich", "shiny", "spatstat", "spData", "spdep", "stringi", "tibble", "tidyr", "units", "vegan", "xfun", "XML", "xtable", "zip", "zoo"))
p_ <- GGally::print_if_interactive
## Quick example, with and without colour
data(flea)
ggpairs(flea, columns = 2:4)
library(GGally)
p_ <- GGally::print_if_interactive
## Quick example, with and without colour
data(flea)
ggpairs(flea, columns = 2:4)
pm <- ggpairs(flea, columns = 2:4, ggplot2::aes(colour=species))
p_(pm)
data(tips, package = "reshape")
names(flea)
head(flea)
# lnTの相関をチェック
library(GGally)
citation(ggplot2)
library(ggplot2)
citation(ggplot2)
load("~/Cloud/Qsync/SI-CAT/長野県解析/全国3次メッシュraster/全国3次メッシュraster.RData")
# 市町村毎に集計する
library(sp)
library(rgeos)
library(plotKML)
install.packages(c("arm", "backports", "BiodiversityR", "Cairo", "callr", "car", "carData", "checkmate", "classInt", "cli", "crosstalk", "data.table", "deldir", "digest", "dplyr", "ecodist", "effects", "ellipsis", "expm", "forcats", "GGally", "ggforce", "ggimage", "ggplot2", "ggplotify", "ggpubr", "ggrepel", "glue", "gpclib", "gridGraphics", "gtools", "haven", "Hmisc", "htmlTable", "htmltools", "httpuv", "httr", "jsonlite", "knitr", "later", "lifecycle", "lme4", "magick", "manipulateWidget", "maptools", "mime", "multcomp", "mvtnorm", "nloptr", "openssl", "openxlsx", "pbkrtest", "pillar", "plyr", "processx", "promises", "ps", "purrr", "quantreg", "raster", "RcmdrMisc", "Rcpp", "reshape2", "rgdal", "rgl", "RgoogleMaps", "RGraphics", "rlang", "rmarkdown", "rstudioapi", "rvcheck", "scales", "sem", "sf", "shiny", "sp", "spatstat", "spatstat.utils", "spData", "spdep", "stringi", "survey", "sys", "tibble", "tidyr", "tidyselect", "tinytex", "units", "vctrs", "withr", "xfun", "yaml", "zip", "zoo"))
# 市町村毎に集計する
library(sp)
library(rgeos)
library(plotKML)
library(stringr)
tim <- proc.time()
load("K:/i/Documents/Cloud/Qsync/SI-CAT/長野県解析/長野県VoCC/VoCC.results/GoogleEarthでの矢印描画/20200829_3mesh_自治体_コード.Rdata")
summary(d)
subset(d, d$mesh.code==52350329)
# setwd("K:/i/Documents/Cloud/Qsync/SI-CAT/長野県解析/長野県VoCC/ArcGIS")
# VoCCデータの読込
PathToDat <- "K://i/Documents/Cloud/Qsync/SI-CAT/長野県解析/長野県VoCC/VoCC.results/20170303/zenkoku/"
PathToOut <- "K://i/Documents/Cloud/Qsync/SI-CAT/長野県解析/長野県VoCC/VoCC.results/20200830_日本語/"
threshold <- c("t_0.5")
rcp <- c("rcp26","rcp45","rcp85")[1]
# color <- ifelse(r=="rcp26",col2kml("green"),
#                 ifelse(r=="rcp45",col2kml("yellow"),col2kml("red")))
# color <- c(col2kml("green"),col2kml("yellow"),col2kml("red"))
pref <- c("01北海道","02青森県","03岩手県","04宮城県","05秋田県","06山形県",
"07福島県","08茨城県","09栃木県","10群馬県","11埼玉県","12千葉県",
"13東京都","14神奈川県","15新潟県","16富山県","17石川県","18福井県",
"19山梨県","20長野県","21岐阜県","22静岡県","23愛知県","24三重県",
"25滋賀県","26京都府","27大阪府","28兵庫県","29奈良県","30和歌山県",
"31鳥取県","32島根県","33岡山県","34広島県","35山口県","36徳島県",
"37香川県","38愛媛県","39高知県","40福岡県","41佐賀県","42長崎県",
"43熊本県","44大分県","45宮崎県","46鹿児島県","47沖縄県")
gcm <- c("bcc","CSI","GFD","Had","MIR","MRI")
g <- gcm[5]
for (th in threshold){
# dir.create(file.path(PathToOut,th),showWarnings = FALSE)
for (r in rcp){
# dir.create(file.path(paste0(PathToOut,th),r),showWarnings = FALSE)
setwd(paste0(PathToDat,th,"/",r,"/edited"))
filelist <- list.files(pattern="MIR_edited.csv",recursive=TRUE)
# color <- ifelse(r=="rcp26",col2kml("green"),
#        ifelse(r=="rcp26",col2kml("yellow"),col2kml("red")))
for (n_p in pref){
p <- str_sub(n_p, start = 3)
pref_e <- c("01Hokkaido","02Aomoriken","03Iwateken","04Miyagiken",
"05Akitaken","06Yamagataken","07Fukushimaken","08Ibarakiken",
"09Tochigiken","10Gunmaken","11Saitamaken","12Chibaken",
"13Tokyoto","14Kanagawaken","15Niigataken","16Toyamaken",
"17Ishikawaken","18Fukuiken","19Yamanashiken","20Naganoken",
"21Gifuken","22Shizuokaken","23Aichiken","24Mieken",
"25Shigaken","26Kyotofu","27Osakafu","28Hyogoken",
"29Naraken","30Wakayamaken","31Tottoriken","32Shimaneken",
"33Okayamaken","34Hiroshimaken","35Yamaguchiken","36Tokushimaken",
"37Kagawaken","38Ehimeken","39Kochiken","40Fukuokaken",
"41Sagaken","42Nagasakiken","43Kumamotoken","44Oitaken",
"45Miyazakiken","46Kagoshimaken","47Okinawaken")
n_p_e <- pref_e[which(pref==n_p)]#県名表記:xx英語
# dir.create(file.path(PathToOut, n_p_e), showWarnings = FALSE)#フォルダ名：xx英語の県名
dir.create(file.path(PathToOut, n_p), showWarnings = FALSE)#フォルダ名：xx日本語の県名
setwd(paste0(PathToDat,th,"/",r,"/edited"))
read.fun <- function(x){
result <- read.csv(x,header=TRUE)[,-1]
# result <- read.csv("MIR_edited.csv",header=TRUE)[,-1]
result <- merge(result,d,by="mesh.code")
result <- subset(result, result$KEN==p)# これはmergeの後でないとする県境で削られてしまう可能性
return(result)
}
result.list <- lapply(filelist,read.fun)
result1 <- do.call(rbind,result.list)
result1 <- result1[complete.cases(result1),] # この影響は後で確認する必要がある。
for (lg in unique(result1$tag_jp)){
result <- subset(result1,tag_jp==lg)
result <- result[!duplicated(result$mesh.code),]#これがないと回らない。
# ここより前でやると境界のメッシュを削ってしまう可能性。
m <- ifelse(length(unique(result$key))==1,
as.character(result$key[1]),
paste0("error",m))
l <- list()
length(l) <- nrow(result)
for (n in 1:nrow(result)){
l[[n]] <- matrix(c(as.numeric(result[n,c("x","x.dest")]),
as.numeric(result[n,c("y","y.dest")])),2,2)
# a <- ifelse(result[n,"x"]==result[n,"x.dest"],
#             as.numeric(result[n,"x"])+0.0001,# 移動しない場合にも微少の線を生成する
#             as.numeric(result[n,"x"]))
# l[[n]] <- matrix(c(a,as.numeric(result[n,"x.dest"]),
#                    as.numeric(result[n,c("y","y.dest")])),2,2)
}
Sl <- lapply(l,Line)
# ID = list()
# length(ID) <- nrow(result)
# for (j in 1:nrow(result)){
#   ID[[j]] <- result$mesh.code[j]
# }
# S <-  lapply(Sl,Lines,ID)
S <- list()
length(S) <- nrow(result)
for (k in 1:nrow(result)){
S[[k]] <- Lines(Sl[[k]], ID = paste(result$mesh.code[k]))
}
Sl <- SpatialLines(S)
## sample data: line lengths
# library(rgeos)
df_l <- data.frame(len = sapply(1:length(Sl), function(i) gLength(Sl[i, ])))
rownames(df_l) <- sapply(1:length(Sl), function(i) Sl@lines[[i]]@ID)
## SpatialLines to SpatialLinesDataFrame
Sldf <- SpatialLinesDataFrame(Sl, data = df_l)
# proj4string(Sldf) <- CRS("+init=epsg:31467")
proj4string(Sldf) <- CRS("+proj=longlat +datum=WGS84")
# library(plotKML)
check_projection(Sldf)
# not yet ready for export to KML;
parse_proj4(proj4string(Sldf))
Sldf.geo <- reproject(Sldf)
check_projection(Sldf.geo)
# # x <- paste(result$KEN[1],result$municipality[1],th,r,g,sep="_")
# # x <- paste(result$tag_en[1])
# x <- paste(result$municipality[1],r,sep="_")
# eval(call("<-",as.name(x),Sldf.geo))
# # 長野県_茅野市_t_0.5_rcp45_MRI
# plotKML(Sldf.geo, colour = color, alpha=.5)
# dir.create(file.path(PathToOut,n_p_e,lg), showWarnings = FALSE) #英語ディレクトリ
dir.create(file.path(PathToOut,n_p,lg), showWarnings = FALSE)#日本語ディレクトリ
# setwd(file.path(PathToOut,n_p_e,lg))
setwd(file.path(PathToOut,n_p,lg))
# plotKML(Sldf.geo)
# color <- ifelse(r=="rcp26",col2kml("green"),
#                 ifelse(r=="rcp45",col2kml("yellow"),col2kml("red")))
kml(obj=Sldf.geo, #folder.name=file.path(PathToOut,p_e,m),
file.name=paste0(paste("From",m,th,r,g,sep="_"),".kml"), #kmz=TRUE,
# eval(parse(colour = color[r])), alpha=1, width = 1)
# colour = eval(paste(color[r]), alpha=1, width = 1)
# colour = eval(paste(text=color[r])), alpha=1, width = 1)
colour = "chartreuse1", alpha=1, width = 1)
}
}
}
}
proc.time()-tim
# ユーザ   システム       経過
# 1845.16     312.41    2419.11
# ---------------------------
# max(result$logSpeed,na.rm=TRUE) #4.041903
# # result$logSpeed.na_4 <- ifelse(is.na(result$logSpeed),4,result$logSpeed)
# result$logSpeed_na_45 <- ifelse(is.na(result$logSpeed),4.5,result$logSpeed) # NAはlog4.5として置換
# head(result)
