├── README.md
├── SCR-function.R
├── data-generation.R
├── example-Baltimore.R
├── simdata1.RData
├── simdata2.RData
└── simulation.R


/README.md:
--------------------------------------------------------------------------------
 1 | # SCR: Spatially Clustered Regression
 2 | 
 3 | This repository provides R code implementing spatially clustered regression for spatial data analysis, as proposed by the following paper.
 4 | 
 5 | [Sugasawa, S. and Murakami, D. (2021). Spatially Clustered Regression. *Spatial Statistics* 44, 100525.](https://doi.org/10.1016/j.spasta.2021.100525)
 6 | (arXiv version: https://arxiv.org/abs/2011.01493)
 7 | 
 8 | The repository includes the following files.
 9 | 
10 | * SCR-function.R : Script implementing the proposed method
11 | * simulation.R : Script applying the proposed method to two simulated datasets 
12 | * simdata1.RData: Simulated data 1
13 | * simdata2.RData: Simulated data 2
14 | * data-generation.R: Script for generating the two simulated datasets
15 | * example-Boltimore.R: Script for applying SCR to Baltimore dataset (available from `spdep` package)
16 | 


--------------------------------------------------------------------------------
/SCR-function.R:
--------------------------------------------------------------------------------
  1 | ###-----------------------------------------------------###
  2 | ###  Functions for spatially clustered regression (SCR)  ###
  3 | ###-----------------------------------------------------###
  4 | ## This code implements the following two functions for SCR/SFCR
  5 | # 'SCR': SCR/SFCR with fixed G 
  6 | # 'SCR.select': tuning parameter (G) selection via BIC-type criteria
  7 | 
  8 | ## packages
  9 | library(SparseM)
 10 | library(MASS)
 11 | 
 12 | 
 13 | ###  Spatially clustered regression (with LASSO)   ###
 14 | ## Input
 15 | # Y: n-dimensional response vector 
 16 | # X: (n,p)-matrix of covariates (p: number of covariates)
 17 | # W: (n,n)-matrix of spatial weight
 18 | # Sp: (n,2)-matrix of location information 
 19 | # G: number of groups 
 20 | # Phi: tuning parameter for spatial similarity 
 21 | # offset: n-dimensional vector of offset term (applicable only to "poisson" and "NB")
 22 | # fuzzy: if True, SFCR is applied
 23 | # maxitr: maximum number of iterations
 24 | # family: distribution family ("gaussian", "poisson" or "NB)
 25 | 
 26 | ## Output
 27 | # Beta: (G,p)-matrix of group-wise regression coefficients
 28 | # Sig: G-dimensional vector of group-wise standard deviations (only for "gaussian" and "NB")
 29 | # group: n-dimensional vector of group assignment 
 30 | # sBeta: (n,p)-matrix of location-wise regression coefficients
 31 | # sSig: n-dimensional vector of location-wise standard deviations (only for "gaussian")
 32 | # s: n-dimensional vector of location-wise standard deviations (only for "gaussian")
 33 | # ML: maximum log-likelihood
 34 | # itr: number of iterations 
 35 | 
 36 | ## Remark
 37 | # matrix X should not include an intercept term
 38 | # initial grouping is determined by K-means of spatial locations
 39 | 
 40 | 
 41 | ## Main function 
 42 | SCR <- function(Y, X, W, Sp, G=5, Phi=1, offset=NULL, fuzzy=F, maxitr=100, delta=1, family="gaussian"){
 43 |   ## Preparations
 44 |   ep <- 10^(-5)      # convergence criterion 
 45 |   X <- as.matrix(X)
 46 |   n <- dim(X)[1]     # number of samples
 47 |   p <- dim(X)[2]+1    # number of regression coefficients
 48 |   XX <- as.matrix( cbind(1,X) )
 49 |   W <- as(W, "sparseMatrix")
 50 |   if(is.null(offset)){ offset <- rep(0, n) }
 51 |   nmax <- function(x){ max(na.omit(x)) }   # new max function 
 52 |   
 53 |   ## Initial values
 54 |   M <- 20  # the number of initial values of k-means
 55 |   WSS <- c()
 56 |   CL <- list()
 57 |   for(k in 1:M){
 58 |     CL[[k]] <- kmeans(Sp, G)
 59 |     WSS[k] <- CL[[k]]$tot.withinss
 60 |   }
 61 |   Ind <- CL[[which.min(WSS)]]$cluster
 62 |   Pen <- rep(0, G)
 63 |   Beta <- matrix(0, p, G)
 64 |   dimnames(Beta)[[2]] <- paste0("G=",1:G)
 65 |   Sig <- rep(1, G)    # not needed under non-Gaussian case
 66 |   Nu <- rep(1, G) 
 67 |   
 68 |   ## iterative algorithm 
 69 |   val <- 0
 70 |   mval <- 0
 71 |   for(k in 1:maxitr){
 72 |     cval <- val
 73 |     
 74 |     ## penalty term
 75 |     Ind.mat <- matrix(0, n, G)
 76 |     for(g in 1:G){
 77 |       Ind.mat[Ind==g, g] <- 1
 78 |     }
 79 |     Ind.mat <- as(Ind.mat, "sparseMatrix")
 80 |     Pen <- W%*%Ind.mat     # penalty term
 81 |     
 82 |     ## model parameters (clustered case)
 83 |     if(fuzzy==F){
 84 |       for(g in 1:G){
 85 |         if(length(Ind[Ind==g])>p+1){
 86 |           # gaussian
 87 |           if(family=="gaussian"){
 88 |             fit <- lm(Y[Ind==g]~X[Ind==g,])
 89 |             Beta[,g] <- as.vector( coef(fit) )
 90 |             resid <- Y-as.vector(XX%*%Beta[,g])
 91 |             Sig[g] <- sqrt(mean(resid[Ind==g]^2))
 92 |             Sig[g] <- max(Sig[g], 0.1)
 93 |           }
 94 |           # poisson
 95 |           if(family=="poisson"){
 96 |             x <- X[Ind==g,]
 97 |             y <- Y[Ind==g]
 98 |             off <- offset[Ind==g]
 99 |             fit <- glm(y~x, offset=off, family="poisson")
100 |             Beta[,g] <- as.vector( coef(fit) )
101 |           }
102 |           # NB
103 |           if(family=="NB"){
104 |             x <- X[Ind==g,]
105 |             y <- Y[Ind==g]
106 |             off <- offset[Ind==g]
107 |             fit <- glm.nb(y~x+offset(off))
108 |             Beta[,g] <- as.vector( coef( fit ) )
109 |             Nu[g] <- fit$theta
110 |           }
111 |         }
112 |       }
113 |     }
114 |     
115 |     ## model parameters (fuzzy case)
116 |     if(fuzzy==T){
117 |       # Gaussian
118 |       if(family=="gaussian"){
119 |         Mu <- XX%*%Beta      # (n,G)-matrix
120 |         ESig <- t(matrix(rep(Sig,n), G, n))    # (n,G)-matrix
121 |         log.dens <- log(dnorm(Y,Mu,ESig)) + Phi*Pen
122 |         mval <- apply(log.dens, 1, max)
123 |         log.denom <- mval + log(apply(exp(log.dens-mval), 1, sum))
124 |         PP <- exp(log.dens-log.denom)     # weight
125 |         for(g in 1:G){ 
126 |           if(sum(PP[,g])>0.1){
127 |             fit <- lm(Y~X, weights=PP[,g])
128 |             Beta[,g] <- as.vector( coef(fit) )
129 |             resid <- Y-as.vector(XX%*%Beta[,g])
130 |             Sig[g] <- sqrt( sum(PP[,g]*resid^2)/sum(PP[,g]) )
131 |             Sig[g] <- max(Sig[g], 0.1)
132 |           }
133 |         }
134 |       }
135 |       
136 |       # Poisson
137 |       if(family=="poisson"){
138 |         Mu <- exp(offset + XX%*%Beta)    # (n,G)-matrix
139 |         log.dens <- log(dpois(Y, Mu)) + Phi*Pen 
140 |         mval <- apply(log.dens, 1, max)
141 |         log.denom <- mval + log(apply(exp(log.dens-mval), 1, sum))
142 |         PP <- exp(log.dens-log.denom)     # weight
143 |         for(g in 1:G){
144 |           if(sum(PP[,g])>0.1){
145 |             fit <- glm(Y~X, offset=offset, weights=PP[,g], family="poisson")
146 |             Beta[,g] <- as.vector( coef(fit) )
147 |           }
148 |         }
149 |       }
150 |       # NB
151 |       if(family=="NB"){
152 |         Mu <- exp(offset + XX%*%Beta)    # (n,G)-matrix
153 |         log.dens <- dnbinom(Y, size=Nu, prob=Nu/(Nu+Mu), log=T) + Phi*Pen 
154 |         mval <- apply(log.dens, 1, max)
155 |         log.denom <- mval + log(apply(exp(log.dens-mval), 1, sum))
156 |         PP <- exp(log.dens-log.denom)     # weight
157 |         for(g in 1:G){
158 |           if(sum(PP[,g])>0.1){
159 |             fit <- glm.nb(Y~X+offset(offset), weights=PP[,g])
160 |             Beta[,g] <- as.vector( coef(fit) )
161 |             Nu[g] <- fit$theta
162 |           }
163 |         }
164 |       }
165 |     }
166 |     
167 |     ## Grouping (clustered case)
168 |     if(fuzzy==F){
169 |       if(family=="gaussian"){
170 |         Mu <- XX%*%Beta      # (n,G)-matrix
171 |         ESig <- t(matrix(rep(Sig,n), G, n))    # (n,G)-matrix
172 |         Q <- dnorm(Y, Mu, ESig, log=T) + Phi*Pen     # penalized likelihood
173 |       }
174 |       if(family=="poisson"){ 
175 |         Mu <- exp(offset + XX%*%Beta) 
176 |         Q <- dpois(Y, Mu, log=T)  + Phi*Pen    # penalized likelihood
177 |       }
178 |       if(family=="NB"){ 
179 |         Mu <- exp(offset + XX%*%Beta) 
180 |         Q <- dnbinom(Y, size=Nu, prob=Nu/(Nu+Mu), log=T)  + Phi*Pen    # penalized likelihood
181 |       }
182 |       Ind <- apply(Q, 1, which.max)
183 |     }
184 |     
185 |     ## Grouping (fuzzy case)
186 |     if(fuzzy==T){
187 |       if(family=="gaussian"){
188 |         Mu <- XX%*%Beta      # (n,G)-matrix
189 |         ESig <- t(matrix(rep(Sig,n), G, n))    # (n,G)-matrix
190 |         Q <- delta*(dnorm(Y, Mu, ESig, log=T) + Phi*Pen)   # penalized likelihood
191 |         mval <- apply(Q, 1, max)
192 |         log.denom <- mval + log(apply(exp(Q-mval), 1, sum))
193 |         PP <- exp(Q-log.denom)
194 |       }
195 |       if(family=="poisson"){ 
196 |         Mu <- exp(offset + XX%*%Beta)    # (n,G)-matrix
197 |         Q <- delta*(dpois(Y, Mu, log=T)  + Phi*Pen)   # penalized likelihood
198 |         mval <- apply(Q, 1, max)
199 |         log.denom <- mval + log(apply(exp(Q-mval), 1, sum))
200 |         PP <- exp(Q-log.denom)
201 |       }
202 |       if(family=="NB"){ 
203 |         Mu <- exp(offset + XX%*%Beta)    # (n,G)-matrix
204 |         Q <- delta*(dnbinom(Y, size=Nu, prob=Nu/(Nu+Mu), log=T) + Phi*Pen)   # penalized likelihood
205 |         mval <- apply(Q, 1, max)
206 |         log.denom <- mval + log(apply(exp(Q-mval), 1, sum))
207 |         PP <- exp(Q-log.denom)
208 |       }
209 |       Ind <- apply(PP, 1, which.max)
210 |     }
211 |     
212 |     ## Value of objective function
213 |     val <- sum( apply(Q, 1, nmax) ) 
214 |     dd <- abs(cval-val)/abs(val)
215 |     mval <- max(mval, cval)
216 |     if( dd<ep | abs(mval-val)<ep ){ break }
217 |   }
218 |   
219 |   ## varying parameters
220 |   if(fuzzy==F){  sBeta <- t(Beta[,Ind]) }
221 |   if(fuzzy==T){  sBeta <- PP%*%t(Beta) }
222 |   sSig <- Sig[Ind]     # location-wise error variance
223 |   
224 | 
225 |   ## maximum likelihood 
226 |   if(family=="gaussian"){
227 |     hmu <- apply(XX*sBeta, 1, sum)
228 |     ML <- sum( dnorm(Y, hmu, sSig, log=T) ) 
229 |   }
230 |   if(family=="poisson"){
231 |     hmu <- exp(offset + apply(XX*sBeta, 1, sum))
232 |     ML <- sum( dpois(Y, hmu, log=T) ) 
233 |   }
234 |   if(family=="NB"){
235 |     sNu <- Nu[Ind]
236 |     hmu <- exp(offset + apply(XX*sBeta, 1, sum))
237 |     ML <- sum( dnbinom(Y, size=sNu, prob=sNu/(sNu+hmu), log=T) ) 
238 |   }
239 |   
240 |   ## Results
241 |   result <- list(Beta=Beta, Sig=Sig, Nu=Nu, group=Ind, sBeta=sBeta, sSig=sSig, ML=ML, itr=k)
242 |   return(result)
243 | }
244 | 
245 | 
246 | 
247 | 
248 | 
249 | 
250 | 
251 | 
252 | 
253 | 
254 | ###  Selection of tuning parameters  ###
255 | ## Imput
256 | # most of inputs are the same as 'SCR' 
257 | # G.set: vector of candidates for G
258 | # print: if True, interim progress is reported 
259 | 
260 | ## Output
261 | # BIC: BIC-type criteria
262 | # select: selection results 
263 | 
264 | ## Main function 
265 | SCR.select <- function(Y, X, W, Sp, G.set=NULL, Phi=1, offset=NULL, maxitr=50, print=T, family="gaussian"){
266 |   ## Preparations
267 |   if(is.null(G.set)){ G.set <- seq(10, 40, by=5) }
268 |   X <- as.matrix(X)
269 |   n <- dim(X)[1]
270 |   p <- dim(X)[2]+1
271 |   L <- length(G.set)
272 |   
273 |   ## computing information criteria
274 |   BIC <- c()
275 |   for(l in 1:L){
276 |     fit <- SCR(Y, X, W, Sp, offset=offset, G=G.set[l], Phi=Phi, maxitr=maxitr, family=family)
277 |     pp <- length(fit$Beta) 
278 |     if(family=="gaussian"| family=="NB"){ pp <- pp + G.set[l] }
279 |     BIC[l] <- -2*fit$ML + log(n)*pp
280 |     if(print){ print( paste0("G=",G.set[l], ", iteration=", fit$itr) ) }
281 |   }
282 |   names(BIC) <- paste0("G=", G.set)
283 |   
284 |   ## selection
285 |   hG <- G.set[which.min(BIC)]
286 | 
287 |   ## result
288 |   Result <- list(BIC=BIC, G=hG)
289 |   return(Result)
290 | }
291 | 
292 | 
293 | 


--------------------------------------------------------------------------------
/data-generation.R:
--------------------------------------------------------------------------------
 1 | ###-----------------------------------------------------###
 2 | ###   one-shot simulation experiment (data generation)  ###
 3 | ###-----------------------------------------------------###
 4 | set.seed(1)
 5 | 
 6 | library(MASS)
 7 | scenario <- 2   # 1 (clustered case) or 2 (smoothed case)
 8 | phi <- 0.6    # range parameter for covariates
 9 | n <- 1000   # sample size
10 | 
11 | 
12 | ##  generation of sampling locations
13 | Sp <- matrix(NA,n,2)
14 | for(i in 1:n){
15 |   dd <- 0
16 |   while(dd<(0.5^2)){
17 |     rn <- c(runif(1,-1,1),runif(1,0,2))
18 |     dd <- sum(rn[1]^2+0.5*rn[2]^2)
19 |   }
20 |   Sp[i,] <- rn
21 | }
22 | 
23 | 
24 | 
25 | ## covariates
26 | dd <- as.matrix(dist(Sp))
27 | mat <- exp(-dd/phi)
28 | 
29 | z1 <- mvrnorm(1, rep(0, n), mat)
30 | z2 <- mvrnorm(1, rep(0, n), mat)
31 | x1 <- z1
32 | rr <- 0.75
33 | x2 <- rr*z1 + sqrt(1-rr^2)*z2
34 | X <- cbind(x1,x2)
35 | 
36 | ## correlation matrix for regression coefficients
37 | V1 <- exp(-dd/1)
38 | V2 <- exp(-dd/2)
39 | V3 <- exp(-dd/3)
40 | 
41 | 
42 | ## Weight matrix for SCR
43 | DD <- as.matrix(dist(Sp))
44 | th <- 0.1
45 | W <- matrix(0, n, n)
46 | for(i in 1:n){
47 |   W[i,] <- ifelse(DD[i,]<th, 1, 0)
48 | }
49 | diag(W) <- 0
50 | 
51 | 
52 | 
53 | # Parameters (clustered case)
54 | if(scenario==1){
55 |   Beta0 <- c()
56 |   Beta1 <- c()
57 |   Beta2 <- c()
58 |   Sig <- c()
59 |   M1 <- 2
60 |   M2 <- 3
61 |   Grid1 <- seq(-1, 1, length=M1+1)
62 |   Grid2 <- seq(0, 2, length=M2+1)
63 |   for(k in 1:M1){
64 |     for(j in 1:M2){
65 |       Ind <- (1:n)[Grid1[k]<Sp[,1] & Sp[,1]<Grid1[k+1] & Grid2[j]<Sp[,2] & Sp[,2]<Grid2[j+1]]
66 |       Beta0[Ind] <- 2*(Grid1[k] + Grid2[j])
67 |       Beta1[Ind] <- (Grid1[k]^2 + Grid2[j]^2)
68 |       Beta2[Ind] <- -(Grid1[k] + Grid2[j])
69 |       Sig[Ind] <- 0.5 + 0.2*abs(Grid1[k] - Grid2[j])
70 |     }
71 |   }
72 |   Beta <- cbind(Beta0, Beta1, Beta2)
73 | }
74 | 
75 | 
76 | # Parameters (smoothed case)
77 | if(scenario==2){
78 |   Beta0 <- mvrnorm(1, rep(0,n), 2*V1)
79 |   Beta1 <- mvrnorm(1, rep(0,n), 2*V2)
80 |   Beta2 <- mvrnorm(1, rep(0,n), 2*V3)
81 |   Sig <- 0.2*exp(mvrnorm(1, rep(0,n), 0.5*V3))
82 |   Beta <- cbind(Beta0, Beta1, Beta2)
83 | }
84 | 
85 | 
86 | 
87 | 
88 | ## Data
89 | Mu <- apply(cbind(1,X)*Beta, 1, sum)
90 | Y <- rnorm(n, Mu, Sig)
91 | 
92 | 
93 | 
94 | ## save
95 | save(Y, X, W, DD, Sp, Beta, file=paste0("simdata", scenario, ".RData"))


--------------------------------------------------------------------------------
/example-Baltimore.R:
--------------------------------------------------------------------------------
 1 | ###   Example: Boltimore data   ###
 2 | rm(list=ls())
 3 | 
 4 | ## dataset
 5 | library(spdep)
 6 | library(spatialreg)
 7 | K <- 5    # number of nearest neighbour
 8 | Y <- as.vector(baltimore$PRICE)
 9 | X <- as.matrix(cbind(baltimore$NROOM, baltimore$DWELL, baltimore$NBATH, baltimore$PATIO, 
10 |                      baltimore$FIREPL, baltimore$AC, baltimore$BMENT, baltimore$NSTOR,
11 |                      baltimore$GAR, baltimore$AGE, baltimore$CITCOU, baltimore$LOTSZ, baltimore$SQFT))
12 | Sp <- as.matrix(cbind(baltimore$X, baltimore$Y))
13 | knn <- knn2nb(knearneigh(Sp, k=K))
14 | listw_10nn_dates <- nb2listw(knn)
15 | W <- as(as_dgRMatrix_listw(listw_10nn_dates), "CsparseMatrix")*K
16 | 
17 | 
18 | ## fitting
19 | source("SCR-function.R")
20 | select <- SCR.select(Y, X, W, Sp, G.set=2:10)   # selection of the number of clusters
21 | select$G
22 | 
23 | fit <- SCR(Y, X, W, Sp, G=select$G)  # estimation with the selected G
24 | 
25 | plot(Sp, col=fit$group)  
26 | 
27 | 
28 | 
29 | 
30 |   
31 | 


--------------------------------------------------------------------------------
/simdata1.RData:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/sshonosuke/SCR/934cd486d72627cf9d5dc7e0d55ea5b96e245ac3/simdata1.RData


--------------------------------------------------------------------------------
/simdata2.RData:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/sshonosuke/SCR/934cd486d72627cf9d5dc7e0d55ea5b96e245ac3/simdata2.RData


--------------------------------------------------------------------------------
/simulation.R:
--------------------------------------------------------------------------------
 1 | ###-----------------------------------------------------###
 2 | ###     one-shot simulation experiment (fitting)        ###
 3 | ###-----------------------------------------------------###
 4 | rm(list=ls())
 5 | set.seed(1)
 6 | 
 7 | 
 8 | library(spgwr)   
 9 | library(glmnet) 
10 | library(ape)    
11 | source("SCR-function.R")
12 | 
13 | 
14 | ## load simulated dataset
15 | scenario <- 1    # 1 (clustered case) or 2 (smoothed case)
16 | load(paste0("simdata", scenario, ".RData"))
17 | 
18 | 
19 | ## GWR: geographically weighted regression
20 | b.opt <- gwr.sel(Y~X, coords=Sp, verbose=F)
21 | fit <- gwr(Y~X, coords=Sp, bandwidth=b.opt)
22 | est0 <- cbind(fit$SDF$`(Intercept)`, fit$SDF$`Xx1`, fit$SDF$`Xx2`)
23 | 
24 | ## SCR: spatially clustered regression
25 | G.set <- seq(5, 30, by=5)
26 | IC <- SCR.select(Y, X, W, Sp, G.set=G.set, Phi=1, print=F, family="gaussian")
27 | hG <- IC$G    # optimal number of group via BIC
28 | 
29 | # SCR
30 | fit1 <- SCR(Y, X, W, Sp, G=hG, Phi=1)    
31 | est1 <- fit1$sBeta
32 | 
33 | # SFCR
34 | fit2 <- SCR(Y, X, W, Sp, G=hG, Phi=1, fuzzy=T)
35 | est2 <- fit2$sBeta
36 | 
37 | 
38 | ## SHP: spatially homogeneity pursuit method
39 | n <- length(Y)
40 | MST <- mst(dist(Sp))    # minimum spanning tree
41 | H <- c()
42 | for(i in 1:n){
43 |   for(j in 1:n){
44 |     if(i<j){
45 |       if(MST[i,j]==1){
46 |         h <- rep(0, n)
47 |         h[i] <- 1
48 |         h[j] <- -1
49 |         H <- rbind(H, h)
50 |       }
51 |     }
52 |   }
53 | }
54 | HH <- rbind(H, rep(1/n, n))
55 | invH <- solve(HH)
56 | XX <- cbind(diag(n), diag(X[,1]), diag(X[,2]))
57 | invHH <- matrix(0, 3*n, 3*n)
58 | for(k in 1:3){
59 |   sub <- (1+n*(k-1)):(n*k)
60 |   invHH[sub, sub] <- invH
61 | }
62 | XH <- XX%*%invHH
63 | pen <- rep(c(rep(1, n-1), 0), 3)
64 | fit.SHP <- glmnet(x=XH, y=Y, family="gaussian", intercept=F, penalty.factor=pen)
65 | BIC <- c()
66 | for(j in 1:100){
67 |   mu <- as.vector(XH%*%as.vector(fit.SHP$beta[,j]))
68 |   sig <- sqrt(mean((Y-mu)^2))
69 |   BIC[j] <- -2*sum(dnorm(Y, mu, sig, log=T)) + log(n)*fit.SHP$df[j]
70 | }
71 | opt <- which.min(BIC)
72 | est <- as.vector(invHH%*%as.vector(fit.SHP$beta[,opt]))
73 | est.SHP <- matrix(est, n, 3)
74 | 
75 | 
76 | 
77 | ## mean squared errors
78 | # GWR
79 | apply((est0-Beta)^2, 2, mean)
80 | # SHP
81 | apply((est.SHP-Beta)^2, 2, mean)
82 | # SCR
83 | apply((est1-Beta)^2, 2, mean)
84 | # SFCR
85 | apply((est2-Beta)^2, 2, mean)
86 | 
87 | 


--------------------------------------------------------------------------------