tests/testthat/test-primary-table-name.R

In REDCapCAST: REDCap Metadata Casting and Castellated Data Handling

## "Primary table name processing"


# Global  variables -------------------------------------------------------
metadata <-
  jsonlite::fromJSON(get_data_location("ExampleProject_metadata.json"))

records <-
  jsonlite::fromJSON(get_data_location("ExampleProject_records.json"))

# ref_hash <- "2c8b6531597182af1248f92124161e0c"

# Tests -------------------------------------------------------------------
test_that("Will not use a repeating instrument name for primary table", {
  # local_edition(3)
  #

  expect_warning(
    REDCap_split(records, metadata, "sale"),
    "primary table"
  )

  redcap_output_json1 <-
    suppressWarnings(REDCap_split(records, metadata, "sale"))

  # dput(redcap_output_json1)
  expect_identical(
    redcap_output_json1,
    list(structure(list(
      row = c(
        "AMC Javelin", "Cadillac Fleetwood",
        "Camaro Z28", "Chrysler Imperial", "Datsun 710", "Dodge Challenger",
        "Duster 360", "Ferrari Dino", "Fiat 128", "Fiat X1-9", "Ford Pantera L",
        "Honda Civic", "Hornet 4 Drive", "Hornet Sportabout", "Lincoln Continental",
        "Lotus Europa", "Maserati Bora", "Mazda RX4", "Mazda RX4 Wag",
        "Merc 230", "Merc 240D", "Merc 280", "Merc 280C", "Merc 450SE",
        "Merc 450SL", "Merc 450SLC", "Pontiac Firebird", "Porsche 914-2",
        "Toyota Corolla", "Toyota Corona", "Valiant", "Volvo 142E"
      ),
      mpg = c(
        "15.2", "10.4", "13.3", "14.7", "22.8", "15.5", "14.3",
        "19.7", "32.4", "27.3", "15.8", "30.4", "21.4", "18.7", "10.4",
        "30.4", "15", "21", "21", "22.8", "24.4", "19.2", "17.8",
        "16.4", "17.3", "15.2", "19.2", "26", "33.9", "21.5", "18.1",
        "21.4"
      ), cyl = c(
        "8", "8", "8", "8", "4", "8", "8", "6",
        "4", "4", "8", "4", "6", "8", "8", "4", "8", "6", "6", "4",
        "4", "6", "6", "8", "8", "8", "8", "4", "4", "4", "6", "4"
      ), disp = c(
        "304", "472", "350", "440", "108", "318", "360",
        "145", "78.7", "79", "351", "75.7", "258", "360", "460",
        "95.1", "301", "160", "160", "140.8", "146.7", "167.6", "167.6",
        "275.8", "275.8", "275.8", "400", "120.3", "71.1", "120.1",
        "225", "121"
      ), hp = c(
        "150", "205", "245", "230", "93", "150",
        "245", "175", "66", "66", "264", "52", "110", "175", "215",
        "113", "335", "110", "110", "95", "62", "123", "123", "180",
        "180", "180", "175", "91", "65", "97", "105", "109"
      ), drat = c(
        "3.15",
        "2.93", "3.73", "3.23", "3.85", "2.76", "3.21", "3.62", "4.08",
        "4.08", "4.22", "4.93", "3.08", "3.15", "3", "3.77", "3.54",
        "3.9", "3.9", "3.92", "3.69", "3.92", "3.92", "3.07", "3.07",
        "3.07", "3.08", "4.43", "4.22", "3.7", "2.76", "4.11"
      ), wt = c(
        "3.435",
        "5.25", "3.84", "5.345", "2.32", "3.52", "3.57", "2.77",
        "2.2", "1.935", "3.17", "1.615", "3.215", "3.44", "5.424",
        "1.513", "3.57", "2.62", "2.875", "3.15", "3.19", "3.44",
        "3.44", "4.07", "3.73", "3.78", "3.845", "2.14", "1.835",
        "2.465", "3.46", "2.78"
      ), qsec = c(
        "17.3", "17.98", "15.41",
        "17.42", "18.61", "16.87", "15.84", "15.5", "19.47", "18.9",
        "14.5", "18.52", "19.44", "17.02", "17.82", "16.9", "14.6",
        "16.46", "17.02", "22.9", "20", "18.3", "18.9", "17.4", "17.6",
        "18", "17.05", "16.7", "19.9", "20.01", "20.22", "18.6"
      ),
      vs = c(
        "0", "0", "0", "0", "1", "0", "0", "0", "1", "1",
        "0", "1", "1", "0", "0", "1", "0", "0", "0", "1", "1", "1",
        "1", "0", "0", "0", "0", "0", "1", "1", "1", "1"
      ), am = c(
        "0",
        "0", "0", "0", "1", "0", "0", "1", "1", "1", "1", "1", "0",
        "0", "0", "1", "1", "1", "1", "0", "0", "0", "0", "0", "0",
        "0", "0", "1", "1", "0", "0", "1"
      ), gear = c(
        "3", "3", "3",
        "3", "4", "3", "3", "5", "4", "4", "5", "4", "3", "3", "3",
        "5", "5", "4", "4", "4", "4", "4", "4", "3", "3", "3", "3",
        "5", "4", "3", "3", "4"
      ), carb = c(
        "2", "4", "4", "4", "1",
        "2", "4", "6", "1", "1", "4", "2", "1", "2", "4", "2", "8",
        "4", "4", "2", "2", "4", "4", "3", "3", "3", "2", "2", "1",
        "1", "1", "2"
      ), color_available___red = c(
        "1", "0", "0",
        "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0",
        "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0",
        "0", "0", "0", "0", "0"
      ), color_available___green = c(
        "1",
        "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0",
        "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0",
        "0", "0", "0", "0", "0", "0", "0"
      ), color_available___blue = c(
        "1",
        "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0",
        "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0",
        "0", "0", "0", "0", "0", "0", "0"
      ), color_available___black = c(
        "0",
        "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0",
        "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0",
        "0", "0", "0", "0", "0", "0", "0"
      ), motor_trend_cars_complete = c(
        "1",
        "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0",
        "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0",
        "0", "0", "0", "0", "0", "0", "0"
      ), letter_group___a = c(
        "1",
        "0", "1", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0",
        "0", "0", "0", "0", "0", "1", "1", "0", "0", "0", "0", "0",
        "0", "0", "0", "0", "0", "0", "0"
      ), letter_group___b = c(
        "1",
        "0", "0", "1", "1", "0", "1", "0", "0", "0", "0", "0", "0",
        "0", "0", "0", "0", "0", "1", "1", "0", "0", "0", "0", "0",
        "0", "0", "0", "0", "0", "0", "0"
      ), letter_group___c = c(
        "0",
        "0", "1", "1", "1", "0", "1", "0", "0", "0", "0", "0", "0",
        "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0",
        "0", "0", "0", "0", "0", "0", "0"
      ), choice = c(
        "choice2",
        "", "choice1", "choice1", "", "", "choice1", "", "", "",
        "", "", "", "", "", "", "", "", "", "choice2", "", "", "",
        "", "", "", "", "", "", "", "", ""
      ), grouping_complete = c(
        "2",
        "0", "2", "2", "0", "0", "1", "0", "0", "0", "0", "0", "0",
        "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0",
        "0", "0", "0", "0", "0", "0", "0"
      )
    ), row.names = c(
      1L, 5L,
      6L, 9L, 11L, 12L, 13L, 18L, 19L, 20L, 21L, 22L, 23L, 24L, 25L,
      26L, 27L, 28L, 29L, 30L, 34L, 35L, 36L, 37L, 38L, 39L, 40L, 41L,
      42L, 43L, 44L, 45L
    ), class = "data.frame"), sale = structure(list(
      row = c(
        "AMC Javelin", "AMC Javelin", "AMC Javelin", "Camaro Z28",
        "Camaro Z28", "Chrysler Imperial", "Duster 360", "Duster 360",
        "Duster 360", "Duster 360", "Merc 230", "Merc 230", "Merc 230"
      ), redcap_repeat_instrument = c(
        "sale", "sale", "sale", "sale",
        "sale", "sale", "sale", "sale", "sale", "sale", "sale", "sale",
        "sale"
      ), redcap_repeat_instance = c(
        "1", "2", "3", "1", "2",
        "1", "1", "2", "3", "4", "1", "2", "3"
      ), price = c(
        "12000.50",
        "13750.77", "15004.57", "7800.00", "8000.00", "7500.00",
        "8756.40", "6800.88", "8888.88", "970.00", "7800.98", "7954.00",
        "6800.55"
      ), color = c(
        "1", "3", "2", "2", "3", "1", "4",
        "2", "1", "4", "2", "1", "3"
      ), customer = c(
        "Bob", "Sue",
        "Kim", "Janice", "Tim", "Jim", "Sarah", "Pablo", "Erica",
        "Juan", "Ted", "Quentin", "Sharon"
      ), sale_complete = c(
        "0",
        "2", "0", "2", "0", "2", "1", "0", "0", "0", "0", "0", "2"
      )
    ), row.names = c(
      2L, 3L, 4L, 7L, 8L, 10L, 14L, 15L, 16L,
      17L, 31L, 32L, 33L
    ), class = "data.frame"))
  )


  # expect_snapshot(redcap_output_json1)

  # expect_known_hash(redcap_output_json1, ref_hash)
})

test_that("Names are set correctly and output is identical", {
  # local_edition(3)
  redcap_output_json2 <- REDCap_split(records, metadata, "main")


  expect_identical(names(redcap_output_json2), c("main", "sale"))
  # expect_known_hash(setNames(redcap_output_json2, c("", "sale")), ref_hash)

  # dput(redcap_output_json2)
  expect_identical(
    redcap_output_json2,
    list(main = structure(list(
      row = c(
        "AMC Javelin", "Cadillac Fleetwood",
        "Camaro Z28", "Chrysler Imperial", "Datsun 710", "Dodge Challenger",
        "Duster 360", "Ferrari Dino", "Fiat 128", "Fiat X1-9", "Ford Pantera L",
        "Honda Civic", "Hornet 4 Drive", "Hornet Sportabout", "Lincoln Continental",
        "Lotus Europa", "Maserati Bora", "Mazda RX4", "Mazda RX4 Wag",
        "Merc 230", "Merc 240D", "Merc 280", "Merc 280C", "Merc 450SE",
        "Merc 450SL", "Merc 450SLC", "Pontiac Firebird", "Porsche 914-2",
        "Toyota Corolla", "Toyota Corona", "Valiant", "Volvo 142E"
      ),
      mpg = c(
        "15.2", "10.4", "13.3", "14.7", "22.8", "15.5", "14.3",
        "19.7", "32.4", "27.3", "15.8", "30.4", "21.4", "18.7", "10.4",
        "30.4", "15", "21", "21", "22.8", "24.4", "19.2", "17.8",
        "16.4", "17.3", "15.2", "19.2", "26", "33.9", "21.5", "18.1",
        "21.4"
      ), cyl = c(
        "8", "8", "8", "8", "4", "8", "8", "6",
        "4", "4", "8", "4", "6", "8", "8", "4", "8", "6", "6", "4",
        "4", "6", "6", "8", "8", "8", "8", "4", "4", "4", "6", "4"
      ), disp = c(
        "304", "472", "350", "440", "108", "318", "360",
        "145", "78.7", "79", "351", "75.7", "258", "360", "460",
        "95.1", "301", "160", "160", "140.8", "146.7", "167.6", "167.6",
        "275.8", "275.8", "275.8", "400", "120.3", "71.1", "120.1",
        "225", "121"
      ), hp = c(
        "150", "205", "245", "230", "93", "150",
        "245", "175", "66", "66", "264", "52", "110", "175", "215",
        "113", "335", "110", "110", "95", "62", "123", "123", "180",
        "180", "180", "175", "91", "65", "97", "105", "109"
      ), drat = c(
        "3.15",
        "2.93", "3.73", "3.23", "3.85", "2.76", "3.21", "3.62", "4.08",
        "4.08", "4.22", "4.93", "3.08", "3.15", "3", "3.77", "3.54",
        "3.9", "3.9", "3.92", "3.69", "3.92", "3.92", "3.07", "3.07",
        "3.07", "3.08", "4.43", "4.22", "3.7", "2.76", "4.11"
      ), wt = c(
        "3.435",
        "5.25", "3.84", "5.345", "2.32", "3.52", "3.57", "2.77",
        "2.2", "1.935", "3.17", "1.615", "3.215", "3.44", "5.424",
        "1.513", "3.57", "2.62", "2.875", "3.15", "3.19", "3.44",
        "3.44", "4.07", "3.73", "3.78", "3.845", "2.14", "1.835",
        "2.465", "3.46", "2.78"
      ), qsec = c(
        "17.3", "17.98", "15.41",
        "17.42", "18.61", "16.87", "15.84", "15.5", "19.47", "18.9",
        "14.5", "18.52", "19.44", "17.02", "17.82", "16.9", "14.6",
        "16.46", "17.02", "22.9", "20", "18.3", "18.9", "17.4", "17.6",
        "18", "17.05", "16.7", "19.9", "20.01", "20.22", "18.6"
      ),
      vs = c(
        "0", "0", "0", "0", "1", "0", "0", "0", "1", "1",
        "0", "1", "1", "0", "0", "1", "0", "0", "0", "1", "1", "1",
        "1", "0", "0", "0", "0", "0", "1", "1", "1", "1"
      ), am = c(
        "0",
        "0", "0", "0", "1", "0", "0", "1", "1", "1", "1", "1", "0",
        "0", "0", "1", "1", "1", "1", "0", "0", "0", "0", "0", "0",
        "0", "0", "1", "1", "0", "0", "1"
      ), gear = c(
        "3", "3", "3",
        "3", "4", "3", "3", "5", "4", "4", "5", "4", "3", "3", "3",
        "5", "5", "4", "4", "4", "4", "4", "4", "3", "3", "3", "3",
        "5", "4", "3", "3", "4"
      ), carb = c(
        "2", "4", "4", "4", "1",
        "2", "4", "6", "1", "1", "4", "2", "1", "2", "4", "2", "8",
        "4", "4", "2", "2", "4", "4", "3", "3", "3", "2", "2", "1",
        "1", "1", "2"
      ), color_available___red = c(
        "1", "0", "0",
        "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0",
        "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0",
        "0", "0", "0", "0", "0"
      ), color_available___green = c(
        "1",
        "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0",
        "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0",
        "0", "0", "0", "0", "0", "0", "0"
      ), color_available___blue = c(
        "1",
        "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0",
        "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0",
        "0", "0", "0", "0", "0", "0", "0"
      ), color_available___black = c(
        "0",
        "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0",
        "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0",
        "0", "0", "0", "0", "0", "0", "0"
      ), motor_trend_cars_complete = c(
        "1",
        "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0",
        "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0",
        "0", "0", "0", "0", "0", "0", "0"
      ), letter_group___a = c(
        "1",
        "0", "1", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0",
        "0", "0", "0", "0", "0", "1", "1", "0", "0", "0", "0", "0",
        "0", "0", "0", "0", "0", "0", "0"
      ), letter_group___b = c(
        "1",
        "0", "0", "1", "1", "0", "1", "0", "0", "0", "0", "0", "0",
        "0", "0", "0", "0", "0", "1", "1", "0", "0", "0", "0", "0",
        "0", "0", "0", "0", "0", "0", "0"
      ), letter_group___c = c(
        "0",
        "0", "1", "1", "1", "0", "1", "0", "0", "0", "0", "0", "0",
        "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0",
        "0", "0", "0", "0", "0", "0", "0"
      ), choice = c(
        "choice2",
        "", "choice1", "choice1", "", "", "choice1", "", "", "",
        "", "", "", "", "", "", "", "", "", "choice2", "", "", "",
        "", "", "", "", "", "", "", "", ""
      ), grouping_complete = c(
        "2",
        "0", "2", "2", "0", "0", "1", "0", "0", "0", "0", "0", "0",
        "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0",
        "0", "0", "0", "0", "0", "0", "0"
      )
    ), row.names = c(
      1L, 5L,
      6L, 9L, 11L, 12L, 13L, 18L, 19L, 20L, 21L, 22L, 23L, 24L, 25L,
      26L, 27L, 28L, 29L, 30L, 34L, 35L, 36L, 37L, 38L, 39L, 40L, 41L,
      42L, 43L, 44L, 45L
    ), class = "data.frame"), sale = structure(list(
      row = c(
        "AMC Javelin", "AMC Javelin", "AMC Javelin", "Camaro Z28",
        "Camaro Z28", "Chrysler Imperial", "Duster 360", "Duster 360",
        "Duster 360", "Duster 360", "Merc 230", "Merc 230", "Merc 230"
      ), redcap_repeat_instrument = c(
        "sale", "sale", "sale", "sale",
        "sale", "sale", "sale", "sale", "sale", "sale", "sale", "sale",
        "sale"
      ), redcap_repeat_instance = c(
        "1", "2", "3", "1", "2",
        "1", "1", "2", "3", "4", "1", "2", "3"
      ), price = c(
        "12000.50",
        "13750.77", "15004.57", "7800.00", "8000.00", "7500.00",
        "8756.40", "6800.88", "8888.88", "970.00", "7800.98", "7954.00",
        "6800.55"
      ), color = c(
        "1", "3", "2", "2", "3", "1", "4",
        "2", "1", "4", "2", "1", "3"
      ), customer = c(
        "Bob", "Sue",
        "Kim", "Janice", "Tim", "Jim", "Sarah", "Pablo", "Erica",
        "Juan", "Ted", "Quentin", "Sharon"
      ), sale_complete = c(
        "0",
        "2", "0", "2", "0", "2", "1", "0", "0", "0", "0", "0", "2"
      )
    ), row.names = c(
      2L, 3L, 4L, 7L, 8L, 10L, 14L, 15L, 16L,
      17L, 31L, 32L, 33L
    ), class = "data.frame"))
  )
})