kuraiyamaK123

Study sites

List of survey plots
code area aspect slope X1 X2 X1.1 X2.1
k1 k1 4422.956 South 38.42805 35.98385 137.2219 990 1058
k2 k2 11161.926 North 31.24337 35.98715 137.2174 852 965
k3 k3 3685.518 North West 27.75433 35.98750 137.2206 900 959

flowchart

data

data(package="kuraiyamaK123")$results[, c("Item")]
#> [1] "DBH_cah_abc"       "TreeHeight_CR_abc" "k123"             
#> [4] "k123_area_vector"  "k123_drone"        "k123_field"       
#> [7] "k123_lidar"        "k123_site"         "k123_species"

k123_site

k123_site
#>    code      area     aspect    slope       X1       X2 X1.1 X2.1
#> k1   k1  4422.956      South 38.42805 35.98385 137.2219  990 1058
#> k2   k2 11161.926      North 31.24337 35.98715 137.2174  852  965
#> k3   k3  3685.518 North West 27.75433 35.98750 137.2206  900  959

k123_area_vector

par(mfrow=c(1,3)) ;
sapply(k123_area_vector,plot)

#> $k1
#> NULL
#> 
#> $k2
#> NULL
#> 
#> $k3
#> NULL
sapply(k123_area_vector,sf::st_area)
#>        k1        k2        k3 
#>  4218.799 11161.378  3427.947

k123_field

k123_field
#> Simple feature collection with 1057 features and 34 fields (with 133 geometries empty)
#> Geometry type: POINT
#> Dimension:     XY
#> Bounding box:  xmin: 4538.371 ymin: -1840.062 xmax: 5009.571 ymax: -1323.528
#> Projected CRS: JGD2011 / Japan Plane Rectangular CS VII
#> First 10 features:
#>    plot label id id_ttops        sp   dbh  h_drone vital memo crown conif
#> 1     1   670 NA      282    sawara 26.69       NA     4 <NA>     0     1
#> 2     1   671 NA      296   asunaro 47.70 26.96774     4 <NA>     1     1
#> 3     1   674 NA      296 tochinoki 50.50 35.80154     5 <NA>     1     0
#> 4     1   675 NA      296    sawara 48.00 32.83424     4 <NA>     1     1
#> 5     1   676 NA      304    mizume 70.00 32.51574     4 <NA>     1     0
#> 6     1   677 NA       NA    sawara 48.90 35.19034     5 <NA>     1     1
#> 7     1   678 NA       NA    sawara 30.50 25.28384     3 <NA>     1     1
#> 8     1   679 NA      296    mizume 52.90 28.55934     5 <NA>     1     0
#> 9     1   680 NA      303   asunaro 42.60 30.44564     3 <NA>     1     1
#> 10    1   681 NA      303    sawara 89.00 42.78994     5 <NA>     1     1
#>    id_drone        ca        h       V_dh   V_Dah2     V_Dah
#> 1        NA        NA 19.65032  0.5469689       NA        NA
#> 2        60  16.79087 26.96774  2.2005467 1.658735  1.858464
#> 3       177  63.58285 35.80154  2.9574539 5.731167  1.989419
#> 4       122  26.03746 32.83424  2.6988935 3.389342  3.561297
#> 5       196 119.01013 32.51574  4.9194313 5.208477  2.802606
#> 6       151  36.66172 35.19034  2.9898780 4.612939  4.919668
#> 7       117  23.30980 25.28384  0.8975208 1.513318  1.902639
#> 8        59  39.16948 28.55934  2.5863167 2.537637  1.360001
#> 9       111  23.12234 30.44564  2.0066777 2.615350  2.844624
#> 10      183  68.56718 42.78994 10.3894934 9.935714 10.326648
#>                      geometry        x         y      z    h_drn     h_cr
#> 1  POINT (5001.724 -1824.627) 5001.724 -1824.627 1006.2       NA 19.65032
#> 2  POINT (4992.009 -1829.587) 4992.009 -1829.587 1001.9 26.96774 28.14266
#> 3  POINT (4995.499 -1834.938) 4995.499 -1834.938 1000.8 35.80154 28.92659
#> 4  POINT (4987.866 -1832.431) 4987.866 -1832.431 1000.3 32.83424 28.23769
#> 5  POINT (4979.523 -1835.144) 4979.523 -1835.144  997.6 32.51574 31.75869
#> 6  POINT (4989.693 -1840.062) 4989.693 -1840.062  998.7 35.19034 28.51903
#> 7  POINT (4981.074 -1827.993) 4981.074 -1827.993 1000.8 25.28384 21.49580
#> 8  POINT (4987.588 -1827.572) 4987.588 -1827.572 1002.8 28.55934 29.38735
#> 9   POINT (4972.117 -1835.19) 4972.117 -1835.190  995.6 30.44564 26.42724
#> 10 POINT (4965.849 -1835.615) 4965.849 -1835.615  992.4 42.78994 36.75891
#>         Vrin Vrin_drn    v_cah v_cah_all        dst h_drn_cr Vrin_h_drn_cr
#> 1  0.5469689       NA       NA        NA  5.5565395 19.65032     0.5469689
#> 2  2.2942392 26.96774 2.716888  2.475037  5.5807518 26.96774     2.2005467
#> 3  2.4034573 35.80154 2.716888  6.914297  0.8960729 35.80154     2.9574539
#> 4  2.3288776 32.83424 3.431066  3.827739  5.9326947 32.83424     2.6988935
#> 5  4.8019536 32.51574 3.431066  4.335489  6.2823456 32.51574     4.9194313
#> 6  2.4344335 35.19034 1.741931  4.192340  0.8565087 35.19034     2.9898780
#> 7  0.7658169 25.28384 2.412390  1.496751 13.5066277 25.28384     0.8975208
#> 8  2.6592293 28.55934 1.741931  2.538673  9.8392051 28.55934     2.5863167
#> 9  1.7473240 30.44564 1.283943  2.786357  5.3543594 30.44564     2.0066777
#> 10 8.9791245 42.78994 1.431679  6.732380  4.0702851 42.78994    10.3894934
#>       v_cah2 v_cah_all2    v_cah3 v_cah_all3 PP9
#> 1         NA         NA        NA         NA   1
#> 2   1.858464   1.658735  1.858464   1.658735   1
#> 3   1.989419   5.731167  1.989419   5.731167   1
#> 4   3.561297   3.389342  3.561297   3.389342   1
#> 5   2.802606   5.208477  2.802606   5.208477   1
#> 6   4.919668   4.612939  4.919668   4.612939   1
#> 7   1.902639   1.513318  1.902639   1.513318   1
#> 8   1.360001   2.537637  1.360001   2.537637   1
#> 9   2.844624   2.615350  2.844624   2.615350   1
#> 10 10.326648   9.935714 10.326648   9.935714   1
plot(k123_field["dbh"])

k123_lidar

k123_lidar
#> Simple feature collection with 637 features and 7 fields
#> Geometry type: POINT
#> Dimension:     XY
#> Bounding box:  xmin: 4539.75 ymin: -1840.75 xmax: 5011.25 ymax: -1327.25
#> Projected CRS: JGD2011 / Japan Plane Rectangular CS VII
#> First 10 features:
#>    plot treeID lbl   height    ca         v winRadius                 geometry
#> 1     1     34 889 20.56006 21.75 0.8038435  1.628003 POINT (5000.75 -1750.25)
#> 2     1     40 886 20.44006 31.00 0.8791932  1.622003 POINT (4987.25 -1751.75)
#> 3     1     76 877 19.28003 18.50 0.6329775  1.564001 POINT (5001.75 -1759.75)
#> 4     1    104 992 19.68005 20.75 0.6963188  1.584003 POINT (5001.25 -1765.25)
#> 5     1    125 990 19.25000 28.50 0.7178056  1.562500 POINT (5000.75 -1772.25)
#> 6     1    223 812 21.64105  5.75 0.6261513  1.682053 POINT (5006.25 -1802.75)
#> 7     1    224 812 21.96399  5.50 0.6454807  1.698199 POINT (5007.75 -1803.25)
#> 8     1    231 812 22.10999  7.75 0.7300103  1.705499 POINT (5004.25 -1804.75)
#> 9     1    235 812 24.37000  8.50 1.0010554  1.818500 POINT (5005.75 -1806.25)
#> 10    1    239 812 23.98999  5.25 0.8262949  1.799500 POINT (5003.75 -1807.75)
plot(k123_lidar["height"])

k123_drone

k123_drone
#> Simple feature collection with 585 features and 7 fields
#> Geometry type: POLYGON
#> Dimension:     XY
#> Bounding box:  xmin: 4536.323 ymin: -1843.417 xmax: 5013.194 ymax: -1320.471
#> Projected CRS: JGD2011 / Japan Plane Rectangular CS VII
#> First 10 features:
#>     id         a        h              sp lbl   dbh plot
#> 1  229 14.522895 20.74704          hinoki 887 31.50    1
#> 2  246 19.603909 20.85744          hinoki 889 43.57    1
#> 3  253 23.244634 21.59184          hinoki 886 42.79    1
#> 4  202  6.361268 23.74694          hinoki 861 28.79    1
#> 5  221 12.442481 19.95144          hinoki 877 28.80    1
#> 6  228 14.482888 20.33754          hinoki 992 31.15    1
#> 7  240 18.363661 19.71104          hinoki 990 27.45    1
#> 8  197  4.240846 21.62244 kohauchiwakaede 961 15.65    1
#> 9  265 27.805544 25.54584         hoonoki 812 39.59    1
#> 10 206  7.843397 23.95214            kuri 800 29.75    1
#>                          geometry
#> 1  POLYGON ((4992.86 -1750.879...
#> 2  POLYGON ((4999.66 -1752.279...
#> 3  POLYGON ((4987.26 -1753.479...
#> 4  POLYGON ((4979.26 -1754.279...
#> 5  POLYGON ((5002.06 -1761.079...
#> 6  POLYGON ((5000.06 -1769.079...
#> 7  POLYGON ((5003.26 -1775.079...
#> 8  POLYGON ((4996.86 -1792.079...
#> 9  POLYGON ((5006.66 -1808.479...
#> 10 POLYGON ((4962.66 -1752.679...
plot(k123_drone["h"])

k123_species

List of tree species
sp ScienceName
アオダモ Fraxinus lanuginosa Koidz. f. serrata (Nakai) Murata
アオハダ Ilex macropoda Miq.
アカシデ Carpinus laxiflora (Siebold et Zucc.) Blume
アサノハカエデ Acer argutum Maxim.
アスナロ Thujopsis dolabrata (L.f.) Siebold et Zucc. var. dolabrata
アセビ Pieris japonica (Thunb.) D.Don ex G.Don
アワブキ Meliosma myriantha Siebold et Zucc.
ウダイカンバ Betula candelae Koidz.
ウラジロノキ Aria japonica Decne.
ウワミズザクラ Padus grayana (Maxim.) C.K.Schneid.
エゴノキ Styrax japonicus Siebold et Zucc.
カツラ Cercidiphyllum japonicum Siebold et Zucc. ex Hoffm. et Schult.
カナクギノキ Benzoin erythrocarpum (Makino) Rehder
キハダ Phellodendron amurense Rupr. var. amurense
キブシ Stachyurus lancifolius Koidz.
クマシデ Carpinus japonica Blume
クリ Castanea crenata Siebold et Zucc.
クロモジ Lindera umbellata Thunb. var. umbellata
コシアブラ Acanthopanax sciadophylloides Franch. et Sav.
コナラ Quercus glandulifera Blume
コハウチワカエデ Acer sieboldianum Miq.
コハクウンボク Styrax shiraianus Makino
コミネカエデ Acer micranthum Siebold et Zucc.
サワグルミ Pterocarya rhoifolia Siebold et Zucc.
サワフタギ Palura chinensis (Lour.) Koidz. var. pilosa (Nakai) Nakai
サワラ Chamaecyparis pisifera (Siebold et Zucc.) Endl.
シロモジ Lindera triloba (Siebold et Zucc.) Blume
スギ Cryptomeria japonica (L.f.) D.Don
タムシバ Magnolia salicifolia (Siebld et Zucc.) Maxim.
ツリバナ Euonymus oxyphyllus Miq.
トチノキ Aesculus turbinata Blume
ネジキ Lyonia elliptica (Siebold et Zucc.) Okuyama
ノリウツギ Heteromalla paniculata (Siebold) H.Ohba et S.Akiyama
ハクウンボク Styrax obassia Siebold et Zucc.
ハリギリ Eleutherococcus septemlobus (Thunb.) Mabb.
ヒノキ Chamaecyparis obtusa (Siebold et Zucc.) Endl.
フサザクラ Euptelea polyandra Siebold et Zucc.
ホオノキ Magnolia hypoleuca Siebold et Zucc.
マルバノキ Disanthus cercidifolius Maxim.
ミズキ Bothrocaryum controversum (Hemsl. ex Prain) Pojark.
ミズナラ Quercus crispula Blume f. longifolia (Nakai) M.Kikuchi
ミズメ Betula grossa Siebold et Zucc.
ムラサキシキブ Callicarpa japonica Thunb.
ヤマナシ Pyrus pyrifolia (Burm.f.) Nakai
リョウブ Clethra barbinervis Siebold et Zucc.

estimation from crown area and tree height


 p<-subset(k123_field,vital>0 & crown==1)
 ca<-p$ca ; h<- p$h ; dbh <- p$dbh ; conif <- p$conif==1
 DBH_cah_abc
#>      all broadleaved conifer
#> a 1.1800    11.60134  1.7862
#> b 0.2007     0.35335  0.2572
#> c 0.8987    -0.01609  0.7537

 par(mfrow=c(1,3))
 i<-conif
 # all tree species ####
 dbh. <-  DBH_cah(ca,h)
 plot(dbh,dbh.,xlab="DBH (field)",ylab="DBH_ca_h",main="All species")
 points(dbh[i],dbh.[i],col="red")
 (lm.all <- summary(lm(dbh~dbh.-1)))
#> 
#> Call:
#> lm(formula = dbh ~ dbh. - 1)
#> 
#> Residuals:
#>     Min      1Q  Median      3Q     Max 
#> -39.920  -7.727   0.316   7.377  43.592 
#> 
#> Coefficients:
#>      Estimate Std. Error t value Pr(>|t|)    
#> dbh.   1.0002     0.0117   85.51   <2e-16 ***
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> Residual standard error: 12.05 on 578 degrees of freedom
#> Multiple R-squared:  0.9267, Adjusted R-squared:  0.9266 
#> F-statistic:  7312 on 1 and 578 DF,  p-value: < 2.2e-16
 lines(c(0,120),c(0,120))

 # Conifer ####
 dbh. <-  DBH_cah(ca[conif],h[conif],abc=DBH_cah_abc$conifer)
 plot(dbh[i],dbh.,xlab="DBH (field)",ylab="DBH_ca_h",main="Conifer",col="red")
(lm.conif <- summary(lm(dbh[i]~dbh.-1)))
#> 
#> Call:
#> lm(formula = dbh[i] ~ dbh. - 1)
#> 
#> Residuals:
#>     Min      1Q  Median      3Q     Max 
#> -32.580  -5.604  -0.735   5.339  39.488 
#> 
#> Coefficients:
#>      Estimate Std. Error t value Pr(>|t|)    
#> dbh.  1.00014    0.01175    85.1   <2e-16 ***
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> Residual standard error: 9.945 on 324 degrees of freedom
#> Multiple R-squared:  0.9572, Adjusted R-squared:  0.957 
#> F-statistic:  7242 on 1 and 324 DF,  p-value: < 2.2e-16
lines(c(0,120),c(0,120))

# Broadleaved ####
 dbh. <-  DBH_cah(ca[!i],h[!i],abc=DBH_cah_abc$broadleaved)
 plot(dbh[!i],dbh.,xlab="DBH (field)",ylab="DBH_ca_h",main="Broadleaved")
 (lm.broad <-summary(lm(dbh[!i]~dbh.-1)))
#> 
#> Call:
#> lm(formula = dbh[!i] ~ dbh. - 1)
#> 
#> Residuals:
#>     Min      1Q  Median      3Q     Max 
#> -30.543  -7.356  -1.552   6.766  41.438 
#> 
#> Coefficients:
#>      Estimate Std. Error t value Pr(>|t|)    
#> dbh.  0.99999    0.01717   58.24   <2e-16 ***
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> Residual standard error: 10.44 on 253 degrees of freedom
#> Multiple R-squared:  0.9306, Adjusted R-squared:  0.9303 
#> F-statistic:  3392 on 1 and 253 DF,  p-value: < 2.2e-16
 lines(c(0,120),c(0,120))

 # statistical table ####
 adj.r.squared <- c(lm.all$adj.r.squared,lm.broad$adj.r.squared,lm.conif$adj.r.squared)
 P <- c(lm.all$coefficients[, "Pr(>|t|)"],lm.broad$coefficients[, "Pr(>|t|)"],lm.conif$coefficients[, "Pr(>|t|)"])
 data.frame(t(DBH_cah_abc),adj.r.squared,P)
#>                    a       b        c adj.r.squared             P
#> all          1.18000 0.20070  0.89870     0.9266188  0.000000e+00
#> broadleaved 11.60134 0.35335 -0.01609     0.9303105 1.443494e-148
#> conifer      1.78620 0.25720  0.75370     0.9570466 9.651586e-224

Relationship between DBH and tree height (Chapman-Richards model)


## data setting ####
# paremeters of Relationship between DBH and tree height (Chapman-Richards model) 
abc <- TreeHeight_CR_abc
# DBH and tree height(k123_field)
d. <- data.frame(subset(k123_field,!is.na(h_drn)))
d. <- subset(k123_field,!is.na(h_drn))
d.$conif<-d.$conif==1
# Figure
ggplot(d.,aes(x=dbh,y=h_drn,color=conif))+
  geom_point(aes(color=conif),size=2)+
  scale_shape_manual(c(1,2))+
  scale_color_manual(values =c("black","red"))+
  
  ggtitle("Relationship between DBH and tree height (Chapman-Richards model)")+
  theme(plot.title = element_text(size=15,hjust = 0.5))+
  labs(x = expression("Diameter at Brest Height (cm)"),
       y =expression("Tree Height  (m)"))+
  theme(axis.text.x = element_text(size = 10),axis.title.x = element_text(size =15))+
  theme(axis.text.y = element_text(size = 10),axis.title.y = element_text(size =15))+
  
  stat_function(fun=function(dbh) 1.3+abc[1,1]*((1-exp(-abc[2,1]*dbh)^abc[3,1])),col="blue", lwd =2)+
  stat_function(fun=function(dbh) 1.3+abc[1,2]*((1-exp(-abc[2,2]*dbh)^abc[3,2])),col="black", lwd =1,lty=2)+
  stat_function(fun=function(dbh) 1.3+abc[1,3]*((1-exp(-abc[2,3]*dbh)^abc[3,3])),col="red", lwd =1,lty=2)+
  geom_segment(x=70, y=20, xend=80, yend=20,col="blue", lwd =2)+
  geom_segment(x=70, y=16, xend=80, yend=16,col="black", lwd =1,lty=2)+
  geom_segment(x=70, y=12, xend=80, yend=12,col="red", lwd =1,lty=2)+
  annotate("text", x = 90, y = 20, label ="All tree species",size=5,col="blue")+
  annotate("text", x = 90, y = 16, label ="Broadleaved",size=5,col="black")+
  annotate("text", x = 90, y = 12, label ="Conifer",size=5,col="red")+
  theme(legend.position = "none")