可变大小的geom_tile图

Question

我有一个代码，它接收位置数据以及该位置数据的值，然后用geom_tile绘制它。从数据项到数据项，图的矩阵大小不是恒定的，并且几何图块中的每个“单元”都有可能包含另外的矩阵，同样具有不一致的大小。我目前使用的代码只要附加细节单元格是2x2，但是在尝试适应任何其他大小时失败，比如5x5。该代码要求用户输入主要的x和y距离（例如，x = c（0,2,4,6,8）的主距离为2）以及附加细节单元的大小。下面的图片是2x2附加细节单元的成功geom_tile

产生它的代码如下。

  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列。方法是查看常数y的x值之间的间隔（反之亦然），并使用它来计算小方形特征。然后，可以使用此信息来标记每个数据点是否属于一个小方块，之后其余部分都很简单。

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()