J'ai une matrice:

m <- matrix(c(
  1,    1,    1,    0,    0,    0,
  0,    0,    0,    0,    0,    0,
  3,    0,    0,    0,    0,    0,
  3,    0,    0,    0,    0,    2,
  3,    0,    0,    0,    0,    0,
  3,    0,    0,    0,    2,    2),
  ncol = 6, byrow = TRUE)

     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]    1    1    1    0    0    0
[2,]    0    0    0    0    0    0
[3,]    3    0    0    0    0    0
[4,]    3    0    0    0    0    2 # <- island 3, value 2
[5,]    3    0    0    0    0    0
[6,]    3    0    0    0    2    2 # <- island  4, also value 2

Dans cette matrice, il y a quatre `` îlots '', c'est-à-dire des valeurs non nulles séparées par des zéros:

(1) un îlot composé de trois 1, (2) quatre 3, (3) un 2 et (4) deux 2.

Ainsi, deux îlots sont composés de la valeur 2. Je veux identifier ces îles «en double» et changer les valeurs de l'une des «îles» (l'une ou l'autre fera l'affaire) au prochain numéro disponible (4 dans ce cas):

     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]    1    1    1    0    0    0
[2,]    0    0    0    0    0    0
[3,]    3    0    0    0    0    0
[4,]    3    0    0    0    0    2
[5,]    3    0    0    0    0    0
[6,]    3    0    0    0    4    4
5
user3651829 20 nov. 2018 à 13:41

4 réponses

Meilleure réponse

Question amusante! Prenons un cas plus complexe

(M <- matrix(c(1, 0, 3, 3, 3, 3, 1, 0, 0, 0, 0, 0, 1, 0, 3, 0, 2, 
               0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 2, 1, 0, 0, 2, 0, 2), 6, 6))
#      [,1] [,2] [,3] [,4] [,5] [,6]
# [1,]    1    1    1    0    0    1
# [2,]    0    0    0    0    0    0
# [3,]    3    0    3    3    0    0
# [4,]    3    0    0    0    0    2
# [5,]    3    0    2    0    0    0
# [6,]    3    0    0    0    2    2

Voici une solution basée sur des graphiques.

library(igraph)
# Indices of nonzero matrix elements
idx <- which(M != 0, arr.ind = TRUE)
# Adjacency matrix for matrix entries
# Two entries are adjacent if their column or row number differs by one
# Also, due to idx, an implicit condition is also that the two entries are the same
adj <- 1 * (as.matrix(dist(idx, method = "manhattan")) == 1)
# Creating loops as to take into account singleton islands
diag(adj) <- 1
# A corresponding graphs
g <- graph_from_adjacency_matrix(adj, mode = "undirected")
# Connected components of this graph
cmps <- clusters(g)
# Going over unique values of M
for(i in 1:max(M)) {
  # Islands of value i
  un <- unique(cmps$membership[M[idx] == i])
  # More than one island?
  if(length(un) > 1)
    # If so, let's go over islands 2, 3, ...
    for(cmp in un[-1])
      # ... and replace corresponding matrix entries by max(M) + 1
      M[idx[cmps$membership == cmp, , drop = FALSE]] <- max(M) + 1
}

M
#      [,1] [,2] [,3] [,4] [,5] [,6]
# [1,]    1    1    1    0    0    4
# [2,]    0    0    0    0    0    0
# [3,]    3    0    7    7    0    0
# [4,]    3    0    0    0    0    6
# [5,]    3    0    2    0    0    0
# [6,]    3    0    0    0    5    5

Notez également qu'en utilisant adj seul, nous pourrions trouver toutes les îles si nous pouvions trouver sa permutation conduisant à une matrice diagonale de blocs avec le nombre maximal de blocs. Ensuite, chaque bloc correspondrait à une île. Cependant, je n'ai pas trouvé d'implémentation R d'une procédure pertinente.

2
Julius Vainora 20 nov. 2018 à 14:51

Les «îles» de valeurs non nulles peuvent être identifiées par raster::clump *. Utilisez ensuite les fonctions pratiques data.table pour identifier les valeurs à mettre à jour.

library(raster)
library(data.table)

# get index of non-zero values. re-order to match the clump order
ix <- which(m != 0, arr.ind = TRUE)
ix <- ix[order(ix[ , "row"]), ]

# get clumps
cl <- clump(raster(m))
cl_ix <- cl@data@values

# put stuff in a data.table and order by x
d <- data.table(ix, x = m[ix], cl_ix = cl_ix[!is.na(cl_ix)])
setorder(d, x, cl_ix)

# for each x, create a counter of runs of clump index
d[ , g := rleid(cl_ix), by = x]

# for 'duplicated' runs...
# ...add to x based on runs of x and clump index runs
d[g > 1, x := max(d$x) + rleid(x, g)]

# update matrix
m2 <- m
m2[as.matrix(d[ , .(row, col)])] <- d$x

m
#      [,1] [,2] [,3] [,4] [,5] [,6]
# [1,]    1    1    1    0    0    1
# [2,]    0    0    0    0    0    0
# [3,]    3    0    3    3    0    0
# [4,]    3    0    0    0    0    2
# [5,]    3    0    2    0    0    0
# [6,]    3    0    0    0    2    2

m2
#      [,1] [,2] [,3] [,4] [,5] [,6]
# [1,]    1    1    1    0    0    4
# [2,]    0    0    0    0    0    0
# [3,]    3    0    7    7    0    0
# [4,]    3    0    0    0    0    2
# [5,]    3    0    5    0    0    0
# [6,]    3    0    0    0    6    6

* Notez que la fonction clump nécessite que le package igraph soit disponible.

1
Henrik 20 nov. 2018 à 19:47

Ceci peut être facilement réalisé avec le package TraMineR.

islander <- function(mat) {
  require(TraMineR)
  rows.mat.seq <- seqdef(mat)  # seeks all sequences in rows 
  cols.mat.seq <- seqdef(t(mat))  # tranposed version
  rows <- seqpm(rows.mat.seq, 22)$MIndex  # seeks for sub sequence 2-2 in rows
  cols <- seqpm(cols.mat.seq, 22)$MIndex  # seeks for sub sequence 2-2 in columns
  if (length(cols) == 0) {  # the row case
    mat[rows, which(mat[rows, ] == 2)] <- 4
    return(mat)
  } else {  # the column case
    mat[which(mat[, cols] == 2), cols] <- 4
    return(mat)
  }
}

Rendements

> islander(row.mat)
...
     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]    1    1    1    0    0    0
[2,]    0    0    0    0    0    0
[3,]    3    0    0    0    0    0
[4,]    3    0    0    0    0    2
[5,]    3    0    0    0    0    0
[6,]    3    0    0    0    4    4

> islander(col.mat)
...
     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]    1    1    1    0    0    0
[2,]    0    0    0    0    0    0
[3,]    3    0    0    0    0    0
[4,]    3    0    0    0    0    0
[5,]    3    0    0    0    0    4
[6,]    3    0    0    2    0    4

Remarque: Si votre île est plus longue, vous devez maîtriser le code, par exemple car la longueur de l'île est de 3 do seqpm(., 222). Il est certainement possible d'intégrer la prise en compte de tous les cas dans la fonction.

Data

row.mat <- structure(c(1, 0, 3, 3, 3, 3, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 
                   0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 2, 0, 2), .Dim = c(6L, 
                                                                                      6L))
col.mat <- structure(c(1, 0, 3, 3, 3, 3, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 
                    0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 2), .Dim = c(6L, 
                                                                                       6L))

> row.mat
     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]    1    1    1    0    0    0
[2,]    0    0    0    0    0    0
[3,]    3    0    0    0    0    0
[4,]    3    0    0    0    0    2
[5,]    3    0    0    0    0    0
[6,]    3    0    0    0    2    2
> col.mat
     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]    1    1    1    0    0    0
[2,]    0    0    0    0    0    0
[3,]    3    0    0    0    0    0
[4,]    3    0    0    0    0    0
[5,]    3    0    0    0    0    2
[6,]    3    0    0    2    0    2
0
jay.sf 20 nov. 2018 à 13:20

C'était plus difficile que je ne le pensais à cause de la condition "pas les deux", j'ai obtenu le résultat avec une boucle while pour le moment, nous verrons s'il peut être amélioré:

(en gros nous nous déplaçons par rang et vérifions si l'île est trouvée, si c'est le cas nous terminons nos recherches)

# some useful variables
i=1 # row counter
counter=0 # check if island is found
max_m <- max(m) #finds the max value in the matrix, to fill

while(counter == 0) {

  if (any(m[i, ] == 2)) { # check if we find the island in the row, otherwise skip
    row <- m[i, ]
    row[row == 2] <- max_m + 1 # here we change the value
    m[i, ] <- row
    counter <- counter + 1
  }

  i = i + 1 # we move up one row
  #cat("row number: ", i, "\n") # sanity check to see if it was an infinite loop
}
m
#      [,1] [,2] [,3] [,4] [,5] [,6]
# [1,]    1    1    1    0    0    0
# [2,]    0    0    0    0    0    0
# [3,]    3    0    0    0    0    0
# [4,]    3    0    0    0    0    4
# [5,]    3    0    0    0    0    0
# [6,]    3    0    0    0    2    2

C'est loin d'être parfait, car nous nous déplaçons par lignes, donc si la première île se trouve sur une colonne, nous ne changerons que la première valeur.

Exemple de résultat inattendu:

#      [,1] [,2] [,3] [,4] [,5] [,6]
# [1,]    1    1    1    0    0    0
# [2,]    0    0    0    0    0    0
# [3,]    3    0    0    0    0    0
# [4,]    3    0    0    0    0    4
# [5,]    3    0    0    0    0    2 # problem here
# [6,]    3    0    0    0    0    0

Données utilisées:

m <- matrix(c(rep(1, 3),
              rep(0, 9),
              3, 
              rep(0, 5),
              3,
              rep(0, 4),
              2,
              3,
              rep(0, 5),
              3,
              rep(0,3),
              rep(2, 2)),ncol=6,nrow=6, byrow = T)
0
RLave 20 nov. 2018 à 11:20