R - Построение шестигранных тесселяций

Question

R - Построение шестигранных тесселяций

Я хотел бы создать несколько квадратных графиков, в которых есть массивы шестиугольников, как показано здесь. Я хотел бы построить как регулярные (геометрически правильные), так и ненормальные шестиугольные тесселяции, поэтому я не думаю, что инструменты из пакета sp будут работать.

Ниже моя попытка регулярного тесселяции шестиугольника, используя owin и заговор.

library(maptools)
library(spatstat)

twid <- 20
theight <-  20
sideL <- 2
rp1 <- (sideL/2)*sqrt(3)
rp2 <- 2*(sideL/2)*sqrt(3)
rp3 <- 3*sideL

    bx <- c(1:floor(twid/rp3))
    by <- c(1:floor(theight/rp3))
    hex_array1 <- list(bx)
    hex_array2 <- list(by)

    for(i in 1:ceiling(twid/rp3)){
        bx[i] <- list(x=c(0+rp3*i,1+rp3*i,3+rp3*i,4+rp3*i,3+rp3*i,1+rp3*i)) 
        by[i] <- list(y=c(rp1,rp2,rp2,rp1,0,0))
            hex_array1[i] <- bx[i]
            hex_array2[i] <- by[i]
    }

    har1 <- list(x=c(0,1,3,4,3,1), y=c(rp1,rp2,rp2,rp1,0,0))

    har2 <- list(x=hex_array1,y=hex_array2)


hexig <- owin(poly=list(list(x=c(0,twid,twid,0), y=c(0,0,theight,theight)),
                        har1, har2
                        )
                )
    plot(hexig)

Однако вышеприведенное кажется ошибочным, поскольку har2 неправильно отформатирован как список списков.

Вышеприведенное, очевидно, относится только к одному ряду шестиугольников, но я подумал, что, получив первую строку, я просто оберну одну строку в цикле for, который добавляет набор расстояний x и y для каждой строки. Я просто не могу понять, как отформатировать har2, чтобы я мог напрямую подключить его к функции поли в owin.

Я открыт для того, чтобы полностью изменить способ, которым я сделал выше, я все еще относительно новичок в R, поэтому я определенно все еще не знаю, как сделать вещи наиболее эффективным / элегантным способом. В настоящее время я использую версию R 3.3.2 на Win 10 x64 под управлением RStudio V0.99.903

Любая помощь приветствуется.

Спасибо!

6

r plot spatstat hexagonal-tiles tesselation

Источник

user6665479 08 ноя '16 в 04:41

3 ответа

Решение

Возможно, было бы проще просто построить гексбиновый график, а затем переопределить раскраску (не то, чтобы не было интересным программирование для непосредственного построения линий тесселяции шестиугольника). Например, используя ggplot2:

library(ggplot2)

dat = data.frame(x=runif(5000, 0,10), y=runif(5000,0,10))

# Basic plot
p = ggplot(dat, aes(x,y)) + 
  geom_hex(colour="black", fill="white", bins=10) +
  theme_minimal() + 
  guides(fill=FALSE) +
  scale_y_continuous(limits=c(-0.4,10.6)) +
  scale_x_continuous(limits=c(-0.4,10.6)) +
  theme(axis.text=element_blank(),
        axis.title=element_blank())

# Regular hexagons
p + coord_equal(ratio=1)

# 2:1 aspect ratio
p + coord_equal(ratio=2)

geom_hex работает только с декартовыми координатами, поэтому этот метод может производить только шестиугольники с различными пропорциями, но не сдвиг или другие искажения.

3

Источник

user496488 08 ноя '16 в 04:51

масштаб = 1

масштаб = 2

Я написал hexagon() функция, которая является базой graphics::polygon()подход. Просто нужно было немного выяснить геометрию шестиугольников и сопоставить ее с индексированием, которое имело смысл. Вот что я придумал:

Шестиугольник - это нижний левый шестиугольник. Его крайняя левая вершина находится в декартовой координате (0, opp). Он будет заподлицо на линии y = 0 (ось x).
В index_i = 2, index_j=1Шестиугольник будет примыкать справа от шестиугольника (внизу слева). Он будет немного приподнят.
В index_i=1, index_j=2 будет прямо на вершине index_i = 1, index_j=1 шестиугольник (внизу слева).
Таким образом, увеличивая ссылочные шестиугольники вправо (подумайте о index_i в качестве позиции координаты x) и увеличивая ссылочные шестиугольники выше (подумайте о index_j в качестве координаты y).
scale делает их больше или меньше
передать цвета каждому шестиугольнику с помощью fill_color
Используйте двойной цикл for для тесселяции

      library(RColorBrewer)
mypalette<-brewer.pal(5,"PuOr")[c(-1,-3)]
lwd.in<-1

hexagon<-function(index_i=1, index_j=1, scale=1, fill_color=sample(rev(mypalette)[2],1)){
  
  opp=tan(pi/3)*scale; 
  adj=1*scale;

  side_length <- sqrt(adj^2+opp^2)

vertex_a <- c(  0                ,   opp)
vertex_b <- c(adj                , 2*opp)
vertex_c <- c(adj+side_length    , 2*opp)
vertex_d <- c(adj+adj+side_length,   opp)
vertex_e <- c(  adj+side_length  , 0)
vertex_f <- c(adj                , 0)

cpoint <- c(adj+0.5*side_length,opp)


if( index_i %% 2 == 1){
  
  odds_up_to_index_i <- seq(1,index_i,by=2)
  
  key <- data.frame(      i = seq(from=0, by=3, length.out = length(odds_up_to_index_i)),
                    index_i = odds_up_to_index_i)
  
  i <- key$i[key$index_i == index_i]
  j <- 2*(index_j - 1)
  
  return_hex <-
    polygon(x = c(vertex_a[1],vertex_b[1],vertex_c[1],vertex_d[1],vertex_e[1],vertex_f[1]) + cpoint[1]*i,
            y = c(vertex_a[2],vertex_b[2],vertex_c[2],vertex_d[2],vertex_e[2],vertex_f[2]) + cpoint[2]*j,
            col=fill_color,
            lwd=lwd.in,
            border=sample(c("white","black")[1],1)
            
            
    )
}

if( index_i %% 2 == 0){
  
  i <- index_i - 1
  j <- 2*(index_j - 1)
  
  return_hex <-
    polygon(x = c(vertex_a[1],vertex_b[1],vertex_c[1],vertex_d[1],vertex_e[1],vertex_f[1]) + (cpoint[1]+0.5*side_length)*(i),
            y = c(vertex_a[2],vertex_b[2],vertex_c[2],vertex_d[2],vertex_e[2],vertex_f[2]) + cpoint[2]*(j+1),
            col=fill_color,
            lwd=lwd.in,
            border=sample(c("white","black")[1],1)
    )
  }
}

par(pty="s", mai=c(0,0,0,0)+0.1)
plot(NA,NA,xlim=c(0,200),ylim=c(0,200), axes = FALSE, xlab="", ylab="") ## if you adjust `opp` and `adj` from (7,4)
#box()
abline(v=0)
abline(h=0)

for(i in 1:100){
  for(j in 1:100){
    hexagon(index_i = i, index_j = j)
  }
}

hexagon(index_i = 1, index_j = 1)
hexagon(index_i = 1, index_j = 2)
hexagon(index_i = 1, index_j = 3)
hexagon(index_i = 1, index_j = 4)
hexagon(index_i = 1, index_j = 5)

hexagon(index_i = 2, index_j = 1)
hexagon(index_i = 2, index_j = 2)
hexagon(index_i = 2, index_j = 3)
hexagon(index_i = 2, index_j = 4)
hexagon(index_i = 2, index_j = 5)

hexagon(index_i = 3, index_j = 1)
hexagon(index_i = 3, index_j = 2)
hexagon(index_i = 3, index_j = 3)
hexagon(index_i = 3, index_j = 4)
hexagon(index_i = 3, index_j = 5)

hexagon(index_i = 4, index_j = 1)
hexagon(index_i = 4, index_j = 2)
hexagon(index_i = 4, index_j = 3)
hexagon(index_i = 4, index_j = 4)
hexagon(index_i = 4, index_j = 5)

hexagon(index_i = 5, index_j = 1)
hexagon(index_i = 5, index_j = 5)
hexagon(index_i = 6, index_j = 1)
hexagon(index_i = 6, index_j = 4)
hexagon(index_i = 7, index_j = 2)
hexagon(index_i = 7, index_j = 3)
hexagon(index_i = 7, index_j = 4)

## Infected: color, white border
hexagon(index_i = 5, index_j = 3, fill_color=rev(mypalette)[3])
## Vaccinated:  deeper color, black border (nah, just white)
hexagon(index_i = 5, index_j = 2, fill_color=rev(mypalette)[1])
hexagon(index_i = 6, index_j = 3, fill_color=rev(mypalette)[1])
hexagon(index_i = 6, index_j = 2, fill_color=rev(mypalette)[1])
hexagon(index_i = 5, index_j = 4, fill_color=rev(mypalette)[1])
hexagon(index_i = 4, index_j = 2, fill_color=rev(mypalette)[1])
hexagon(index_i = 4, index_j = 3, fill_color=rev(mypalette)[1])



## Infected: color, white border
hexagon(index_i = 20, index_j = 20, fill_color=rev(mypalette)[3])
## Vaccinated:  deeper color, black border (nah, just white)
hexagon(index_i = 20, index_j = 19, fill_color=rev(mypalette)[1])
hexagon(index_i = 20, index_j = 21, fill_color=rev(mypalette)[1])

hexagon(index_i = 19, index_j = 20, fill_color=rev(mypalette)[1])
hexagon(index_i = 19, index_j = 21, fill_color=rev(mypalette)[1])

hexagon(index_i = 21, index_j = 20, fill_color=rev(mypalette)[1])
hexagon(index_i = 21, index_j = 21, fill_color=rev(mypalette)[1])



par(pty="s", mai=c(0,0,0,0)+0.1)
plot(NA,NA,xlim=c(0,200),ylim=c(0,200), axes = FALSE, xlab="", ylab="") ## if you adjust `opp` and `adj` from (7,4)
#box()
abline(v=0)
abline(h=0)

scale.in <- 2

for(i in 1:100){
  for(j in 1:100){
    hexagon(index_i = i, index_j = j, scale=scale.in)
  }
}

hexagon(index_i = 1, index_j = 1, scale=scale.in)
hexagon(index_i = 1, index_j = 2, scale=scale.in)
hexagon(index_i = 1, index_j = 3, scale=scale.in)
hexagon(index_i = 1, index_j = 4, scale=scale.in)
hexagon(index_i = 1, index_j = 5, scale=scale.in)

hexagon(index_i = 2, index_j = 1, scale=scale.in)
hexagon(index_i = 2, index_j = 2, scale=scale.in)
hexagon(index_i = 2, index_j = 3, scale=scale.in)
hexagon(index_i = 2, index_j = 4, scale=scale.in)
hexagon(index_i = 2, index_j = 5, scale=scale.in)

hexagon(index_i = 3, index_j = 1, scale=scale.in)
hexagon(index_i = 3, index_j = 2, scale=scale.in)
hexagon(index_i = 3, index_j = 3, scale=scale.in)
hexagon(index_i = 3, index_j = 4, scale=scale.in)
hexagon(index_i = 3, index_j = 5, scale=scale.in)

hexagon(index_i = 4, index_j = 1, scale=scale.in)
hexagon(index_i = 4, index_j = 2, scale=scale.in)
hexagon(index_i = 4, index_j = 3, scale=scale.in)
hexagon(index_i = 4, index_j = 4, scale=scale.in)
hexagon(index_i = 4, index_j = 5, scale=scale.in)

hexagon(index_i = 5, index_j = 1, scale=scale.in)
hexagon(index_i = 5, index_j = 5, scale=scale.in)
hexagon(index_i = 6, index_j = 1, scale=scale.in)
hexagon(index_i = 6, index_j = 4, scale=scale.in)
hexagon(index_i = 7, index_j = 2, scale=scale.in)
hexagon(index_i = 7, index_j = 3, scale=scale.in)
hexagon(index_i = 7, index_j = 4, scale=scale.in)

## Infected: color, white border
hexagon(index_i = 5, index_j = 3, scale=scale.in, fill_color=rev(mypalette)[3])
## Vaccinated:  deeper color, black border (nah, just white)
hexagon(index_i = 5, index_j = 2, scale=scale.in, fill_color=rev(mypalette)[1])
hexagon(index_i = 6, index_j = 3, scale=scale.in, fill_color=rev(mypalette)[1])
hexagon(index_i = 6, index_j = 2, scale=scale.in, fill_color=rev(mypalette)[1])
hexagon(index_i = 5, index_j = 4, scale=scale.in, fill_color=rev(mypalette)[1])
hexagon(index_i = 4, index_j = 2, scale=scale.in, fill_color=rev(mypalette)[1])
hexagon(index_i = 4, index_j = 3, scale=scale.in, fill_color=rev(mypalette)[1])



## Infected: color, white border
hexagon(index_i = 20, index_j = 20, scale=scale.in, fill_color=rev(mypalette)[3])
## Vaccinated:  deeper color, black border (nah, just white)
hexagon(index_i = 20, index_j = 19, scale=scale.in, fill_color=rev(mypalette)[1])
hexagon(index_i = 20, index_j = 21, scale=scale.in, fill_color=rev(mypalette)[1])

hexagon(index_i = 19, index_j = 20, scale=scale.in, fill_color=rev(mypalette)[1])
hexagon(index_i = 19, index_j = 21, scale=scale.in, fill_color=rev(mypalette)[1])

hexagon(index_i = 21, index_j = 20, scale=scale.in, fill_color=rev(mypalette)[1])
hexagon(index_i = 21, index_j = 21, scale=scale.in, fill_color=rev(mypalette)[1])

0

Источник

user2727349 24 апр '21 в 03:44

Другие вопросы по тегам r plot spatstat hexagonal-tiles tesselation

user3341769 08 ноя '16 в 09:43 2016-11-08 09:43 · Accepted Answer · 2016-11-08 09:43

Я думаю spatstat имеет только те функции, которые вы ищете: hextessа также affine.tess,

Посмотрите на примеры для affine.tess, Вот пример того, что вы можете сделать (добавить trim = FALSE чтобы избежать ограничительной рамки):

library(spatstat)
H <- hextess(square(5), 0.2)
plot(H)

shear <- matrix(c(1,0,0.6,1), 2, 2)
sH <- affine(H, shear)
plot(sH)