Переменный размер участка geom_tile

Question

У меня есть код, который принимает позиционные данные, а также значения этих позиционных данных, а затем строит их с помощью geom_tile. Размер матрицы графика не постоянен от элемента данных к элементу данных, и каждая "ячейка" в мозаичном элементе geom может содержать дополнительную матрицу, опять-таки, непоследовательного размера. Код, который у меня есть в настоящее время, работает до тех пор, пока дополнительная ячейка детализации имеет размер 2x2, но терпит неудачу при попытке адаптации к любому другому размеру, скажем, 5x5. Код требует, чтобы пользователь ввел основные расстояния x и y (например, x=c(0,2,4,6,8) имеет большое расстояние 2), а также размер ячейки дополнительной детализации. На рисунке ниже показан успешный geom_tile для ячейки дополнительной детализации 2x2.

Код, который произвел это ниже.

  x <- c(0,0,4,3,3,5,5)
  y <- c(0,4,0,3,5,3,5)


  #USER INPUT
  major_x_dist <- 4 #x distance between the major data points 
  major_y_dist <- 4 #x distance between the major data points 
  division_cells <- as.character("2x2") #size of the cell containing additional detail



  #######################################
  if (division_cells == "2x2") {
    div_cells <- 2
  } else if (division_cells == "3x3") 
  { div_cells <- 3
  } else if (division_cells == "4x4")
  { div_cells <- 4
  } else if (division_cells == "5x5")
  { div_cells <- 5
  } else 
  { div_cells <-1
  }
  data_width <- ifelse(x%% major_x_dist==0, major_x_dist, major_x_dist/div_cells)
  data_height <- ifelse(y%% major_y_dist==0, major_y_dist, major_y_dist/div_cells)


  data_val <- sample(0:100, 7)
  alldata <-data.frame(x, y, data_width, data_height, data_val)




  ggplot(data= alldata, aes(x=x, y=y, width=data_width, height=data_height)) +
    geom_tile(fill = "white", color="black") + 
    geom_text(aes(label = data_val), colour="black") +
    coord_fixed()

Попытка адаптации для дополнительной ячейки 5x5 приведена ниже.

  x <- c(0,0,0,2,2,2,4,4,4,-0.8,-0.8,-0.8,-0.8,-0.8,-0.4,-0.4,-0.4,-0.4,-0.4,0,0,0,0,0.4,0.4,0.4,0.4,0.4,0.8,0.8,0.8,0.8,0.8)
  y <- c(0,2,4,0,2,4,0,2,4,3.2,3.6,4,4.4,4.8,3.2,3.6,4,4.4,4.8,3.2,3.6,4.4,4.8,3.2,3.6,4,4.4,4.8,3.2,3.6,4,4.4,4.8)


  #USER INPUT
  major_x_dist <- 2 #x distance between the major data points 
  major_y_dist <- 2 #x distance between the major data points 
  division_cells <- as.character("5x5") #size of the cell containing additional detail 



  #######################################
  if (division_cells == "2x2") {
    div_cells <- 2
  } else if (division_cells == "3x3") 
  { div_cells <- 3
  } else if (division_cells == "4x4")
  { div_cells <- 4
  } else if (division_cells == "5x5")
  { div_cells <- 5
  } else 
  { div_cells <-1
  }
  data_width <- ifelse(x%% major_x_dist==0, major_x_dist, major_x_dist/div_cells)
  data_height <- ifelse(y%% major_y_dist==0, major_y_dist, major_y_dist/div_cells)


  data_val <- sample(0:100, 33)
  alldata <-data.frame(x, y, data_width, data_height, data_val)




  ggplot(data= alldata, aes(x=x, y=y, width=data_width, height=data_height)) +
    geom_tile(fill = "white", color="black") + 
    geom_text(aes(label = data_val), colour="black") +
    coord_fixed()

Обратите внимание, что размер общей матрицы, основные расстояния между точками данных, расположение дополнительной ячейки подробностей и размер дополнительной ячейки подробностей отличаются от решения, которое работает с ячейкой дополнительной детализации 2x2. Похоже, что текст находится в правильном месте, но ячейки нет. Я думаю, что проблема может быть связана с тем фактом, что центральная точка данных дополнительной ячейки подробностей лежит на главной точке (0,4). Сюжет, который производит этот код ниже.

Любые советы по устранению неисправностей, которые могут быть предоставлены, очень ценятся!

Answer 1

Я не думаю, что метод определения маленьких квадратов работает у вас. Не совсем уверен, почему, но я подумал, что может быть проще вернуться к этому вопросу. Вот обобщенное решение. Сначала я настрою некоторые данные - с размерами, количеством квадратов и местоположением подсетки, выбранными случайным образом...

large_x <- sample(2:5,1) #large grid no of x squares
large_y <- sample(2:5,1) #large grid no of y squares
small_x <- sample(2:5,1) #small grid no of x squares
small_y <- sample(2:5,1) #small grid no of y squares
large_w <- round(runif(1,0.5,1.5),2) #width of large squares
large_h <- round(runif(1,0.5,1.5),2) #height of large squares
df <- expand.grid(x=large_w*(1:large_x),y=large_h*(1:large_y)) #large grid
divsq <- sample(nrow(df),1) #random row of df to determine square to divide
sm_x <- df$x[divsq] #coordinates of divided square
sm_y <- df$y[divsq]
df <- rbind(df[-divsq,], #large grid without subdivided square
            expand.grid(x=sm_x-large_w*((1+1/small_x)/2-(1:small_x)/small_x), #x coordinates of small grid
                        y=sm_y-large_h*((1+1/small_y)/2-(1:small_y)/small_y))) #y coordinates of small grid
df$val <- sample(0:100,nrow(df))
df <- df[sample(nrow(df)),] #shuffle df for good measure!

Теперь я собираюсь игнорировать все случайные параметры и просто работать с df, который содержит только x, y а также val колонны. Подход заключается в том, чтобы посмотреть на интервалы между значениями x для константы y (и наоборот) и использовать это для определения характеристик малого квадрата. Затем эту информацию можно использовать для обозначения того, принадлежит ли каждая точка данных к небольшому квадрату, после чего все остальное просто.

xdists <- tapply(df$x,df$y,function(z) diff(sort(z))) #list of differences between x values for constant y
ydists <- tapply(df$y,df$x,function(z) diff(sort(z))) #list of differences between y values for constant x
smallw <- min(unique(unlist(xdists))) #identify small width
smallh <- min(unique(unlist(ydists))) #identify small height

#the next lines check for rows that contain diffs equal to the small values, and return the appropriate values of x or y 
smally <- as.numeric(names(xdists)[sapply(xdists,function(z) min(abs(z-smallw))<0.0000001)]) #values of y corresponding to small grid
smallx <- as.numeric(names(ydists)[sapply(ydists,function(z) min(abs(z-smallh))<0.0000001)]) #values of x corresponding to small grid

nx <- length(smallx) #x-size of small grid
ny <- length(smally) #y-size of small grid

#this checks which data points are in small squares (allowing some tolerance for rounding)
df$small <- mapply(function(x,y) (min(abs(x-smallx))<0.0000001 & 
                                  min(abs(y-smally))<0.0000001),df$x,df$y)

df$w <- ifelse(df$small,smallw,smallw*nx)
df$h <- ifelse(df$small,smallh,smallh*ny)

ggplot(data=df, aes(x=x, y=y, width=w, height=h)) +
  geom_tile(fill = "white", color="black") + 
  geom_text(aes(label = val), colour="black") +
  coord_fixed()