tests/testthat/test-sgl_geom_line.R

In rsgl: An Implementation of the 'SGL' Graphics Language

test_that(
  paste(
    "new_sgl_geom_line returns an instance",
    "of the sgl_geom_line subclass"
  ),
  {
    line <- new_sgl_geom_line()
    expect_equal(attr(line, "class"), c("sgl_geom_line", "sgl_geom"))
  }
)

test_that("new_sgl_geom_line only adds class attribute", {
  line <- new_sgl_geom_line()
  all_attributes <- names(attributes(line))
  expect_equal(all_attributes, "class")
})

test_that("new_sgl_geom_line sets empty list as base object", {
  base_object <- unclass(new_sgl_geom_line())

  expect_equal(base_object, list())
})

test_that("geom_name returns line", {
  line <- new_sgl_geom_line()
  actual <- geom_name(line)
  expect_equal(actual, "line")
})

test_that("is_collective returns TRUE", {
  line <- new_sgl_geom_line()
  expect_equal(is_collective(line), TRUE)
})

test_that("ggplot_geom returns geom_line function", {
  line <- new_sgl_geom_line()
  actual <- ggplot_geom(line)
  expect_equal(actual, ggplot2::geom_line)
})

describe("group_aes_cols", {
  describe("no non-pos aes", {
    it("returns empty character vector", {
      rgs <- sgl_to_rgs("
				visualize
					hp as x,
					mpg as y
				from cars
				using line
			")
      layer <- rgs$layers[[1]]
      line <- layer$geom_expr$geom
      scales <- rgs$scales
      dfs <- result_dfs(rgs, test_con)
      df <- dfs[[1]]

      expect_equal(
        group_aes_cols(line, layer, df, scales),
        character(0)
      )
    })
  })
  describe("color is present", {
    it("returns color mapping col name", {
      rgs <- sgl_to_rgs("
				visualize
					hp as x,
					mpg as y,
					bin(wt) as color
				from cars
				using line
				scale by
					log(color)
			")
      layer <- rgs$layers[[1]]
      line <- layer$geom_expr$geom
      scales <- rgs$scales
      dfs <- result_dfs(rgs, test_con)
      df <- dfs[[1]]

      expect_equal(
        group_aes_cols(line, layer, df, scales),
        "rsgl.log.bin.30.wt"
      )
    })
  })
})

test_that(
  "ggplot_aes returns correct aes with grouping for x and y aesthetics",
  {
    rgs <- sgl_to_rgs("
			visualize
				day as x,
				letter as y
			from synth
			using line
		")
    dfs <- result_dfs(rgs, test_con)
    df <- dfs[[1]]
    layer <- rgs$layers[[1]]

    actual_aes <- ggplot_aes(layer$geom_expr$geom, layer, df, rgs$scales)

    expect_equal(class(actual_aes)[1], "ggplot2::mapping")
    expect_equal(names(actual_aes), c("x", "y", "group"))
    expect_equal(ggplot2::as_label(actual_aes$x), "day")
    expect_equal(ggplot2::as_label(actual_aes$y), "letter")
    expect_equal(actual_aes$group, "1")
  }
)

test_that(
  "ggplot_aes returns correct aes with grouping for color aesthetic",
  {
    rgs <- sgl_to_rgs("
			visualize
				day as x,
				letter as y,
				bin(wt) as color
			from synth
			using line
			scale by
				log(color)
		")
    dfs <- result_dfs(rgs, test_con)
    df <- dfs[[1]]
    layer <- rgs$layers[[1]]

    actual_aes <- ggplot_aes(layer$geom_expr$geom, layer, df, rgs$scales)

    expect_equal(class(actual_aes)[1], "ggplot2::mapping")
    expect_equal(names(actual_aes), c("x", "y", "colour", "group"))
    expect_equal(
      ggplot2::as_label(actual_aes$colour),
      "rsgl.log.bin.30.wt"
    )
    expect_equal(
      ggplot2::as_label(actual_aes$group),
      "rsgl.log.bin.30.wt"
    )
  }
)

test_that("ggplot_aes maps to cta generated columns correctly", {
  rgs <- sgl_to_rgs("
    visualize
      bin(mpg, 5) as x,
      count(*) as y
    from cars
		group by
			bin(mpg)
    using line
		scale by
			log(x)
  ")
  dfs <- result_dfs(rgs, test_con)
  df <- dfs[[1]]
  layer <- rgs$layers[[1]]

  actual_aes <- ggplot_aes(layer$geom_expr$geom, layer, df, rgs$scales)

  expect_equal(class(actual_aes)[1], "ggplot2::mapping")
  expect_equal(names(actual_aes), c("x", "y", "group"))
  expect_equal(ggplot2::as_label(actual_aes$x), "rsgl.log.bin.5.mpg")
  expect_equal(ggplot2::as_label(actual_aes$y), "rsgl.count")
  expect_equal(actual_aes$group, "1")
})

test_that("ggplot_aes replaces theta and r with x and y", {
  rgs <- sgl_to_rgs("
    visualize
      hp as theta,
      mpg as r
    from cars
    using line
  ")
  dfs <- result_dfs(rgs, test_con)
  df <- dfs[[1]]
  layer <- rgs$layers[[1]]

  actual_aes <- ggplot_aes(layer$geom_expr$geom, layer, df, rgs$scales)

  expect_equal(names(actual_aes), c("x", "y", "group"))
  expect_equal(ggplot2::as_label(actual_aes$x), "hp")
  expect_equal(ggplot2::as_label(actual_aes$y), "mpg")
})

test_that("ggplot_aes adds blank mapping for omitted y aesthetic", {
  rgs <- sgl_to_rgs("
    visualize
      mpg as x
    from cars
    using line
  ")
  dfs <- result_dfs(rgs, test_con)
  df <- dfs[[1]]
  layer <- rgs$layers[[1]]

  actual_aes <- ggplot_aes(layer$geom_expr$geom, layer, df, rgs$scales)

  expect_equal(names(actual_aes), c("x", "y", "group"))
  expect_equal(ggplot2::as_label(actual_aes$x), "mpg")
  expect_equal(actual_aes$y, "")
})

test_that("ggplot_aes adds blank mapping for omitted x aesthetic", {
  rgs <- sgl_to_rgs("
    visualize
      mpg as y
    from cars
    using line
  ")
  dfs <- result_dfs(rgs, test_con)
  df <- dfs[[1]]
  layer <- rgs$layers[[1]]

  actual_aes <- ggplot_aes(layer$geom_expr$geom, layer, df, rgs$scales)

  expect_equal(names(actual_aes), c("x", "y", "group"))
  expect_equal(actual_aes$x, "")
  expect_equal(ggplot2::as_label(actual_aes$y), "mpg")
})

test_that("ggplot_aes adds blank mapping for omitted r aesthetic", {
  rgs <- sgl_to_rgs("
    visualize
      mpg as theta
    from cars
    using line
  ")
  dfs <- result_dfs(rgs, test_con)
  df <- dfs[[1]]
  layer <- rgs$layers[[1]]

  actual_aes <- ggplot_aes(layer$geom_expr$geom, layer, df, rgs$scales)

  expect_equal(names(actual_aes), c("x", "y", "group"))
  expect_equal(ggplot2::as_label(actual_aes$x), "mpg")
  expect_equal(actual_aes$y, "")
})

test_that("ggplot_aes adds blank mapping for omitted theta aesthetic", {
  rgs <- sgl_to_rgs("
    visualize
      mpg as r
    from cars
    using line
  ")
  dfs <- result_dfs(rgs, test_con)
  df <- dfs[[1]]
  layer <- rgs$layers[[1]]

  actual_aes <- ggplot_aes(layer$geom_expr$geom, layer, df, rgs$scales)

  expect_equal(names(actual_aes), c("x", "y", "group"))
  expect_equal(actual_aes$x, "")
  expect_equal(ggplot2::as_label(actual_aes$y), "mpg")
})

test_that("ggplot_aes includes collection in group aes", {
  rgs <- sgl_to_rgs("
    visualize
      hp as x,
      mpg as y
    from cars
    collect by
      vs
    using lines
  ")
  dfs <- result_dfs(rgs, test_con)
  df <- dfs[[1]]
  layer <- rgs$layers[[1]]

  actual_aes <- ggplot_aes(layer$geom_expr$geom, layer, df, rgs$scales)

  expect_true("group" %in% names(actual_aes))
  expect_equal(ggplot2::as_label(actual_aes$group), "vs")
})

test_that("ggplot_aes includes unmapped transformed collection in group aes", {
  rgs <- sgl_to_rgs("
    visualize
      bin(mpg) as x,
      count(*) as y
    from cars
    group by
      bin(mpg),
      bin(hp, 5)
    collect by
      bin(hp, 5)
    using lines
  ")
  dfs <- result_dfs(rgs, test_con)
  df <- dfs[[1]]
  layer <- rgs$layers[[1]]

  actual_aes <- ggplot_aes(layer$geom_expr$geom, layer, df, rgs$scales)

  expect_true("group" %in% names(actual_aes))
  expect_equal(ggplot2::as_label(actual_aes$group), "rsgl.linear.bin.5.hp")
})

test_that("ggplot_aes includes mapped transformed collection in group aes", {
  rgs <- sgl_to_rgs("
    visualize
      bin(mpg) as x,
      count(*) as y,
      bin(hp) as color
    from cars
    group by
      bin(mpg),
      bin(hp)
    collect by
      bin(hp)
    using lines
    scale by
      log(color)
  ")
  dfs <- result_dfs(rgs, test_con)
  df <- dfs[[1]]
  layer <- rgs$layers[[1]]

  actual_aes <- ggplot_aes(layer$geom_expr$geom, layer, df, rgs$scales)

  expect_true("group" %in% names(actual_aes))
  expect_equal(ggplot2::as_label(actual_aes$group), "rsgl.log.bin.30.hp")
})

test_that("ggplot_aes includes multiple collections in group aes", {
  rgs <- sgl_to_rgs("
    visualize
      hp as x,
      mpg as y
    from cars
    collect by
      vs,
      am
    using lines
  ")
  dfs <- result_dfs(rgs, test_con)
  df <- dfs[[1]]
  layer <- rgs$layers[[1]]

  actual_aes <- ggplot_aes(layer$geom_expr$geom, layer, df, rgs$scales)

  expect_true("group" %in% names(actual_aes))
  expect_equal(ggplot2::as_label(actual_aes$group), "interaction(am, vs)")
})

test_that(
  paste(
    "ggplot_aes includes both scales for mapped",
    "transformed collection in group aes"
  ),
  {
    rgs <- sgl_to_rgs("
			visualize
				bin(mpg) as x,
				count(*) as y,
				bin(mpg) as color
			from cars
			group by
				bin(mpg)
			collect by
				bin(mpg)
			using lines
			scale by
				log(color)
		")
    dfs <- result_dfs(rgs, test_con)
    df <- dfs[[1]]
    layer <- rgs$layers[[1]]

    actual_aes <- ggplot_aes(layer$geom_expr$geom, layer, df, rgs$scales)

    expect_true("group" %in% names(actual_aes))
    expect_equal(
      ggplot2::as_label(actual_aes$group),
      "interaction(rsgl.log.bin.30.mpg, rsgl.linear.bin.30.mpg)"
    )
  }
)

describe("has_direction", {
  it("returns TRUE", {
    line <- new_sgl_geom_line()
    expect_true(
      has_direction(line)
    )
  })
})

describe("ggplot_dir_from_qual", {
  it("returns x for horizontal qual", {
    line <- new_sgl_geom_line()
    expect_equal(
      ggplot_dir_from_qual(line, "horizontal"),
      "x"
    )
  })
  it("returns y for vertical qual", {
    line <- new_sgl_geom_line()
    expect_equal(
      ggplot_dir_from_qual(line, "vertical"),
      "y"
    )
  })
})