Câte modalități de a colora această grilă: predarea combinatoarelor folosind r

Soluția

Există multe modalități de a rezolva acest lucru. În fiecare soluție, numărăm numărul de combinații care sunt „corecte” sau valabile, adică, respectăm regulile date mai sus în problemă. Pentru soluția din R, vom genera toate combinațiile posibile de colorare a acestei grile, fără restricții, și folosind acest lucru, numărați direct cazurile care Urmați regulile de adjacență specificat în problemă.

Voi folosi dplyr Pentru a ilustra cât de ușor și simplu va fi să ajungeți la soluție.

Cel mai simplu mod de a calcula modalități de a colora această grilă fără restricții este de a considera că pentru fiecare dintre pătrate (), Sunt opțiuni posibile (vezi Square de mai sus), astfel încât numărul total de opțiuni pe care le avem este în esență –

Acum folosim R pentru a genera acestea cazuri sau opțiuni.

library(gtools)
x <- c('r', 'b', 'g', 'y')

P <- permutations(
  n = 4,
  r = 4,
  v = x,
  repeats.allowed = T
)

colnames(P) <- c("A", "B", "C", "D")
P <- data.frame(P)
nrow(P)

head(P)

  A B C D
1 b b b b
2 b b b g
3 b b b r
4 b b b y
5 b b g b
6 b b g g

Cum determinăm acum ce cazuri nu respectă regulile de adjacență? Pentru a face acest lucru, va trebui să folosim o logică de căutare a modelului pentru a le semnaliza. O modalitate este de a calcula, pentru toți cazuri, diferite coloane, corespunzătoare Restricții de adiacență (de exemplu, roșu-roșu, albastru-albastru, verde-verde și galben-galben). Le -am folosi apoi pe acestea Coloane pentru calcularea unei singure coloane de semnalizare a coloanelor în care sunt urmate restricții de adiacent, adică pavilion valabil cazuri și rezumă -le.

Cu toate acestea, în r, folosind dplyrcombinăm acest lucru într -o singură comandă folosind case whencare va semnaliza fiecare caz ori de câte ori îndeplinește condiția de invaliditate chiar și o dată, de exemplu, pentru schema de colorat „albastru-albastru-albastru-roșu”, îl va semnaliza „nevalid”, deoarece doar existența „albastru-albastru” este suficientă pentru a considera această schemă nevalide.

library(dplyr)
library(magrittr)

case_split <- P %>%
  mutate(concat = paste(P$A, P$B, P$C, P$D, P$A, sep = "")) %>%
  mutate(
    flag = case_when(
      grepl("rr", concat) ~ "invalid",
      grepl("bb", concat) ~ "invalid",
      grepl("gg", concat) ~ "invalid",
      grepl("yy", concat) ~ "invalid",
      .default = "valid"
    )
  ) %>%
  group_by(flag) %>% summarise(count = n())

knitr::kable(case_split, align = rep('c', 2))

Sunt Cazuri valide, care pot, desigur, să fie calculate aritmetic folosind formule combinatorice sau pur și simplu mergând în caz după caz ​​și calculând câte cazuri valabile apar, ceea ce ne va oferi și Cazuri valabile ale totalului .

Dintre acestea rămase Cazuri nevalide, m -am gândit apoi la câți se datorează atât de mult pentru a nu respecta regulile de adiacență doar o dată, câte de două ori sau mai mult? De exemplu, „BBBG” nu o ascultă de două ori, „BBRG” doar o dată. Să facă acest lucru, pentru fiecare dintre Cazuri, în loc de existența invalidității, semnalizăm fiecare apariție de adjacență sau invaliditate și apoi le rezumăm.

flag_invalid_adj <- function(df) {
  df %>%
    rowwise() %>%
    mutate(
      # Check each adjacency pair for invalidity
      ab_invalid = A == B,
      bc_invalid = B == C,
      cd_invalid = C == D,
      ad_invalid = A == D,
      # Count the number of invalid pairs
      invalid = sum(ab_invalid, bc_invalid, cd_invalid, ad_invalid),
    ) %>%
    ungroup()
}

cols <- P(, 1:4)
invalid_data <- flag_invalid_adj(cols) %>% select(A, B, C, D, invalid)
finalCounts <- invalid_data %>% group_by(invalid) %>% summarise(count =
                                                                  n())
knitr::kable(finalCounts, align = rep('c', 2))

Primul rând confirmă numărul de Cazurile valide, adică nu au nicio problemă de adiacență. În cele din urmă, pentru că putem, și iubim ggplot2Să generăm o grilă de probe din fiecare categorie de invaliditate, astfel încât să putem inspecta vizual ceea ce am spus. „4 cazuri nevalide” au 4 perechi de albastru, sau 4 adiacențe, în timp ce „Nu există cazuri nevalide!” Parcela este un exemplu despre modul în care putem colora într -adevăr un grafic, o hartă sau o grilă cu 4 culori fără pătrate sau „regiuni” adiacente, având aceeași culoare. Câteva note despre codul folosit – complotăm cele 4 exemple folosind gridExtra. Vom folosi și textGrob Pentru a atribui un titlu general pentru familia parcelelor, folosind un font elegant de la Google Library („Rouge Script”). Faceți clic pe „Afișați codul” pentru a vedea detaliile.

# Select first row of all groups
s <- invalid_data %>% group_by(invalid) %>% filter(row_number() == 1)

# Load necessary libraries for elegant visualizations
library(ggplot2)
library(grid)       # To ensure "textGrob" works
library(gridExtra)
library(showtext)   # For using custom fonts

# Load a font using showtext
font_add_google("Rouge Script", "rouge script")  # Example: Adding the "Lobster" font
showtext_auto()  # Automatically use showtext for all plots

# Create my color tibble (4x4)
sq <- s %>%
  mutate_all( ~ case_when(
    . == "b" ~ "blue",
    . == "g" ~ "green",
    . == "y" ~ "yellow",
    . == "r" ~ "red",
    TRUE ~ .  # Keep original value if it doesn't match
  ))

# Convert tibble to a matrix
color_matrix <- sq(, -5) %>% select(A, B, D, C) %>% as.matrix() # to match the coloring order of ggplot2

# Check the dimensions of the matrix
# Print(dim(color_matrix))  # Should be 4x4

# Function to create a plot based on a color vector and a title
create_plot <- function(colors, title) {
  df <- expand.grid(x = 0:1, y = 0:1)
  df$color <- colors
  
  ggplot(df, aes(x = x, y = y, fill = color)) +
    geom_tile(color = "white") +  # Change border color to white
    scale_fill_identity() +        # Use the colors as they are
    theme_minimal() +              # Use a minimal theme
    coord_fixed() +                # Keep aspect ratio
    labs(title = title) +          # Add the title
    theme(
      legend.position = "none",
      # Remove legend
      axis.title = element_blank(),
      # Suppress axis titles
      axis.text = element_blank(),
      # Suppress axis text
      axis.ticks = element_blank(),
      # Suppress axis ticks
      panel.grid = element_blank(),
      # Suppress grid lines
      plot.title = element_text(
        family = "rouge script",
        size = 16,
        hjust = 0.5
      )  # Use the custom font for the title
    )
}

# Create a vector of titles for each plot
titles <- c("4 invalid cases",
            "2 invalid cases",
            "1 invalid case",
            "No invalid cases!")

# Create a list of plots using the color matrix and titles
plots <- lapply(1:nrow(color_matrix), function(i) {
  create_plot(color_matrix(i, ), titles(i))
})

# Create the overall title using textGrob
overall_title <- textGrob(
  "Using R to elegantly illustrate the solution to a Combinatorics puzzle",
  gp = gpar(fontsize = 20, fontfamily = "rouge script")
)

# Create a spacer with appropriate height
spacer <- rectGrob(
  gp = gpar(fill = NA, col = NA),
  width = unit(1, "npc"),
  height = unit(0.5, "lines")
)

# Arrange the overall title and plots
grid.arrange(
  overall_title,
  spacer,
  arrangeGrob(grobs = plots, ncol = 2),
  ncol = 1,
  heights = c(1, 0.1, 4)
)

Despre autor

Vidisha scrie: „În calitate de statisticist și geek de date, îmi place să rezolv puzzle -uri de tot felul, cu o dragoste deosebită pentru provocările combinatorii. Recent, am abordat unul în R folosind pachetul DPlyR, ceea ce m -a determinat să mă gândesc la aplicațiile mai largi ale lui R, nu doar ca un instrument puternic pentru rezolvarea puzzle -urilor pentru entuziasm, ci și ca o compensare a modului de a învăța volumul de matematic. Poate ajuta elevii să înțeleagă mai intuitiv problemele complexe, ducând în cele din urmă la o înțelegere mai profundă a soluțiilor lor. ”