3.10.1

nplatonov · Oct 7, 2023 · 1961c02 · 1961c02
1 parent 0f134de
commit 1961c02
Show file tree

Hide file tree

Showing 6 changed files with 38 additions and 22 deletions.
diff --git a/R/conn.read_gdal.R b/R/conn.read_gdal.R
@@ -35,19 +35,20 @@
                        ,verbose=FALSE,...) { ## ,...
   # if (resetGrid)
   #    session_grid(NULL)
-   if (!file.exists(fname)) {
-      list1 <- dir(path=dirname(fname),pattern=paste0("^",basename(fname)),full.names=TRUE)
-      list1 <- list1[.grep("\\.(tif|tiff|img|hfa)$",basename(list1))]
-      if (length(list1)==1)
-         fname <- list1
-   }
    engList <- as.character(as.list(match.fun("read_gdal"))[["engine"]])[-1]
    if (length(engine)<length(engList)) {
       if (!.isPackageInUse()) {
          engList <- c(engList,"rgdal")
       }
    }
    engine <- match.arg(engine,engList)
+   fname <- gsub("\\.$","",fname)
+   if (!file.exists(fname)) {
+      list1 <- dir(path=dirname(fname),pattern=paste0("^",basename(fname)),full.names=TRUE)
+      list1 <- list1[.grep("\\.(tif|tiff|img|hfa)$",basename(list1))]
+      if (length(list1)==1)
+         fname <- list1
+   }
    if ((engine=="vapour")&&(requireNamespace("vapour",quite=!.isPackageInUse()))) {
       return(.read_vapour(fname,resetGrid=resetGrid,band=band
                          ,engine=engine,verbose=verbose))

diff --git a/R/package_sf.R b/R/package_sf.R
@@ -5,12 +5,14 @@
    columns <- obj$cols[2]
    rows <- obj$rows[2]
    bands <- length(obj$bands)
-  # patt <- "^Band_(\\d+)=(.+)$"
-   patt <- "^Band_(\\d+)=\\t*(.+)$"
-   bname <- grep(patt,obj$meta,value=TRUE)
-   b1 <- .grep(patt,obj$meta,value=TRUE)
-   bname <- .gsub(patt,"\\2",b1)
-   bname[as.integer(.gsub(patt,"\\1",b1))] <- bname
+   if (length(ind <- grep("(^crs$|^wkt|wkt$)",names(obj))))
+      crs <- obj[[ind]]
+   if (is.character(crs))
+      crs <- sf::st_crs(crs)$proj4string
+   if (inherits(crs,"crs"))
+      crs <- crs$proj4string
+   if (is.na(crs))
+      crs <- ""
    if (all(is.na(obj$geotransform))) {
       resx <- 1
       resy <- 1
@@ -28,7 +30,7 @@
       miny <- maxy-rows*resy
    }
    g1 <- regrid(minx=minx,maxx=maxx,miny=miny,maxy=maxy,columns=columns,rows=rows
-               ,crs=sf::st_crs(obj$crs)$proj4string
+               ,crs=crs # sf::st_crs(obj$crs)$proj4string
                )
    res <- .raster.skeleton()
    res$grid <- g1
@@ -100,7 +102,10 @@
       j <- grep(patt,obj$meta)
       ind <- as.integer(gsub(patt,"\\1",obj$meta[j]))
       bname <- gsub(patt,"\\2",obj$meta[j])
-      names(res)[ind] <- bname
+      bname[ind] <- bname
+      if (!length(bname))
+         bname <- paste("Band",seq(bands))
+      names(res) <- bname
    }
    res$dim <- as.integer(c(columns*rows,bands))
    gi <- sf::gdal_utils("info",fname,quiet=!FALSE)

diff --git a/R/ursa_as.R b/R/ursa_as.R
@@ -152,13 +152,23 @@
       }
       return(res)
    }
-   if ((is.list(obj))&&(!anyNA(match(c("filename","cols","rows","bands","crs"
+   if ((is.list(obj))&&(!anyNA(match(c("filename","cols","rows","bands","driver"
                                       ,"geotransform","datatype","meta")
                                     ,names(obj))))) { ## from 'sf::gdal_read'
      # .elapsedTime("A")
       columns <- obj$cols[2]
       rows <- obj$rows[2]
       bands <- obj$bands[2]
+      if (length(ind <- grep("(^crs$|^wkt|wkt$)",names(obj))))
+         crs <- obj[[ind]]
+     # if (!is.na(crs))
+     #    crs <- crs$proj4string
+      if (is.character(crs))
+         crs <- sf::st_crs(crs)$proj4string
+      else if (inherits(crs,"crs"))
+         crs <- crs$proj4string
+      if (is.na(crs))
+         crs <- ""
      # patt <- "^Band_(\\d+)=\\t*(.+)$"
      # bname <- grep(patt,obj$meta,value=TRUE)
      # b1 <- .grep(patt,obj$meta,value=TRUE)
@@ -182,7 +192,7 @@
      # .elapsedTime("I")
       if (F) 
          g1 <- regrid(setbound=c(minx,miny,maxx,maxy),dim=c(rows,columns)
-                     ,crs=obj$crs$proj4string)
+                     ,crs=crs)
       else {
          g1 <- .grid.skeleton()
          g1$columns <- as.integer(columns)
@@ -193,7 +203,7 @@
          g1$maxy <- maxy
          g1$resx <- with(g1,(maxx-minx)/columns)
          g1$resy <- with(g1,(maxy-miny)/rows)
-         g1$crs <- obj$crs$proj4string
+         g1$crs <- crs
       }
       if (is.na(g1$crs))
          g1$crs <- ""

diff --git a/R/xxx.gdal_rasterize.R b/R/xxx.gdal_rasterize.R
@@ -129,7 +129,7 @@
    proj4 <- .gsub("(^\\s|\\s$)","",proj4)
    proj4 <- proj4[nchar(proj4)>0]
    if (noProj <- !length(proj4))
-      proj4 <- "+init=epsg:4326"
+      proj4 <- "+proj=longlat +datum=WGS84 +no_defs"
    ftemp <- .maketmp() # .maketmp() #tempfile(pattern="") # ".\\tmp1"
    cmd <- paste("ogrinfo","-q",.dQuote(dsn))
    if (verbose)

diff --git a/R/xxx.spatialize.R b/R/xxx.spatialize.R
@@ -204,7 +204,7 @@
             crsNow <- NA
          if (is.na(crsNow)) {
             if ((.lgrep("^(lon|lng$)",coords[1])==1)&&(.lgrep("^lat",coords[2])==1))
-               crsNow <- "EPSG:4326"
+               crsNow <- "+proj=longlat +datum=WGS84 +no_defs"
             else if (is.data.frame(dsn)) {
                if (is.character(attr(dsn,"crs")))
                   crsNow <- attr(dsn,"crs")

diff --git a/R/yyy.project.R b/R/yyy.project.R
@@ -101,11 +101,11 @@
       if (verbose)
          message("'sf' is used")
       if (inv) {
-         crs_t <- "EPSG:4326"
+         crs_t <- "+proj=longlat +datum=WGS84 +no_defs"
          crs_s <- proj
       }
       else {
-         crs_s <- "EPSG:4326"
+         crs_s <- "+proj=longlat +datum=WGS84 +no_defs"
          crs_t <- proj
       }
       if (is.list(xy))
@@ -145,7 +145,7 @@
                                      sf::st_multipoint(xy),crs=crs_s),crs_t)[[1]]))
          else {
             if (T & !sf::sf_proj_network())
-               sf::sf_proj_network(url="",TRUE)
+               try(sf::sf_proj_network(url="",TRUE))
             if (F & verbose) {
                print(xy)
                print(crs_s)