```
context("Basic test of the backgammon board")
test_that("initial board state is valid", {
expect_equal(TRUE, validate(getStartingBoard()))
})
test_that("boundary checks for board", {
initialBoard <- getStartingBoard()
# White boundary check
expect_equal(FALSE, canMove(initialBoard, thisColour = WHITE, thisPoint = 19, roll = 6))
expect_equal(TRUE, canMove(initialBoard, thisColour = WHITE, thisPoint = 19, roll = 4))
# Red boundary check
expect_equal(FALSE, canMove(initialBoard, thisColour = RED, thisPoint = 6, roll = 6))
expect_equal(TRUE, canMove(initialBoard, thisColour = RED, thisPoint = 6, roll = 4))
})
test_that("valid can moves", {
initialBoard <- getStartingBoard()
# White
expect_equal(FALSE, canMove(initialBoard, thisColour = WHITE, thisPoint = 12, roll = 1))
expect_equal(TRUE, canMove(initialBoard, thisColour = WHITE, thisPoint = 12, roll = 2))
expect_equal(TRUE, canMove(initialBoard, thisColour = WHITE, thisPoint = 12, roll = 3))
expect_equal(TRUE, canMove(initialBoard, thisColour = WHITE, thisPoint = 12, roll = 4))
expect_equal(TRUE, canMove(initialBoard, thisColour = WHITE, thisPoint = 12, roll = 5))
expect_equal(TRUE, canMove(initialBoard, thisColour = WHITE, thisPoint = 12, roll = 6))
# Red
expect_equal(FALSE, canMove(initialBoard, thisColour = RED, thisPoint = 13, roll = 1))
expect_equal(TRUE, canMove(initialBoard, thisColour = RED, thisPoint = 13, roll = 2))
expect_equal(TRUE, canMove(initialBoard, thisColour = RED, thisPoint = 13, roll = 3))
expect_equal(TRUE, canMove(initialBoard, thisColour = RED, thisPoint = 13, roll = 4))
expect_equal(TRUE, canMove(initialBoard, thisColour = RED, thisPoint = 13, roll = 5))
expect_equal(TRUE, canMove(initialBoard, thisColour = RED, thisPoint = 13, roll = 6))
})
test_that("valid can moves from bar - red", {
initial_board <- getStartingBoard()
bar_board <- initial_board %>%
mutate(
numCheckers = if_else(point == 24, 1, numCheckers)
) %>%
mutate(
numCheckers = if_else(point == RED_BAR, 1, numCheckers)
)
expect_equal(TRUE, canMoveFromBar(bar_board, RED, 1))
expect_equal(TRUE, canMoveFromBar(bar_board, RED, 2))
expect_equal(TRUE, canMoveFromBar(bar_board, RED, 3))
expect_equal(TRUE, canMoveFromBar(bar_board, RED, 4))
expect_equal(TRUE, canMoveFromBar(bar_board, RED, 5))
expect_equal(FALSE, canMoveFromBar(bar_board, RED, 6))
})
test_that("valid moves from bar", {
initialBoard <- getStartingBoard()
initialBoard <- initialBoard %>%
mutate(
numCheckers = if_else(point == 24, 1, numCheckers)
) %>%
mutate(
numCheckers = if_else(point == RED_BAR, 1, numCheckers)
)
# From bar to point 24
newBoard <- doMove(board = initialBoard, thisColour = RED, roll = 1, fromBar = TRUE, thisPoint = 0)
newPoint <- filter(newBoard, point == 24)
newBar <- filter(newBoard, point == RED_BAR)
expect_equal(newPoint$numCheckers, 2)
expect_equal(newPoint$colour, RED)
expect_equal(newBar$numCheckers, 0)
# From bar to point 23
newBoard <- doMove(board = initialBoard, thisColour = RED, roll = 2, fromBar = TRUE, thisPoint = 0)
newPoint <- filter(newBoard, point == 24)
newBar <- filter(newBoard, point == RED_BAR)
expect_equal(newPoint$numCheckers, 1)
expect_equal(newPoint$colour, RED)
expect_equal(newBar$numCheckers, 0)
newPoint <- filter(newBoard, point == 24)
expect_equal(newPoint$numCheckers, 1)
expect_equal(newPoint$colour, RED)
# Invalid move!
expect_error(newBoard <- doMove(board = initialBoard, thisColour = RED, roll = 6, fromBar = TRUE, thisPoint = 0))
# With blots
initialBoard <- initialBoard %>%
mutate(numCheckers = if_else(point == 19, 4, numCheckers)) %>%
mutate(numCheckers = if_else(point == 20, 1, numCheckers)) %>%
mutate(colour = if_else(point == 20, WHITE, colour)) %>%
mutate(numCheckers = if_else(point == getBarPoint(RED), 1, numCheckers))
printBoard(initialBoard)
browser()
# From bar to point 20
newBoard <- doMove(board = initialBoard, thisColour = RED, roll = 5, fromBar = TRUE, thisPoint = 0)
# Red hits blot on 20
newPoint <- filter(newBoard, point == 20)
whiteBar <- filter(newBoard, point == getBarPoint(WHITE))
redBar <- filter(newBoard, point == getBarPoint(RED))
expect_equal(newPoint$numCheckers, 1)
expect_equal(newPoint$colour, RED)
expect_equal(redBar$numCheckers, 0)
# And white has a checker on the bar
expect_equal(whiteBar$numCheckers, 1)
})
test_that("valid moves from board", {
initialBoard <- getStartingBoard()
# Lovers leap for red - (6-5 opening)
newBoard <- doMove(board = initialBoard, thisColour = RED, roll = 6, thisPoint = 24)
newBoard <- doMove(board = newBoard, thisColour = RED, roll = 5, thisPoint = 18)
newPoint <- filter(newBoard, point == 24)
redBar <- filter(newBoard, point == getBarPoint(RED))
expect_equal(newPoint$numCheckers, 1)
expect_equal(newPoint$colour, RED)
expect_equal(redBar$numCheckers, 0)
newPoint <- filter(newBoard, point == 13)
expect_equal(newPoint$numCheckers, 6)
expect_equal(newPoint$colour, RED)
# White not so lucky - (5-1) split
newBoard <- doMove(board = newBoard, thisColour = WHITE, roll = 5, thisPoint = 12)
newBoard <- doMove(board = newBoard, thisColour = WHITE, roll = 1, thisPoint = 1)
newPoint <- filter(newBoard, point == 17)
whiteBar <- filter(newBoard, point == getBarPoint(WHITE))
expect_equal(newPoint$numCheckers, 4)
expect_equal(newPoint$colour, WHITE)
expect_equal(whiteBar$numCheckers, 0)
newPoint <- filter(newBoard, point == 1)
expect_equal(newPoint$numCheckers, 1)
expect_equal(newPoint$colour, WHITE)
newPoint <- filter(newBoard, point == 2)
expect_equal(newPoint$numCheckers, 1)
expect_equal(newPoint$colour, WHITE)
})
```

Embedding an R snippet on your website

Add the following code to your website.

For more information on customizing the embed code, read Embedding Snippets.