Построение разветвляющегося движения с помощью dplyr + ggplot2

Question

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

#define rot(x,k) (((x)<<(k)) | ((x)>>(32-(k))))
uint32_t rotating_hash(uint32_t state, uint32_t input)
{
    uint32_t hash = state;
    uint8_t *p = (uint8_t*)&input;
    //      mix          ; combine
    hash ^=                *(p++);
    hash += rot(hash, 4) ^ *(p++);
    hash += rot(hash, 4) ^ *(p++);
    hash += rot(hash, 4) ^ *p;
    return hash;
}

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

Я вычисляю, как биты на одном уровне влияют на биты ниже их так:

library(tibble)
library(dplyr)
library(magrittr)

rot_hash_positions <- function(bit) {
  operation_1 <- bit
  operation_2 <- outer(operation_1, c(4, 0, -28), FUN = '+')  %>% as.vector() %>% { . %% 32 }
  operation_3 <- outer(operation_2, c(4, 0, -28), FUN = '+')  %>% as.vector() %>% { . %% 32 }
  operation_4 <- outer(operation_3, c(4, 0, -28), FUN = '+')  %>% as.vector() %>% { . %% 32 }
  rbind(tibble(bit = bit, operation = 1, positions = operation_1),
        tibble(bit = bit, operation = 2, positions = operation_2),
        tibble(bit = bit, operation = 3, positions = operation_3),
        tibble(bit = bit, operation = 4, positions = operation_4))
}

bit_movement <- do.call(rbind, lapply(0:31, rot_hash_positions))

и результат выглядит следующим образом:

> bit_movement %>% filter(bit == 0)
# A tibble: 10 x 3
     bit operation positions
   <int>     <dbl>     <dbl>
 1     0         1         0
 2     0         2         4
 3     0         2         0
 4     0         3         8
 5     0         3         4
 6     0         3         0
 7     0         4        12
 8     0         4         8
 9     0         4         4
10     0         4         0

Функция вычисляет два значения для операции поворота, но модуль 32 становится одной позицией, и я избавляюсь от дублирования, используя unique().

Теперь я хочу построить это,Пока моя попытка выглядит следующим образом:

library(ggplot2)

plot_bitmovement <- function(bit_movement, highlight_bits) {
  ggplot(bit_movement, aes(
    y = positions,
    x = operation,
    group = factor(bit, levels = 1:32)
  )) +
    geom_line(colour = "gray") +
    geom_point(colour = "gray") +
    geom_line(data = highlight_bits, colour = "black") +
    geom_point(data = highlight_bits, colour = "black") +
    coord_flip() +
    scale_y_reverse(breaks = 0:31, labels = 1:32) +
    scale_x_reverse() +
    theme_minimal() +
    theme(
      legend.position = "none"
    ) + ylab("Bit-position") + xlab("Operation")
}

, где я выделяю первый или последний байт на графиках:

bit_movement <- do.call(rbind, lapply(0:31, rot_hash_positions))
plot_bitmovement(bit_movement, bit_movement %>% filter(bit < 8))

last_byte <- tibble(bit = 0:7, operation = 4, positions = 0:7)
plot_bitmovement(bit_movement, last_byte)

Последний байт в этом случае менее интересен, но мне нужно также визуализировать некоторые другие хэш-функции, где они становятся более интересными.

Теперь моя проблема заключается в следующем: когда я строю битовое движение, используя geom_line(), я не получаю отрезки линии от одного уровня оси y к следующему, но сегменты горизонтальной линии для всех, кроме первого шага от одногоуровень на следующий.Я хочу только сегменты, которые переходят с одного уровня на следующий.Я не совсем уверен, как это сделать.

Я думаю, что geom_linesegment - это путь, и в этом случае мне нужно изменить фрейм данных bit_movement на что-то, что имеет начало иКонечные позиции отрезков я хочу, но я не уверен, как это сделать элегантно.И поскольку мне нужно нарисовать несколько похожих фигур, я бы предпочел не связывать слишком много данных манипуляциями.

Есть предложения?

Answer 1

Я придумал эту идею.Я не уверен, насколько это элегантно, поэтому я все еще хотел бы комментарии к нему.

library(purrr)
get_steps <- function(bm, step) {
  op1 <- bm %>%
    filter(operation == !!(step-1)) %>%
    mutate(x = operation, y = positions) %>%
    select(bit, x, y)
  op2 <- bm %>%
    filter(operation == !!step) %>%
    mutate(xend = operation, yend = positions) %>%
    select(bit, xend, yend)
  inner_join(op1, op2, by = "bit")
}

plot_bitmovement <- function(bit_movement, highlight_bits) {
  bm_segs <- map(2:4, ~ get_steps(bit_movement, .x)) %>% bind_rows()
  hl_segs <- map(2:4, ~ get_steps(highlight_bits, .x)) %>% bind_rows()
  ggplot(bm_segs, aes(
    x = x, 
    y = y, 
    xend = xend,
    yend = yend)
  ) + 
    geom_segment(colour = "grey") +
    geom_point(colour = "grey") + 
    geom_point(aes(x = xend, y = yend), colour = "grey") +
    geom_segment(data = hl_segs, colour = "black") + 
    geom_point(data = hl_segs, colour = "black") +
    geom_point(aes(x = xend, y = yend), data = hl_segs, colour = "black") +
    coord_flip() +
    scale_y_reverse(breaks = 0:31, labels = 1:32) +
    scale_x_reverse() +
    theme_minimal() +
    theme(
      legend.position = "none"
    ) + ylab("Bit-position") + xlab("Operation")
}

bit_movement <- do.call(rbind, lapply(0:31, rot_hash_positions))
plot_bitmovement(bit_movement, bit_movement %>% filter(bit < 8))

Обновление: Нет, это тоже не совсем правильно.Теперь я вижу больше движений, чем должен, так как объединяю все позиции на одном уровне со всеми ниже.Это ошибка в rot_hash_positions, поэтому я сам попробую.