Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions .Rbuildignore
Original file line number Diff line number Diff line change
Expand Up @@ -5,3 +5,4 @@
^docs$
^pkgdown$
^cran-comments\.md$
^build-vignettes\.md$
1 change: 1 addition & 0 deletions .gitignore
Original file line number Diff line number Diff line change
Expand Up @@ -5,3 +5,4 @@
.DS_Store
.quarto
docs
inst/doc
5 changes: 5 additions & 0 deletions DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -17,10 +17,15 @@ LinkingTo:
Rcpp,
RcppThread
Suggests:
gdverse,
infoxtr,
knitr,
pc,
Rcpp,
RcppThread,
rmarkdown,
sdsfun,
spEDM
VignetteBuilder: knitr
Config/roxygen2/markdown: TRUE
Config/roxygen2/version: 8.0.0
8 changes: 4 additions & 4 deletions _pkgdown.yml
Original file line number Diff line number Diff line change
Expand Up @@ -11,10 +11,10 @@ navbar:
bg: custom
components:
articles:
# text: Vignettes
# menu:
# - text: Coupling Coordination Degree Models
# href: articles/ccd.html
text: Vignettes
menu:
- text: Coupling Coordination Degree Model and Metacoupling Analysis
href: articles/ccd.html

home:
title: |
Expand Down
9 changes: 9 additions & 0 deletions build-vignettes.md
Original file line number Diff line number Diff line change
@@ -0,0 +1,9 @@
``` r
.prebuild_vignettes = \(name){
out = paste0("vignettes/",name,".Rmd")
inp = paste0(out,".orig")
knitr::knit(inp,out)
}

.prebuild_vignettes("ccd")
```
Binary file added man/figures/ccd/fig_ccd-1.png
Loading
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
Binary file added man/figures/ccd/fig_metacoupling-1.png
Loading
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
2 changes: 2 additions & 0 deletions vignettes/.gitignore
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
*.html
*.R
269 changes: 269 additions & 0 deletions vignettes/ccd.Rmd
Original file line number Diff line number Diff line change
@@ -0,0 +1,269 @@
---
title: "Coupling Coordination Degree Model and Metacoupling Analysis"
author: "Wenbo Lyu"
date: |
| Last update: 2026-05-12
| Last run: `r Sys.Date()`
output: rmarkdown::html_vignette
vignette: >
%\VignetteIndexEntry{ccd}
%\VignetteEngine{knitr::rmarkdown}
%\VignetteEncoding{UTF-8}
---



# Introduction

The **Coupling Coordination Degree (CCD) model** is widely used to quantify the degree of coupling and coordinated development among multiple subsystems. Originating from physics, it has been extensively applied in regional and human–environment systems.

## Coupling Degree

Given *n* normalized subsystem indicators $U_i$, the standard coupling degree $C$ is defined as:

$$
C = \left[ \frac{\prod_{i=1}^{n} U_i}{\left( \frac{1}{n} \sum_{i=1}^{n} U_i \right)^n} \right]^{\frac{1}{n}}
$$

Although widely used, this formulation may suffer from **scale sensitivity and over-amplification effects** due to the power structure. To address these issues, several formulations have been proposed by modifying the functional form of the coupling degree.

## Modified Coupling Degree

### Modification by $\text{wang et al}^{[1]}$.

**First**, Wang et al. introduce a formulation that incorporates pairwise differences among subsystems while normalizing their relative magnitudes:

$$
C = \sqrt{\left[1-\frac{\sum\limits_{i>j,j=1}^{n-1} \sqrt{\left(U_i-U_j\right)^2}}{\sum_{m=1}^{n-1}m}\right] \times \left(\prod_{i=1}^n \frac{U_i}{\text{max} U_i}\right)^{\frac{1}{n-1}}}
$$

### Modification by $\text{fan et al}^{[2]}$.

**Alternatively**, Fan et al. propose a simplified structure derived from variance-like dispersion, which directly captures the imbalance among subsystem indicators:

$$
C = 1-2\sqrt{\frac{n\sum_{i=1}^n U_i^2 - \left(\sum_{i=1}^n U_i\right)^2}{n^2}}
$$

## Comprehensive Development Index

The overall development level is defined as:

$$
T = \sum_{i=1}^{n} \alpha_i U_i
$$

where $\alpha_i$ are weights with $\sum \alpha_i = 1$.

## Coordination Degree

The coordination degree $D$ integrates interaction $C$ and development $T$:

$$
D = \sqrt{C \times T}
$$

where
- $C$ measures coupling degree
- $T$ measures development level
- $D$ reflects coordinated development

## Metacoupling Perspective

The CCD framework can be extended under the $\text{metacoupling framework}^{[3,4]}$, distinguishing:

- **Intracoupling**
- **Pericoupling**
- **Telecoupling**

This enables cross-scale analysis of coupling.

# Example Cases

## Install necessary packages and load data


``` r
install.packages(c("sdsfun", "coupling", "tidyr", "dplyr", "ggplot2"), dep = TRUE)
```

The `gzma` dataset represents the *Data of Social Space Quality in Guangzhou Metropolitan Areas of China (2010)*. It contains multiple indicators describing urban social space conditions. In particular, four key variables correspond to subsystem scores, including population stability (`PS_Score`), educational level (`EL_Score`), occupational hierarchy (`OH_Score`), and income level (`IL_Score `).

Load the `gzma` dataset from the `sdsfun` package:


``` r
gzma = sf::read_sf(system.file('extdata/gzma.gpkg',package = 'sdsfun'))
gzma
## Simple feature collection with 118 features and 4 fields
## Geometry type: POLYGON
## Dimension: XY
## Bounding box: xmin: 113.1485 ymin: 22.94659 xmax: 113.5628 ymax: 23.33026
## Geodetic CRS: WGS 84
## # A tibble: 118 × 5
## PS_Score EL_Score OH_Score IL_Score geom
## <dbl> <dbl> <dbl> <dbl> <POLYGON [°]>
## 1 7.21 4.64 4.75 2.64 ((113.2797 23.13359, 113.2715 23.13413, 113.2682 23.13371, …
## 2 3.55 3.81 3.91 4.06 ((113.2519 23.15353, 113.2497 23.15545, 113.254 23.15774, 1…
## 3 7.94 4.69 4.86 3.31 ((113.2815 23.12902, 113.2749 23.12969, 113.2732 23.12523, …
## 4 8.22 4.93 4.92 3.74 ((113.3098 23.12458, 113.3046 23.12448, 113.3026 23.12642, …
## 5 7.84 4.74 4.98 4.69 ((113.3099 23.11566, 113.3087 23.11542, 113.2957 23.11531, …
## 6 8.12 5.13 4.98 3.92 ((113.2864 23.13354, 113.2863 23.135, 113.2884 23.1375, 113…
## 7 8.30 5.18 4.87 3.77 ((113.2797 23.13359, 113.2799 23.13956, 113.274 23.14182, 1…
## 8 5.14 4.43 4.41 4.13 ((113.3013 23.16168, 113.2985 23.16208, 113.296 23.16051, 1…
## 9 5.92 4.18 4.37 2.29 ((113.2631 23.12832, 113.2586 23.12813, 113.2592 23.12228, …
## 10 6.99 4.32 4.24 2.72 ((113.2747 23.12164, 113.2727 23.12362, 113.2732 23.12523, …
## # ℹ 108 more rows
```

Normalize the `*_Score` columns:


``` r
dt = apply(sf::st_drop_geometry(gzma), 2,
\(.x) (.x - min(.x)) / (max(.x) - min(.x)))
head(dt)
## PS_Score EL_Score OH_Score IL_Score
## 1 0.8179733 0.3246648 0.6590316 0.1308531
## 2 0.3020233 0.1318888 0.4046987 0.5173794
## 3 0.9209903 0.3353516 0.6921477 0.3141320
## 4 0.9604095 0.3914758 0.7099999 0.4316421
## 5 0.9061589 0.3473603 0.7297774 0.6909494
## 6 0.9456379 0.4391423 0.7304117 0.4792905
```

## Analysis of coupling coordination degree


``` r
ccd_standard = coupling::ccd(dt)
head(ccd_standard)
## C D
## 1 0.8051958 0.6237105
## 2 0.8914577 0.5497290
## 3 0.8999423 0.7134825
## 4 0.9346128 0.7632959
## 5 0.9440912 0.7944703
## 6 0.9519923 0.7858001
```


``` r
ccd_wang = coupling::ccd(dt, method = "wang")
head(ccd_wang)
## C D
## 1 0.4722274 0.4776480
## 2 0.6211236 0.4588675
## 3 0.5375842 0.5514412
## 4 0.5861986 0.6045044
## 5 0.6640321 0.6662930
## 6 0.6319211 0.6402164
```


``` r
ccd_fan = coupling::ccd(dt, method = "fan")
head(ccd_fan)
## C D
## 1 0.4593785 0.4711049
## 2 0.7164548 0.4928249
## 3 0.4915051 0.5272784
## 4 0.5399620 0.5801746
## 5 0.5951898 0.6308098
## 6 0.5907777 0.6190239
```


``` r
ccd_df = do.call(cbind, list(ccd_standard, ccd_wang, ccd_fan))
names(ccd_df) = paste0(rep(c("standard", "wang", "fan"), each = 2),
"_", rep(c("C", "D"), times = 3))
fig1 = ccd_df |>
sf::st_set_geometry(sf::st_geometry(gzma)) |>
tidyr::pivot_longer(-geometry, names_to = "var", values_to = "val") |>
dplyr::mutate(var = factor(var, levels = names(ccd_df))) |>
ggplot2::ggplot() +
ggplot2::geom_sf(ggplot2::aes(fill = val), color = "grey40", lwd = 0.15) +
ggplot2::scale_fill_gradientn(
name = "degree",
colors = c("#ffffcc", "#d9f0a3", "#addd8e",
"#78c679", "#31a354", "#006837")
) +
ggplot2::facet_wrap(~var, ncol = 2) +
ggplot2::theme_bw(base_family = "serif") +
ggplot2::theme(
panel.grid = ggplot2::element_blank(),
axis.text = ggplot2::element_blank(),
axis.ticks = ggplot2::element_blank(),
strip.text = ggplot2::element_text(face = "bold", size = 15),
legend.title = ggplot2::element_text(size = 16.5),
legend.text = ggplot2::element_text(size = 15)
)
fig1
```

![**Figure 1**. Spatial distribution of CCD components across three estimation methods. Panels display component C and component D derived from the standard, Wang, and Fan methods, respectively.](../man/figures/ccd/fig_ccd-1.png)

## A Meta-Coupling Analysis

Due to data limitations, here we focus on **peri-coupling** based on a Queen contiguity structure. Pericoupling among neighboring units are further weighted using an inverse distance scheme. The calculation of the coupling coordination degree adopts the formulation proposed by $\text{wang et al}^{[1]}$.


``` r
nb = sdsfun::spdep_nb(gzma)
swm_peri = sdsfun::inverse_distance_swm(gzma)
for (i in seq_len(nrow(gzma))) {
swm_peri[i, seq_len(nrow(gzma))[-nb[[i]]]] = 0
}
swm_peri = apply(swm_peri, 1, \(.x) .x / sum(.x))

mc_wang = coupling::metacoupling(dt, swm_peri = swm_peri, method = "wang")
head(mc_wang)
## Intra_C Intra_D Peri_C Peri_D Tele_C Tele_D
## 1 0.4722274 0.4776480 0.7414392 0.7507625 0 0
## 2 0.6211236 0.4588675 0.6712215 0.5061883 0 0
## 3 0.5375842 0.5514412 0.4539894 0.4644758 0 0
## 4 0.5861986 0.6045044 0.6692548 0.6808108 0 0
## 5 0.6640321 0.6662930 0.6880871 0.6870927 0 0
## 6 0.6319211 0.6402164 0.6064480 0.6032699 0 0
```


``` r
fig2 = mc_wang |>
dplyr::select(dplyr::all_of(c("Intra_C", "Intra_D", "Peri_C", "Peri_D"))) |>
sf::st_set_geometry(sf::st_geometry(gzma)) |>
tidyr::pivot_longer(-geometry, names_to = "var", values_to = "val") |>
dplyr::mutate(var = factor(var,
levels = c("Intra_C", "Intra_D", "Peri_C", "Peri_D"))) |>
ggplot2::ggplot() +
ggplot2::geom_sf(ggplot2::aes(fill = val), color = "grey40", lwd = 0.15) +
ggplot2::scale_fill_gradientn(
name = "degree",
colors = c("#ffffcc", "#d9f0a3", "#addd8e",
"#78c679", "#31a354", "#006837")
) +
ggplot2::facet_wrap(~var, ncol = 2) +
ggplot2::theme_bw(base_family = "serif") +
ggplot2::theme(
panel.grid = ggplot2::element_blank(),
axis.text = ggplot2::element_blank(),
axis.ticks = ggplot2::element_blank(),
strip.text = ggplot2::element_text(face = "bold", size = 15),
legend.title = ggplot2::element_text(size = 16.5),
legend.text = ggplot2::element_text(size = 15)
)
fig2
```

![**Figure 2**. Spatial distribution of intra- and pericoupling CCD components based on the Wang formulation. Panels display coupling degree (C) and coordination degree (D) for intra- and pericoupling, respectively.](../man/figures/ccd/fig_metacoupling-1.png)

## References

[1] Wang, S., Kong, W., Ren, L. and ZHI, D., 2021. Research on misuses and modification of coupling coordination degree model in China. Journal of Natural Resources, 36, 793-810. https://doi.org/10.31497/zrzyxb.20210319

[2] Fan, D., Ke, H. and Cao, R., 2024. Modification and improvement of coupling coordination degree model. Stat. Decis, 40, 41-46. https://doi.org/10.13546/j.cnki.tjyjc.2024.22.007

[3] Tang, P., Huang, J., Zhou, H., Fang, C., Zhan, Y., Huang, W., 2021. Local and telecoupling coordination degree model of urbanization and the eco-environment based on RS and GIS: A case study in the Wuhan urban agglomeration. Sustainable Cities and Society 75, 103405. https://doi.org/10.1016/j.scs.2021.103405

[4] Li, Y., Jia, N., Zheng, L., Yin, C., Chen, K., Sun, N., Jiang, A., Wang, M., Chen, R., Zhou, Z., 2026. A meta-coupling analysis between three-dimensional urbanization and ecosystem services in China’s urban agglomerations. Communications Earth & Environment 7. https://doi.org/10.1038/s43247-025-03047-w
Loading
Loading