File:Permian triassic 252ma co2 450 vege map 1.png

From Wikimedia Commons, the free media repository
Jump to navigation Jump to search

Original file (2,400 × 1,200 pixels, file size: 2.04 MB, MIME type: image/png)

Captions

Captions

Permian-Triassic boundary 252ma co2 450 vegetation map

Summary

[edit]
Description
English: Permian-Triassic boundary 252ma co2 450 vegetation map
Date
Source Own work
Author Merikanto

his image is based on Exoplasim and estimations of CO2 amount in Permian-Triassic boundary, that is often 1600-9000 ppm. Alos need Koppenpasta output.

"R" scripts to create accurate map here 

https://commons.wikimedia.org/wiki/File:Permian_triassic_boundary_growing_degree_days_above_5_degrees_celsius_1.png

This image is based data from exoplasim simulation and Scotese paleodem maps.

https://www.earthbyte.org/paleodem-resource-scotese-and-wright-2018/

PaleoDEM Resource – Scotese and Wright (2018) 11 August, 2018 by Sabin Zahirovic

https://www.earthbyte.org/webdav/ftp/Data_Collections/Scotese_Wright_2018_PaleoDEM/Scotese_Wright_2018_Maps_1-88_1degX1deg_PaleoDEMS_nc.zip

PALEOMAP Paleodigital Elevation Models (PaleoDEMS) for the Phanerozoic

Scotese, Christopher R, & Wright, Nicky M. (2018). PALEOMAP Paleodigital Elevation Models (PaleoDEMS) for the Phanerozoic [Data set]. Zenodo. https://doi.org/10.5281/zenodo.5460860

Scotese, Christopher R; Wright, Nicky M https://zenodo.org/record/5460860

https://zenodo.org/record/5460860/files/Scotese_Wright_2018_Maps_1-88_6minX6min_PaleoDEMS_nc.zip?download=1

Exoplasim output is Post-Processed with paleodem data.

Exoplasim is ran with Anaconda in Linux. 

Note use older version of exoplaism, if exoplasim does not run correctly.

https://github.com/alphaparrot/ExoPlaSim https://pypi.org/project/exoplasim/ https://exoplasim.readthedocs.io/en/latest/

Generate rgb "true color" planet: Warning: under development, has errors based on koppenpasta True color output

    1. rgb koppenpasta output downscaler proto test 2
    1. needs fine lat, lon, dem, temperature and rainfall maps, and
    2. coarse image map of planet surface: output of koppenpasta , "true color" or so on
    4. 18.12.2023 v 0000.0008e

library(raster) library(rgdal) library(grid) library(png) library(jpeg) library(tiff)

library(rainfarmr) library(ranger) library(gamm4) ## fast, not func library(mgcv) #3 slow library(e1071) library(caret) library(earth) library(brt) library(neuralnet) library(gbm)

first_downscale <- function (valu0) { print("Downscaling stage 1 ...") 

   ext1<-extent(-180,180,-90,90)
   crs1<-"+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"
   
   crs(valu0)<-crs1
   extent(valu0)<-ext1
   
   #plot(valu0)
   
   #stop(-1)
   
    bigtemp1<-raster("./origo2/bio5.tif") 
     bigtemp2<-raster("./origo2/bio6.tif") 
  bigrain1<-raster("./origo/annual_precipitation.tif")
   bigrain2<-raster("./origo2/bio13.tif")  
      bigrain3<-raster("./origo2/bio14.tif")  
  bigdem1<-raster("./origo/usedem.tif") 
  biglat1<-raster("./origo/biglat.tif")
   biglon1<-raster("./origo/biglons.tif")   
  bigtpi1<-raster("./origo/tpi.tif")
   bigtri1<-raster("./origo/tri.tif")   
   bigdistance1<-raster("./origo/distance.tif") 
    bigslope1<-raster("./origo/slope.tif")  
     bigaspect1<-raster("./origo/aspect.tif")  
       bigmask1<-raster("./origo/mask_land.png")  
   



   dimx1=bigtemp1@ncols
   dimy1=bigtemp1@nrows
   print(dimx1)
   print(dimy1)
   
   #quit(-1)
   



  crs(bigrain1)<-crs1
   extent(bigrain1)<-ext1 
    crs(bigrain2)<-crs1
   extent(bigrain2)<-ext1   
      crs(bigrain3)<-crs1
   extent(bigrain3)<-ext1 
       
   crs(bigtemp1)<-crs1
   extent(bigtemp1)<-ext1
     crs(bigtemp2)<-crs1
   extent(bigtemp2)<-ext1  
   
   crs(bigdem1)<-crs1
   extent(bigdem1)<-ext1
   crs(biglat1)<-crs1
   extent(biglat1)<-ext1
    crs(biglon1)<-crs1
   extent(biglon1)<-ext1   

    crs(bigtpi1)<-crs1
   extent(bigtpi1)<-ext1
    crs(bigtri1)<-crs1
   extent(bigtri1)<-ext1 
      crs(bigdistance1)<-crs1
   extent(bigdistance1)<-ext1 
     crs(bigslope1)<-crs1
   extent(bigslope1)<-ext1 
     crs(bigaspect1)<-crs1
   extent(bigaspect1)<-ext1 
      crs(bigmask1)<-crs1
   extent(bigmask1)<-ext1    
   
          
   smallrain1<-resample(bigrain1, valu0)
    smallrain2<-resample(bigrain2, valu0)
        smallrain3<-resample(bigrain3, valu0)   
   smalltemp1<-resample(bigtemp1, valu0)
    smalltemp2<-resample(bigtemp2, valu0)   
   
   smalldem1<-resample(bigdem1, valu0)
   smalllat1<-resample(biglat1, valu0)
   smalllon1<-resample(biglon1, valu0)
   smalltpi1<-resample(bigtpi1, valu0)
   smalltri1<-resample(bigtri1, valu0)
      smalldistance1<-resample(bigdistance1, valu0)   
    smallslope1<-resample(bigslope1, valu0)
   smallaspect1<-resample(bigaspect1, valu0)   
      smallmask1<-resample(bigmask1, valu0)  
      
   #   plot(smalltpi1)
   #   quit(-1)
    
                  
  # plot(smallrain1)
  # plot(bigrain1)
  # plot(smalltemp1)
  # plot(bigtemp1)
  # plot(smalldem1)
  # plot(bigdem1)

#stop(-1) 


   valu1<-as.data.frame(valu0)

   rs1<-values(smallrain1)
     rs2<-values(smallrain2)
         rs3<-values(smallrain3)  
   rt1<-values(smalltemp1)
    rt2<-values(smalltemp1)   
   
   rd1<-values(smalldem1)
    rlat1<-values(smalllat1)
     rlon1<-values(smalllon1)
       rtpi1<-values(smalltpi1)
        rtri1<-values(smalltri1)
        rdistance1<-values(smalldistance1)
     rslope1<-values(smallslope1)
        raspect1<-values(smallaspect1)
        rmask1<-values(smallmask1)
        
   bs1<-values(bigrain1)
    bs2<-values(bigrain2)
    bs3<-values(bigrain3)   
        
   bt1<-values(bigtemp1)
     bt2<-values(bigtemp2)  
   bd1<-values(bigdem1)    
   blat1<-values(biglat1)
   blon1<-values(biglon1)     
     btpi1<-values(bigtpi1)  
      btri1<-values(bigtri1)  
        bdistance1<-values(bigdistance1)  
      bslope1<-values(bigslope1)  
      baspect1<-values(bigaspect1)  
     bmask1<-values(bigmask1)
     
  #      minrta1<-min(rt1)
 # minrtb1<-min(rtb1)
    
  #  bta1[bta1<minrta1]<-minrta1
   #    btb1[btb1<minrtb1]<-minrtb1  
      
             bs1[is.na(bs1)]<- -1
               rs1[is.na(rs1)]<- -1  
               
               bs2[is.na(bs2)]<- -1
               rs2[is.na(rs2)]<- -1   
             bs3[is.na(bs3)]<- -1
               rs3[is.na(rs3)]<- -1                 
                             
                bt1[is.na(bt1)]<- -100
               rt1[is.na(rt1)]<- -100  
               
                   bt2[is.na(bt2)]<- -100
               rt2[is.na(rt2)]<- -100  
                            
                bd1[is.na(bd1)]<- -1
               rd1[is.na(rd1)]<- -1       
                      
              # rtb1[is.na(rtb1)]<- -100    
     
     
     
         
   #coarse1<-as.data.frame(cbind(valu1,rs1, rt1, rd1, rlon1, rlat1, rtpi1, rtri1,rdistance1, rslope1, raspect1))
   #names(coarse1)<-c("valu1", "pr", "ta", "dem", "lon", "lat", "tpi","tri", "distance", "slope", "aspect")
      coarse1<-as.data.frame(cbind(valu1,rs1, rs2, rs3, rt1, rt2, rd1, rlon1, rlat1, rdistance1, rmask1))
   names(coarse1)<-c("valu1", "pr1","pr2", "pr3","ta1","ta2", "dem", "lon", "lat", "distance", "mask")
   #print(head(coarse1,2))

   #stop(-1)
   #accur1<-as.data.frame(cbind(bs1, bt1, bd1, blon1, blat1, btpi1,btri1, bdistance1, bslope1, baspect1))
   accur1<-as.data.frame(cbind(bs1, bs2, bs3, bt1, bt2,  bd1, blon1, blat1,bdistance1, bmask1))
   names(accur1)<-c("pr1","pr2", "pr3","ta1","ta2",  "dem", "lon", "lat", "distance", "mask")

  #method = "gamboost" ok

caret1 <- train(valu1~pr1+ta1+dem, data = coarse1, method = "gamboost",preProc = c("center", "scale") ) 

 caret1.pred <- predict(caret1, newdata = accur1 )

daata1<-caret1.pred 

#   min1=min(valu1)
 #  max1=max(valu1)
  # del1=max1-min1
   
 #      min2=min(daata1)
 #  max2=max(daata1)
 #  del2=max2-min2
   ## 0 ...1
   #daata1<-(daata1-min2)/del2
   #daata1<-daata1*del1+min1
   

  ## has color abberrations

earth.mod <- earth(valu1~pr1+pr2+pr3+ta1+ta2+dem+mask, data=coarse1, degree=1) pred2<-predict(earth.mod, newdata=accur1) daata2<-as.numeric(pred2)

    1. ok

svm3 <-svm (valu1~pr1+ta1+dem+mask, data=coarse1, cost=100, gamma=1.7) svm3.pred<-predict(svm3, accur1) 

  str(svm3.pred)
 daata3<-as.numeric(svm3.pred)

    daataa<-(daata1+daata2+daata3)/3	
       
   ## WARNING clamps  to 0 ... 1 !!!!
   
    daataa<-replace( daataa,  daataa<0, 0)
    daataa<-replace( daataa,  daataa>1, 1)

   dmat1<-matrix( daataa, nrow=dimy1, byrow=TRUE)
   

   dras1<-raster(dmat1)
   ext1<-extent(-180,180,-90,90)
   crs1<-"+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"
   extent(dras1)<-ext1
   crs(dras1)<-crs1

#  plot(dras1)
#   quit("yes")
    return(dras1)

}

earth_downscale<-function(valu0) { print(" Earth downscaling ...")

ext1<-extent(-180,180,-90,90) 

   crs1<-"+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"
   

  # bigtemp1<-raster("./origo/annual_mean_temperature.tif") 
    bigtempa1<-raster("./origo2/bio5.tif")  
    bigtempb1<-raster("./origo2/bio6.tif")       
  bigrain1<-raster("./origo/annual_precipitation.tif")
  bigdem1<-raster("./origo/usedem.tif") 
  biglat1<-raster("./origo/biglat.tif")
   biglon1<-raster("./origo/biglons.tif")   
   bigdistance1<-raster("./origo/distance.tif")  
   
  # smalltemp1<-raster("./origo4/earth_annual_mean_temperature.tif") 
     smalltempa1<-raster("./origo4/earth_bio_05.tif")  
        smalltempb1<-raster("./origo4/earth_bio_06.tif")     
  smallrain1<-raster("./origo4/earth_annual_precipitation.tif")
  smalldem1<-raster("./origo4/earthdem.tif") 
  smalllat1<-raster("./origo4/earthlat.tif")
   smalllon1<-raster("./origo4/earthlons.tif")   
    smalldistance1<-raster("./origo4/earth_distance.tif")  
       
   dimx1=bigtempa1@ncols
   dimy1=bigtempa1@nrows
   print(dimx1)
   print(dimy1)
   
  # quit(-1)
   
   
  crs(bigrain1)<-crs1
   extent(bigrain1)<-ext1   
   crs(bigtempa1)<-crs1
   extent(bigtempa1)<-ext1
     crs(bigtempb1)<-crs1
   extent(bigtempb1)<-ext1  
   crs(bigdem1)<-crs1
   extent(bigdem1)<-ext1
   crs(biglat1)<-crs1
   extent(biglat1)<-ext1
    crs(biglon1)<-crs1
   extent(biglon1)<-ext1   
    crs(bigdistance1)<-crs1
   extent(bigdistance1)<-ext1  



      crs(smallrain1)<-crs1
   extent(smallrain1)<-ext1   
   crs(smalltempa1)<-crs1
   extent(smalltempa1)<-ext1
     crs(smalltempb1)<-crs1
   extent(smalltempb1)<-ext1  
   crs(smalldem1)<-crs1
   extent(smalldem1)<-ext1
   crs(smalllat1)<-crs1
   extent(smalllat1)<-ext1
    crs(smalllon1)<-crs1
   extent(smalllon1)<-ext1          
    crs(smalldistance1)<-crs1
   extent(smalldistance1)<-ext1  
 
     valu1<-as.data.frame(valu0)

   rs1<-values(smallrain1)
   rta1<-values(smalltempa1)
     rtb1<-values(smalltempb1)  
   rd1<-values(smalldem1)
    rlat1<-values(smalllat1)
     rlon1<-values(smalllon1)
       rdistance1<-values(smalldistance1)             
        
   bs1<-values(bigrain1)
   bta1<-values(bigtempa1)
      btb1<-values(bigtempb1) 
   bd1<-values(bigdem1)    
   blat1<-values(biglat1)
   blon1<-values(biglon1)     
   bdistance1<-values(bigdistance1)     



  minrta1<-min(rta1)
  minrtb1<-min(rtb1)
    
    bta1[bta1<minrta1]<-minrta1
       btb1[btb1<minrtb1]<-minrtb1  
      
             bs1[is.na(bs1)]<- -1
               rs1[is.na(rs1)]<- -1  
                
                bta1[is.na(bta1)]<- -100
               rta1[is.na(rta1)]<- -100  
               
                bd1[is.na(bd1)]<- -1
               rd1[is.na(rd1)]<- -1       
                      
               rtb1[is.na(rtb1)]<- -100    
               
   coarse1<-as.data.frame(cbind(valu1,rs1, rta1,rtb1, rd1, rlon1, rlat1, rdistance1))
   names(coarse1)<-c("valu1", "pr", "ta","tb", "dem", "lon", "lat", "distance")

   #print(head(coarse1,2))

   #stop(-1)
   accur1<-as.data.frame(cbind(bs1, bta1,btb1, bd1, blon1, blat1, bdistance1))

   names(accur1)<-c("pr", "ta","tb" ,"dem", "lon", "lat", "distance")
  1. motel1<-lm(valu1~pr+ta+dem+lon+lat, data=coarse1 )
# pred1<-predict(motel1, accur1, se.fit = TRUE)
#daata1<-pred1$fit
## brnn partly ok, glmnet not good
#3 !!! gamboost good, glmboost not kood, has some ok

knn2 <- train(valu1~pr+ta+dem, data = coarse1,method = "mars", na.action = na.pass, preProc = c("center", "scale")) knn2.pred <- predict(knn2, newdata = accur1 ) #print(knn2.pred) daata2<-knn2.pred


  1. earth.mod <- earth(valu1~pr+ta+dem, data=coarse1, degree=1)


  1. pred3<-predict(earth.mod, newdata=accur1)
  1. daata3<-as.numeric(pred3)


# bami4 <- bam(valu1~pr+ta+dem+lon+lat+distance, data=coarse1)
#    pred4 <- predict.bam(bami4, newdata=accur1)
  1. daata4<-as.numeric(pred4)
  1. svm4 <-svm (valu1~pr+ta, data=coarse1, cost=100, gamma=1.7)

#svm4.pred<-predict(svm4, accur1) 

  #str(svm4.pred)
  
# daata5<-as.numeric(svm4.pred)

  daataa<-daata2


   dra1<-as.data.frame(daataa)

   names(dra1)=c("z")
   dvec0<-as.vector(dra1"z")

  ## camp to 0.... 1
  
   dvec01<-replace(dvec0, dvec0<0, 0)
   dvec1<-replace(dvec01, dvec01>1, 1)

   dmat1<-matrix(dvec1, nrow=600, byrow=TRUE)
   
   dras1<-raster(dmat1)
   ext1<-extent(-180,180,-90,90)
   crs1<-"+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"
   extent(dras1)<-ext1
   crs(dras1)<-crs1

#  plot(dras1)
#   quit("yes")
    return(dras1)


}

second_downscale <- function (valu0) { print("Downscaling stage 2 **..") 

   ext1<-extent(-180,180,-90,90)
   crs1<-"+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"
   
   crs(valu0)<-crs1
   extent(valu0)<-ext1
   
   #plot(valu0)
   
   #stop(-1)
   
   
    bigtemp1<-raster("./origo/annual_mean_temperature.tif") 
  bigrain1<-raster("./origo/annual_precipitation.tif")
  bigdem1<-raster("./origo/usedem.tif") 
  biglat1<-raster("./origo/biglat.tif")
   biglon1<-raster("./origo/biglons.tif")   
  bigtpi1<-raster("./origo/tpi.tif")
   bigtri1<-raster("./origo/tri.tif")   
   bigdistance1<-raster("./origo/distance.tif") 
    bigslope1<-raster("./origo/slope.tif")  
     bigaspect1<-raster("./origo/aspect.tif")
  1. bigtemp1<-raster("./origo/annual_mean_temperature_accu.tif")
  2. bigrain1<-raster("./origo/annual_precipitation_accu.tif")
  3. bigdem1<-raster("./origo/usedemaccu.tif")
#   biglat1<-raster("./origo/biglataccu.tif")
#   biglon1<-raster("./origo/biglonsaccu.tif")   
#   bigtpi1<-raster("./origo/tpiaccu.tif")
#   bigtri1<-raster("./origo/triaccu.tif")    
#     bigdistance1<-raster("./origo/distanceaccu.tif") 
#     bigslope1<-raster("./origo/slopeaccu.tif")
  1. bigaspect1<-raster("./origo/aspectaccu.tif")


   bigaspect1[is.na(bigaspect1)] <- 0 
     bigslope1[is.na(bigslope1)] <- 0 
     bigtpi1[is.na(bigtpi1)] <- 0 
   
 #  plot(bigaspect1)

  # stop(-1)
              
   dimx1=bigtemp1@ncols
   dimy1=bigtemp1@nrows
   print(dimx1)
   print(dimy1)
   
   #quit(-1)
   



  crs(bigrain1)<-crs1
   extent(bigrain1)<-ext1   
   crs(bigtemp1)<-crs1
   extent(bigtemp1)<-ext1
   crs(bigdem1)<-crs1
   extent(bigdem1)<-ext1
   crs(biglat1)<-crs1
   extent(biglat1)<-ext1
    crs(biglon1)<-crs1
   extent(biglon1)<-ext1   

    crs(bigtpi1)<-crs1
   extent(bigtpi1)<-ext1
    crs(bigtri1)<-crs1
   extent(bigtri1)<-ext1 
      crs(bigdistance1)<-crs1
   extent(bigdistance1)<-ext1 
     crs(bigslope1)<-crs1
   extent(bigslope1)<-ext1 
     crs(bigaspect1)<-crs1
   extent(bigaspect1)<-ext1 
          
   smallrain1<-resample(bigrain1, valu0)
   smalltemp1<-resample(bigtemp1, valu0)
   smalldem1<-resample(bigdem1, valu0)
   smalllat1<-resample(biglat1, valu0)
   smalllon1<-resample(biglon1, valu0)
   smalltpi1<-resample(bigtpi1, valu0)
   smalltri1<-resample(bigtri1, valu0)
      smalldistance1<-resample(bigdistance1, valu0)   
    smallslope1<-resample(bigslope1, valu0)
   smallaspect1<-resample(bigaspect1, valu0)      
   #   plot(smalltpi1)
   #   quit(-1)
    
                  
  # plot(smallrain1)
  # plot(bigrain1)
  # plot(smalltemp1)
  # plot(bigtemp1)
  # plot(smalldem1)
  # plot(bigdem1)

#stop(-1) 


   valu1<-as.data.frame(valu0)

   rs1<-values(smallrain1)
   ds1<-as.data.frame(rs1)
   rt1<-values(smalltemp1)
   dt1<-as.data.frame(rt1)
   rd1<-values(smalldem1)
   dd1<-as.data.frame(rd1)
    rlat1<-values(smalllat1)
   dlat1<-as.data.frame(rlat1)
     rlon1<-values(smalllon1)
   dlon1<-as.data.frame(rlon1)
       rtpi1<-values(smalltpi1)
   dtpi1<-as.data.frame(rtpi1 ) 
        rtri1<-values(smalltri1)
   dtri1<-as.data.frame(rtri1 )    
        rdistance1<-values(smalldistance1)
        
        
   ddistance1<-as.data.frame(rdistance1 )    
   
     rslope1<-values(smallslope1)
       dslope1<-as.data.frame(rslope1)
        raspect1<-values(smallaspect1)
       daspect1<-as.data.frame(raspect1)
        
   bs1<-values(bigrain1)
   bt1<-values(bigtemp1)
   bd1<-values(bigdem1)    
   blat1<-values(biglat1)
   blon1<-values(biglon1)     
     btpi1<-values(bigtpi1)  
      btri1<-values(bigtri1)  
        bdistance1<-values(bigdistance1)  
      bslope1<-values(bigslope1)  
      baspect1<-values(bigaspect1)  
               
   coarse1<-as.data.frame(cbind(valu1,rs1, rt1, rd1, rlon1, rlat1, rtpi1, rtri1,rdistance1, rslope1, raspect1))
   names(coarse1)<-c("valu1", "pr", "ta", "dem", "lon", "lat", "tpi","tri", "distance", "slope", "aspect")

   #print(head(coarse1,2))

   #stop(-1)
   accur1<-as.data.frame(cbind(bs1, bt1, bd1, blon1, blat1, btpi1,btri1, bdistance1, bslope1, baspect1))

   names(accur1)<-c("pr", "ta", "dem", "lon", "lat", "tpi", "tri", "distance", "slope", "aspect")
  1. motel1<-lm(valu1~pr+ta+dem, data=coarse1 )
# pred1<-predict(motel1, accur1, se.fit = TRUE)

 #  pred1<-predict(motel1, accur1, se.fit = TRUE)

 # daata1<-pred1$fit
    1. knn ok gausspradial osin ok
    2. begearth osin ok inaccurate
  2. gam quite ok
    1. svmRadial in caret quite ok , lots tundra svmpoly ok sloow , but not so tan svmpoly
    1. lm, penalized ,pls, kernelpls, simpls some color, inaccurate svmLinear too
    1. brnn: generates surface , but has color abberrations too partly ok, partly nok
    4. xgblinear slow and not accurate randomGLM very slow
    5. cubist has some artefacts
    6. lars inaccurate
  1. knn5 <- train(valu1~pr+ta+dem+distance,
#              data = coarse1,
 #             method = "svmRadial",
  #           preProc = c("center", "scale") )
    1. knn5 <- train(valu1~pr+ta+dem+lon+lat,
 ##              data = coarse1,
 ##              method = "knn",
 ##              preProc = c("center", "scale"))
  1. knn5.pred <- predict(knn5, newdata = accur1 )

#print(knn5.pred)

  1. daata5<-knn5.pred

#stop(-1) 

   #print(head(accur1,2))

   #stop(-1)

#print("Svm ...") svm4 <-svm (valu1~pr+ta+tb+dem+lon+lat, data=coarse1, cost=100, gamma=1.0)

svm4.pred<-predict(svm4, accur1) 

  #str(svm4.pred)
  
 daata4<-as.numeric(svm4.pred)
   #print(daata4)
   #quit(-1)


  1. ran2 <- ranger(valu1~pr+ta+dem+distance, importance='impurity', data=coarse1,num.trees=128,probability=FALSE, mtry=4) ## mtry number
  1. pred2 <- predict(ran2, data=accur1)
  2. daata2<-as.numeric(pred2$predictions)
  1. bami3 <- bam(valu1~pr+ta+dem+lon+lat+tpi+distance, data=coarse1 ,gamma=1.7)
   #bami3 <- bam(valu1~pr+ta+dem+lon+lat, data=coarse1)
  1. pred3 <- predict.bam(bami3, newdata=accur1)
  2. daata3<-as.numeric(pred3)

## earth MARS quite ok

  1. earth.mod <- earth(valu1~pr+ta+dem+lon+lat+distance+slope+aspect, data=coarse1, degree=1)

#earth.mod <- earth(valu1~pr+ta+dem+distance+tpi, data=coarse1, degree=1)

  1. pred6<-predict(earth.mod, newdata=accur1)
  1. daata6<-as.numeric(pred6)
    1. nok
  2. nn7.model = neuralnet( valu1~pr+ta+dem+lon+lat, linear.output = FALSE, hidden = c(5, 5), data=coarse1)
##  print(".")
  1. pred7 = neuralnet::compute(nn7.model, accur1)
  1. str(pred7)
  1. daata7<-pred7$net.result
  1. stop(-1)
  ## todo_ brt
  
 ## todo: nn
  1. str(pred6)

#stop(-1)

    1. quite ok, but classifies!
    2. bernouilli, adaboost
  1. gbm8 <- gbm(valu1~pr+ta+dem+distance+tpi, data=coarse1, distribution="bernoulli")
  1. daata8<-predict(gbm8, newdata=accur1, n.trees=500, type="response")
  1. str(pred8)
  1. quit("yes")
   #dmat1<-as.matrix(daata1, nrow=dimx1, ncol=dimy1)

#daataa<-(daata2*4+daata3*2)/6 

 	daataa<- daata4

##dem effecto
max1<-max(bd1)
min1<-min(bd1)

mami1<- (max1-min1)
bed1<-bd1
bed1<-bed1-min1
bed1<-bed1/mami1
bed1<-bed1*0.1

print (min(bed1))
print (max(bed1))



bed2=rnorm(n = dimx1*dimy1, mean = 0, sd = 0.25)
bed2=bed2*bed1
#quit(-1)
 

#      	daataa<- (daata1)
 #  daataa<-daata6*0.8+bed1
    ##  daataa<-daata6*0.9+bed2		
   
   
   daataa<-daata4
   
   dra1<-as.data.frame(daataa)

   names(dra1)=c("z")
   dvec0<-as.vector(dra1"z")
   dvec01<-replace(dvec0, dvec0<0, 0)
   dvec1<-replace(dvec01, dvec01>1, 1)

   #print(head(dvec1))

   #stop(-1)

   dmat1<-matrix(dvec1, nrow=dimy1, byrow=TRUE)
  1. image(dmat1)

# print(dim(dmat1)) 

 #  quit(-1)
   
  ## dmat1<-matrix(dvec1, nrow=180, byrow=TRUE)
   #print(dmat1)

   #print("mat")

   #print(head(dmat1))

   #quit(-1)

   #image(dmat1)

   dras1<-raster(dmat1)
   ext1<-extent(-180,180,-90,90)
   crs1<-"+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"
   extent(dras1)<-ext1
   crs(dras1)<-crs1

#  plot(dras1)
#   quit("yes")
    return(dras1)
   # return(dmat1)

}

        2. main program
    1. smaller, bigger downscaling

ds_1=1 ds_2=0 earth_ds_1=0

if (ds_1==1) {

  1. img <- png::readPNG('./duuni_5000_1/basemap_land.png')
  2. img <- png::readPNG('./origo/basemap_land_p5000.png')

img <- png::readPNG('./origo/koppen_land.png')

  1. img <- png::readPNG('./origo/koppenw_land.png')
  2. img <- png::readPNG('./origo/hold_small_land.png')
  1. img <- png::readPNG('./basecamo1.png')
    1. plot(img)

r <- brick(img)

raster::plotRGB(r, scale = 1)

  1. quit("yes")

red=r1 green=r2 blue=r3

  1. ext1<-extent(-180,180,-90,90)
  2. crs1<-"+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"

red2=first_downscale(red) green2=first_downscale(green) blue2=first_downscale(blue)

grey2=red2*0.3+green2*0.6+blue2*0.11

rik1<-brick(grey2, red2, green2, blue2) rik2<-brick(red2, green2, blue2)*255

  1. png("colormap1.png", width = 360, height =180)

png("colormap1.png", width = 2400, height =1200) plotRGB(rik2)

dev.off()

  1. quit("yes")

}

    1. second stage

if (ds_2==1) {

  1. img <- png::readPNG('./colormap1.png')
  2. img <- png::readPNG('./duuni_5000_1/basemap_land.png')
  3. img <- png::readPNG('./origo/basemap_land_p5000.png')
  4. img <- png::readPNG('./origo/koppen_land.png')
  5. img <- png::readPNG('./origo/koppenw_land.png')
  6. img <- png::readPNG('./origo/hold_small_land.png')

img <- png::readPNG('./basecamo1.png')

    1. plot(img)

r <- brick(img)

raster::plotRGB(r, scale = 1)

  1. quit("yes")

red=r1 green=r2 blue=r3

  1. ext1<-extent(-180,180,-90,90)
  2. crs1<-"+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"

red2=second_downscale(red) green2=second_downscale(green) blue2=second_downscale(blue)

grey2=red2*0.3+green2*0.6+blue2*0.11

rik1<-brick(grey2, red2, green2, blue2) rik2<-brick(red2, green2, blue2)*255

png("colormap2.png", width = 2400, height =1200)

plotRGB(rik2)

dev.off()

}

if (earth_ds_1==1) {

print(" Earth test") img3 <- png::readPNG('./origo4/satellite.png')

  1. plot(img3)
  1. quit(-1)

r3 <- brick(img3)

raster::plotRGB(r3, scale = 1)

  1. quit("yes")

reda=r31 greena=r32 bluea=r33

  1. ext1<-extent(-180,180,-90,90)
  2. crs1<-"+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"

red2=earth_downscale(reda) green2=earth_downscale(greena) blue2=earth_downscale(bluea)

grey2=red2*0.3+green2*0.6+blue2*0.11

rik1<-brick(grey2, red2, green2, blue2) rik2<-brick(red2, green2, blue2)*255

png("colormapsuper1.png", width = 2400, height =1200)

plotRGB(rik2)

dev.off()

}

Licensing

[edit]
I, the copyright holder of this work, hereby publish it under the following license:
w:en:Creative Commons
attribution share alike
This file is licensed under the Creative Commons Attribution-Share Alike 4.0 International license.
You are free:
  • to share – to copy, distribute and transmit the work
  • to remix – to adapt the work
Under the following conditions:
  • attribution – You must give appropriate credit, provide a link to the license, and indicate if changes were made. You may do so in any reasonable manner, but not in any way that suggests the licensor endorses you or your use.
  • share alike – If you remix, transform, or build upon the material, you must distribute your contributions under the same or compatible license as the original.

File history

Click on a date/time to view the file as it appeared at that time.

Date/TimeThumbnailDimensionsUserComment
current12:19, 18 December 2023Thumbnail for version as of 12:19, 18 December 20232,400 × 1,200 (2.04 MB)Merikanto (talk | contribs)Uploaded own work with UploadWizard

You cannot overwrite this file.

There are no pages that use this file.

Retrieved from "https://commons.wikimedia.org/w/index.php?title=File:Permian_triassic_252ma_co2_450_vege_map_1.png&oldid=831912417"