Skip to content

Commit

Permalink
fix bug of opgd model
Browse files Browse the repository at this point in the history
  • Loading branch information
@SpatLyu
SpatLyu committed Jun 7, 2024
1 parent 4978b07 commit 0461fc0
Show file tree
Hide file tree
Showing 6 changed files with 77 additions and 154 deletions.
4 changes: 2 additions & 2 deletions R/opgd.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -34,7 +34,7 @@
#' fvc = as_tibble(terra::as.data.frame(fvc,na.rm = T))
#' opgd(fvc ~ ., data = fvc,
#' discvar = names(select(fvc,-c(fvc,lulc))),
#' cores = 6, type =c(`factor`,`interaction`))
#' cores = 6, type =c('factor','interaction'))
#' }
opgd = \(formula,data,discvar,discnum = NULL,discmethod = NULL,
cores = 1,type = 'factor',alpha = 0.95,...){
Expand All @@ -55,7 +55,7 @@ opgd = \(formula,data,discvar,discnum = NULL,discmethod = NULL,
res = vector("list", length(type))
for (i in seq_along(type)){
res[[i]] = gd(paste0(yname,' ~ .'),data = newdata,
type = i,alpha = alpha)
type = type[i],alpha = alpha)
}
}

Expand Down
8 changes: 4 additions & 4 deletions README.Rmd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -56,12 +56,12 @@ head(fvc)

```{r}
tictoc::tic()
g = gd_bestunidisc(fvc ~ .,data = select(fvc,-lulc),discnum = 2:15,cores = 6)
fvc_gd = opgd(fvc ~ .,data = fvc,
discvar = names(select(fvc,-c(fvc,lulc))),
cores = 6, type = 'factor')
tictoc::toc()
```

```{r}
new.fvc = bind_cols(select(fvc,fvc,lulc),g$disv)
gd(fvc ~ .,data = new.fvc,type = 'factor')
gd(fvc ~ .,data = new.fvc,type = 'interaction')
fvc_gd
```
99 changes: 12 additions & 87 deletions README.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -23,7 +23,7 @@ devtools::install_github("SpatLyu/gdverse",build_vignettes = T,dep = T)

or install `gdverse` from `r-universe`:

```r
``` r
install.packages('gdverse', repos='https://spatlyu.r-universe.dev')
```

Expand Down Expand Up @@ -54,106 +54,31 @@ head(fvc)

``` r
tictoc::tic()
g = gd_bestunidisc(fvc ~ .,data = select(fvc,-lulc),discnum = 2:15,cores = 6)
fvc_gd = opgd(fvc ~ .,data = fvc,
discvar = names(select(fvc,-c(fvc,lulc))),
cores = 6, type = 'factor')
tictoc::toc()
## 14.33 sec elapsed
## 14.63 sec elapsed
```

``` r
new.fvc = bind_cols(select(fvc,fvc,lulc),g$disv)
gd(fvc ~ .,data = new.fvc,type = 'factor')
fvc_gd
## Spatial Stratified Heterogeneity Test
##
## Factor detector
```

| variable | Q-statistic | P-value |
|:--------:|:-----------:|:---------:|
| presum | 0.6395 | 9.278e-10 |
| presum | 0.6413 | 4.059e-10 |
| lulc | 0.5533 | 9.106e-10 |
| premin | 0.4434 | 8.652e-10 |
| tmpmin | 0.401 | 8.888e-10 |
| premin | 0.443 | 6.77e-10 |
| tmpmin | 0.4065 | 4.706e-10 |
| tmpmax | 0.2284 | 5.111e-10 |
| elev | 0.209 | 1.5e-10 |
| tmpavg | 0.197 | 6.833e-10 |
| slope | 0.1928 | 8.815e-10 |
| tmpavg | 0.1965 | 3.906e-10 |
| slope | 0.1936 | 8.571e-10 |
| pop | 0.1856 | 3.221e-10 |
| premax | 0.1341 | 8.861e-10 |
| ntl | 0.02171 | 6.162e-10 |
| ntl | 0.0213 | 8.522e-10 |
| aspect | 0.00741 | 5.448e-10 |

``` r
gd(fvc ~ .,data = new.fvc,type = 'interaction')
## Spatial Stratified Heterogeneity Test
##
## Interaction detector
```

| Interactive variable | Interaction |
|:--------------------:|:------------------:|
| lulc ∩ aspect | Enhance, nonlinear |
| lulc ∩ elev | Enhance, bi- |
| lulc ∩ ntl | Enhance, nonlinear |
| lulc ∩ pop | Enhance, bi- |
| lulc ∩ premax | Enhance, bi- |
| lulc ∩ premin | Enhance, bi- |
| lulc ∩ presum | Enhance, bi- |
| lulc ∩ slope | Enhance, bi- |
| lulc ∩ tmpavg | Enhance, bi- |
| lulc ∩ tmpmax | Enhance, bi- |
| lulc ∩ tmpmin | Enhance, bi- |
| aspect ∩ elev | Enhance, nonlinear |
| aspect ∩ ntl | Enhance, nonlinear |
| aspect ∩ pop | Enhance, nonlinear |
| aspect ∩ premax | Enhance, nonlinear |
| aspect ∩ premin | Enhance, nonlinear |
| aspect ∩ presum | Weaken, uni- |
| aspect ∩ slope | Enhance, nonlinear |
| aspect ∩ tmpavg | Enhance, nonlinear |
| aspect ∩ tmpmax | Enhance, nonlinear |
| aspect ∩ tmpmin | Enhance, nonlinear |
| elev ∩ ntl | Enhance, nonlinear |
| elev ∩ pop | Enhance, bi- |
| elev ∩ premax | Enhance, nonlinear |
| elev ∩ premin | Enhance, bi- |
| elev ∩ presum | Enhance, bi- |
| elev ∩ slope | Enhance, bi- |
| elev ∩ tmpavg | Enhance, bi- |
| elev ∩ tmpmax | Enhance, nonlinear |
| elev ∩ tmpmin | Enhance, bi- |
| ntl ∩ pop | Enhance, nonlinear |
| ntl ∩ premax | Enhance, nonlinear |
| ntl ∩ premin | Enhance, nonlinear |
| ntl ∩ presum | Enhance, nonlinear |
| ntl ∩ slope | Enhance, nonlinear |
| ntl ∩ tmpavg | Enhance, nonlinear |
| ntl ∩ tmpmax | Enhance, nonlinear |
| ntl ∩ tmpmin | Enhance, nonlinear |
| pop ∩ premax | Enhance, nonlinear |
| pop ∩ premin | Enhance, bi- |
| pop ∩ presum | Enhance, bi- |
| pop ∩ slope | Enhance, bi- |
| pop ∩ tmpavg | Enhance, nonlinear |
| pop ∩ tmpmax | Enhance, nonlinear |
| pop ∩ tmpmin | Enhance, bi- |
| premax ∩ premin | Enhance, nonlinear |
| premax ∩ presum | Enhance, bi- |
| premax ∩ slope | Enhance, nonlinear |
| premax ∩ tmpavg | Enhance, nonlinear |
| premax ∩ tmpmax | Enhance, nonlinear |
| premax ∩ tmpmin | Enhance, nonlinear |
| premin ∩ presum | Enhance, bi- |
| premin ∩ slope | Enhance, bi- |
| premin ∩ tmpavg | Enhance, bi- |
| premin ∩ tmpmax | Enhance, bi- |
| premin ∩ tmpmin | Enhance, bi- |
| presum ∩ slope | Enhance, bi- |
| presum ∩ tmpavg | Enhance, bi- |
| presum ∩ tmpmax | Enhance, bi- |
| presum ∩ tmpmin | Enhance, bi- |
| slope ∩ tmpavg | Enhance, bi- |
| slope ∩ tmpmax | Enhance, bi- |
| slope ∩ tmpmin | Enhance, bi- |
| tmpavg ∩ tmpmax | Enhance, nonlinear |
| tmpavg ∩ tmpmin | Enhance, nonlinear |
| tmpmax ∩ tmpmin | Enhance, nonlinear |
2 changes: 1 addition & 1 deletion man/opgd.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

116 changes: 57 additions & 59 deletions vignettes/OPGD.Rmd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -33,8 +33,8 @@ fvc

``` r
names(fvc)
## [1] "fvc" "premax" "premin" "presum" "tmpmax" "tmpmin" "tmpavg" "pop"
## [9] "ntl" "lulc" "elev" "slope" "aspect"
## [1] "fvc" "premax" "premin" "presum" "tmpmax" "tmpmin" "tmpavg" "pop" "ntl"
## [10] "lulc" "elev" "slope" "aspect"
```

### Convert data from `SpatRaster` to `tibble`
Expand All @@ -44,15 +44,14 @@ names(fvc)
fvc = as_tibble(terra::as.data.frame(fvc,na.rm = T))
head(fvc)
## # A tibble: 6 × 13
## fvc premax premin presum tmpmax tmpmin tmpavg pop ntl lulc elev
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.198 163. 7.95 3956. 20.8 -7.53 8.05 1.90 6.60 10 1758.
## 2 0.193 161. 6.80 3892. 20.7 -7.55 8.02 1.20 4.91 10 1754.
## 3 0.192 160. 5.24 3842. 20.9 -7.48 8.15 0.547 3.75 10 1722.
## 4 0.189 159. 5 3808. 21.1 -7.39 8.35 0.542 3.99 10 1672.
## 5 0.208 164. 9.98 4051. 20.6 -7.59 7.97 10.4 7.10 10 1780.
## 6 0.196 163. 8.15 3973. 20.7 -7.53 8.03 9.31 6.56 10 1755.
## # ℹ 2 more variables: slope <dbl>, aspect <dbl>
## fvc premax premin presum tmpmax tmpmin tmpavg pop ntl lulc elev slope aspect
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.198 163. 7.95 3956. 20.8 -7.53 8.05 1.90 6.60 10 1758. 2.65 176.
## 2 0.193 161. 6.80 3892. 20.7 -7.55 8.02 1.20 4.91 10 1754. 3.45 170.
## 3 0.192 160. 5.24 3842. 20.9 -7.48 8.15 0.547 3.75 10 1722. 3.96 139.
## 4 0.189 159. 5 3808. 21.1 -7.39 8.35 0.542 3.99 10 1672. 2.90 111.
## 5 0.208 164. 9.98 4051. 20.6 -7.59 7.97 10.4 7.10 10 1780. 1.94 99.5
## 6 0.196 163. 8.15 3973. 20.7 -7.53 8.03 9.31 6.56 10 1755. 3.01 99.6
```

### Determine optimal discretization parameters
Expand All @@ -65,37 +64,37 @@ We can use `gd_bestunidisc` to discretize them based on geodetector q-statistic.
tictoc::tic()
g = gd_bestunidisc(fvc ~ .,data = select(fvc,-lulc),discnum = 2:15,cores = 6)
tictoc::toc()
## 17.28 sec elapsed
## 14.83 sec elapsed
```


``` r
g
## $x
## [1] "aspect" "elev" "ntl" "pop" "premax" "premin" "presum" "slope"
## [9] "tmpavg" "tmpmax" "tmpmin"
## [1] "aspect" "elev" "ntl" "pop" "premax" "premin" "presum" "slope" "tmpavg"
## [10] "tmpmax" "tmpmin"
##
## $k
## [1] 15 15 15 15 15 13 15 13 15 15 15
## [1] 15 15 15 15 15 14 15 13 15 15 15
##
## $method
## [1] "equal" "quantile" "fisher" "quantile" "quantile" "fisher"
## [7] "fisher" "fisher" "fisher" "quantile" "fisher"
## [1] "equal" "quantile" "fisher" "quantile" "fisher" "fisher" "fisher"
## [8] "fisher" "quantile" "quantile" "fisher"
##
## $disv
## # A tibble: 136,243 × 11
## aspect elev ntl pop premax premin presum slope tmpavg tmpmax tmpmin
## <int> <int> <int> <int> <int> <int> <int> <int> <int> <int> <int>
## 1 8 12 3 1 9 1 1 4 6 8 2
## 2 8 12 2 1 8 1 1 5 6 8 2
## 3 6 12 2 1 8 1 1 6 6 9 2
## 4 5 12 2 1 8 1 1 4 7 10 2
## 5 5 13 3 4 9 2 1 3 6 8 2
## 6 5 12 3 3 9 1 1 4 6 8 2
## 7 6 12 2 1 8 1 1 6 6 9 2
## 8 7 12 2 1 8 1 1 5 7 10 2
## 9 8 12 2 1 8 1 1 3 7 10 2
## 10 7 12 3 1 8 1 1 4 7 10 2
## 1 8 12 3 1 7 1 1 4 4 8 2
## 2 8 12 2 1 7 1 1 5 4 8 2
## 3 6 12 2 1 7 1 1 6 4 9 2
## 4 5 12 2 1 7 1 1 4 5 10 2
## 5 5 13 3 4 8 2 1 3 4 8 2
## 6 5 12 3 3 7 2 1 4 4 8 2
## 7 6 12 2 1 7 1 1 6 4 9 2
## 8 7 12 2 1 7 1 1 5 5 10 2
## 9 8 12 2 1 7 1 1 3 5 10 2
## 10 7 12 3 1 7 1 1 4 5 10 2
## # ℹ 136,233 more rows
```

Expand All @@ -105,16 +104,16 @@ new.fvc
## # A tibble: 136,243 × 11
## aspect elev ntl pop premax premin presum slope tmpavg tmpmax tmpmin
## <int> <int> <int> <int> <int> <int> <int> <int> <int> <int> <int>
## 1 8 12 3 1 9 1 1 4 6 8 2
## 2 8 12 2 1 8 1 1 5 6 8 2
## 3 6 12 2 1 8 1 1 6 6 9 2
## 4 5 12 2 1 8 1 1 4 7 10 2
## 5 5 13 3 4 9 2 1 3 6 8 2
## 6 5 12 3 3 9 1 1 4 6 8 2
## 7 6 12 2 1 8 1 1 6 6 9 2
## 8 7 12 2 1 8 1 1 5 7 10 2
## 9 8 12 2 1 8 1 1 3 7 10 2
## 10 7 12 3 1 8 1 1 4 7 10 2
## 1 8 12 3 1 7 1 1 4 4 8 2
## 2 8 12 2 1 7 1 1 5 4 8 2
## 3 6 12 2 1 7 1 1 6 4 9 2
## 4 5 12 2 1 7 1 1 4 5 10 2
## 5 5 13 3 4 8 2 1 3 4 8 2
## 6 5 12 3 3 7 2 1 4 4 8 2
## 7 6 12 2 1 7 1 1 6 4 9 2
## 8 7 12 2 1 7 1 1 5 5 10 2
## 9 8 12 2 1 7 1 1 3 5 10 2
## 10 7 12 3 1 7 1 1 4 5 10 2
## # ℹ 136,233 more rows
```

Expand All @@ -125,20 +124,19 @@ The `new.fvc` is the discrete result of the optimal discretization parameter ba
new.fvc = bind_cols(select(fvc,fvc,lulc),new.fvc)
new.fvc
## # A tibble: 136,243 × 13
## fvc lulc aspect elev ntl pop premax premin presum slope tmpavg
## <dbl> <dbl> <int> <int> <int> <int> <int> <int> <int> <int> <int>
## 1 0.198 10 8 12 3 1 9 1 1 4 6
## 2 0.193 10 8 12 2 1 8 1 1 5 6
## 3 0.192 10 6 12 2 1 8 1 1 6 6
## 4 0.189 10 5 12 2 1 8 1 1 4 7
## 5 0.208 10 5 13 3 4 9 2 1 3 6
## 6 0.196 10 5 12 3 3 9 1 1 4 6
## 7 0.191 10 6 12 2 1 8 1 1 6 6
## 8 0.185 10 7 12 2 1 8 1 1 5 7
## 9 0.174 10 8 12 2 1 8 1 1 3 7
## 10 0.166 10 7 12 3 1 8 1 1 4 7
## fvc lulc aspect elev ntl pop premax premin presum slope tmpavg tmpmax tmpmin
## <dbl> <dbl> <int> <int> <int> <int> <int> <int> <int> <int> <int> <int> <int>
## 1 0.198 10 8 12 3 1 7 1 1 4 4 8 2
## 2 0.193 10 8 12 2 1 7 1 1 5 4 8 2
## 3 0.192 10 6 12 2 1 7 1 1 6 4 9 2
## 4 0.189 10 5 12 2 1 7 1 1 4 5 10 2
## 5 0.208 10 5 13 3 4 8 2 1 3 4 8 2
## 6 0.196 10 5 12 3 3 7 2 1 4 4 8 2
## 7 0.191 10 6 12 2 1 7 1 1 6 4 9 2
## 8 0.185 10 7 12 2 1 7 1 1 5 5 10 2
## 9 0.174 10 8 12 2 1 7 1 1 3 5 10 2
## 10 0.166 10 7 12 3 1 7 1 1 4 5 10 2
## # ℹ 136,233 more rows
## # ℹ 2 more variables: tmpmax <int>, tmpmin <int>
```

### Run geodetector
Expand All @@ -157,25 +155,25 @@ gd(fvc ~ .,data = new.fvc,type = 'factor')
------------------------------------
variable Q-statistic P-value
---------- ------------- -----------
presum 0.6413 4.059e-10
presum 0.642 8.298e-10

lulc 0.5533 9.106e-10

premin 0.4434 8.652e-10
premin 0.4422 6.921e-10

tmpmin 0.4065 4.706e-10

tmpmax 0.2284 5.111e-10

elev 0.209 1.5e-10

tmpavg 0.1965 3.906e-10
tmpavg 0.197 6.833e-10

slope 0.1928 8.815e-10
slope 0.1942 5.872e-10

pop 0.1856 3.221e-10

premax 0.1341 8.861e-10
premax 0.1333 1.891e-10

ntl 0.02171 6.162e-10

Expand Down Expand Up @@ -336,14 +334,14 @@ gd(fvc ~ .,data = new.fvc,type = 'interaction')
``` r
fvc_gd = opgd(fvc ~ .,data = fvc,
discvar = names(select(fvc,-c(fvc,lulc))),
cores = 6, type = c(`factor`,`interaction`))
cores = 6, type = c('factor','interaction'))
str(fvc_gd)
## List of 2
## $ :List of 1
## ..$ factor: tibble [12 × 3] (S3: tbl_df/tbl/data.frame)
## .. ..$ variable : chr [1:12] "presum" "lulc" "premin" "tmpmin" ...
## .. ..$ Q-statistic: num [1:12] 0.642 0.553 0.443 0.403 0.228 ...
## .. ..$ P-value : num [1:12] 8.30e-10 9.11e-10 8.56e-10 4.82e-10 5.11e-10 ...
## .. ..$ Q-statistic: num [1:12] 0.642 0.553 0.443 0.406 0.228 ...
## .. ..$ P-value : num [1:12] 8.30e-10 9.11e-10 8.56e-10 4.71e-10 5.11e-10 ...
## ..- attr(*, "class")= chr "factor_detector"
## $ :List of 1
## ..$ interaction: tibble [66 × 6] (S3: tbl_df/tbl/data.frame)
Expand Down Expand Up @@ -373,7 +371,7 @@ fvc_gd[[1]]

premin 0.443 8.559e-10

tmpmin 0.4027 4.824e-10
tmpmin 0.4065 4.706e-10

tmpmax 0.2284 5.111e-10

Expand Down
2 changes: 1 addition & 1 deletion vignettes/OPGD.Rmd.orig
View file
Original file line number Diff line number Diff line change
Expand Up @@ -76,7 +76,7 @@ gd(fvc ~ .,data = new.fvc,type = 'interaction')
```{r}
fvc_gd = opgd(fvc ~ .,data = fvc,
discvar = names(select(fvc,-c(fvc,lulc))),
cores = 6, type = c(`factor`,`interaction`))
cores = 6, type = c('factor','interaction'))
str(fvc_gd)
fvc_gd[[1]]
fvc_gd[[2]]
Expand Down

0 comments on commit 0461fc0

Please sign in to comment.