Hex with Shinylive !

#| '!! shinylive warning !!': |
#|   shinylive does not work in self-contained HTML documents.
#|   Please set `embed-resources: false` in your metadata.
#| viewerHeight: 600
#| standalone: true
library(ggplot2)
library(hexbin)
library(shiny)
library(dplyr)
library(magrittr)

initialize_hex_board <- function(size = 11) {
  board <- matrix(0, nrow = size + 2, ncol = size + 2)
  board[1, ] <- 2  # 上の境界を2Pに
  board[size + 2, ] <- 2  # 下の境界を2Pに
  board[, 1] <- 1  # 左の境界を1Pに
  board[, size + 2] <- 1  # 右の境界を1Pに
  # 左下と右上の隅をNAに
  board[1, 1] <- NA
  board[size + 2, size + 2] <- NA
  return(board)
}

get_neighbors <- function(row, col, board_size) {
  directions <- list(
    c(-1, 0), c(-1, 1),  # 上側
    c(0, -1), c(0, 1),   # 左右
    c(1, -1), c(1, 0)    # 下側
  )
  neighbors <- lapply(directions, function(d) c(row + d[1], col + d[2]))
  return(Filter(function(pos) {
    pos[1] >= 1 && pos[1] <= board_size && pos[2] >= 1 && pos[2] <= board_size
  }, neighbors))
}

dfs <- function(board, player, visited, row, col) {
  size <- nrow(board)
  if (visited[row, col] || board[row, col] != player) {
    return(FALSE)
  }
  visited[row, col] <- TRUE
  
  if (player == 1 && col == size) {
    return(TRUE)
  }
  
  if (player == 2 && row == size) {
    return(TRUE)
  }
  
  neighbors <- get_neighbors(row, col, size)
  for (neighbor in neighbors) {
    if (dfs(board, player, visited, neighbor[1], neighbor[2])) {
      return(TRUE)
    }
  }
  return(FALSE)
}

check_hex_winner <- function(board) {
  actual_board <- board[2:(nrow(board) - 1), 2:(ncol(board) - 1)]
  size <- nrow(actual_board)
  visited <- matrix(FALSE, nrow = size, ncol = size)
  
  for (row in 1:size) {
    if (actual_board[row, 1] == 1 && dfs(actual_board, 1, visited, row, 1)) {
      return(1)
    }
  }
  
  # プレイヤー2の勝利チェック（上から下）
  visited[,] <- FALSE
  for (col in 1:size) {
    if (actual_board[1, col] == 2 && dfs(actual_board, 2, visited, 1, col)) {
      return(2)
    }
  }
  
  return(NULL)
}


board_to_long <- function(board) {
  size <- nrow(board)
  data.frame(
    row = rep(1:size, each = size) * sqrt(3)/2,
    col = rep(1:size, times = size) + rep(seq(0, size - 1) / 2, each = size),
    player = as.vector(board)
  )
}

plot_hex_board_with_geom_hex <- function(board) {
  long_board <- board_to_long(board)
  ggplot(long_board, aes(x = col, y = row, z = player)) +
    stat_summary_hex(binwidth = c(1, 1), 
                     linewidth = 1,
                     colour = "black",
                     fun = function(x) mean(x, na.rm = TRUE)) +
    scale_fill_gradient2(low = "white", mid = "#FF0033", high = "#00B900", midpoint = 1, na.value = "grey") +
    coord_fixed() +
    theme_minimal() +
    theme(legend.position = 'none') +
    labs(x = "Column", y = "Row", fill = "Player") +
    xlim(0, ncol(board)+ncol(board)*0.5) +
    ylim(0, nrow(board) * sqrt(3)/2+1)
}

find_nearest_cell <- function(coords, board) {
  size <- nrow(board)
  
  centers <- expand.grid(row = 1:size, col = 1:size)
  centers$center_x <- centers$col + centers$row * 0.5
  centers$center_y <- centers$row * sqrt(3)/2
  
  centers$distance <- sqrt((centers$center_x - coords$x)^2 + (centers$center_y - coords$y)^2)
  
  nearest <- centers[which.min(centers$distance), ]
  return(nearest)
}



ui <- fluidPage(
  titlePanel("Hex Game"),
  sidebarLayout(
    sidebarPanel(
      # verbatimTextOutput("click_info"),
      verbatimTextOutput("cell_info"),
      verbatimTextOutput("winner_info") 
    ),
    mainPanel(
      plotOutput("hex_board", click = "plot_click")
    )
  )
)

server <- function(input, output, session) {
  board <- initialize_hex_board(7)
  current_player <- reactiveVal(1)  
  
  output$hex_board <- renderPlot({
    plot_hex_board_with_geom_hex(board)
  })
  
  observeEvent(input$plot_click, {
    coords <- input$plot_click
    nearest <- find_nearest_cell(coords, board)
    
    if (nearest$row >= 1 && nearest$row <= nrow(board) && nearest$col >= 1 && nearest$col <= ncol(board)) {
      cell_value <- board[nearest$col, nearest$row]
      if (is.na(cell_value) || cell_value != 0) {
        output$cell_info <- renderPrint({
          cat("Selected cell is not playable.\n")
        })
      } else {
        
        board[nearest$col, nearest$row] <<- current_player()
        output$cell_info <- renderPrint({
          cat(sprintf("Player %d placed on Row: %d, Column: %d\n", current_player(), nearest$row, nearest$col))
        })
        
        winner <- check_hex_winner(board)
        if (!is.null(winner)) {
          output$winner_info <- renderPrint({
            cat(sprintf("Player %d wins!\n", winner))
          })
        } else {
          current_player(ifelse(current_player() == 1, 2, 1))
        }
        
        output$hex_board <- renderPlot({
          plot_hex_board_with_geom_hex(board)
        })
      }
    } else {
      output$cell_info <- renderPrint({
        cat("Clicked outside of board.\n")
      })
    }
  })
}

shinyApp(ui, server)