AIDA
Analysis of Interval DAta

Package index
Search the AIDA package
Vignettes
Functions
127
Source code
27
Man pages
73
Home
/
CRAN
/
AIDA
/
tests/testthat/test-intData_class.R

tests/testthat/test-intData_class.R
In AIDA: Analysis of Interval DAta 

library(testthat)

test_that("intData constructor and accessors", {
	Data <- data.frame(L1 = c(1,2,3), U1 = c(2,3,4), L2 = c(0,1,2), U2 = c(1,2,3))
	obj <- intData(Data, Seq = "LbUb_VarbyVar", VarNames = c("A","B"))
obj[1,1]
	expect_s4_class(obj, "intData")
	expect_equal(nrow(obj), 3)
	expect_equal(ncol(obj), 2)
	expect_equal(colnames(obj), c("A","B"))
	expect_equal(rownames(obj), as.character(1:3))

	expected_centers <- data.frame(A.Centers = c(1.5,2.5,3.5), B.Centers = c(0.5,1.5,2.5), row.names = as.character(1:3), check.names = FALSE)
	expect_equal(Centers(obj), expected_centers)

	expected_ranges <- data.frame(A.Ranges = c(1,1,1), B.Ranges = c(1,1,1), row.names = as.character(1:3), check.names = FALSE)
	expect_equal(Ranges(obj), expected_ranges)

	expected_lb <- data.frame(A.Lbnd = c(1,2,3), B.Lbnd = c(0,1,2), row.names = as.character(1:3), check.names = FALSE)
	expect_equal(LowerBounds(obj), expected_lb)

	expected_ub <- data.frame(A.Ubnd = c(2,3,4), B.Ubnd = c(1,2,3), row.names = as.character(1:3), check.names = FALSE)
	expect_equal(UpperBounds(obj), expected_ub)
})

test_that("intData constructor errors on invalid Data inputs", {
  expect_error(intData(1:3), "must be a data frame or a matrix")

  bad <- data.frame(a = 1:3, b = 2:4, c = 3:5)
  expect_error(intData(bad), "must be an even number")

  bad2 <- data.frame(L1 = c(1,2), U1 = c(2, NA), L2 = c(0,1), U2 = c(1,2))
  expect_error(intData(bad2, Seq = "LbUb_VarbyVar"), "Invalid data")
})

test_that("intData reads correctly a data frame of lower and upper bounds presented variable by variable", {

  Xbnds <- data.frame(XLB=c(1,2,4),XUB=c(9,7,6),row.names=paste("Unit",1:3))
  Ybnds <- data.frame(YLB=c(10,3,5),YUB=c(15,8,6),row.names=paste("Unit",1:3))
  Allbnds <- cbind(Xbnds,Ybnds)

  Idt <- intData(Allbnds,VarNames = c("X","Y"),Seq="LbUb_VarbyVar")
  
  expect_equal(nrow(Idt),3)
  expect_equal(ncol(Idt),2)
  expect_equal(row.names(Idt),row.names(Allbnds))
  expect_equal(rownames(Idt),rownames(Allbnds))
  
  X.Centers <- (Xbnds$XLB + Xbnds$XUB) /2 
  Y.Centers <- (Ybnds$YLB + Ybnds$YUB) /2 
  AllCenters <- as.data.frame(cbind(X.Centers,Y.Centers))
  row.names(AllCenters) <- row.names(Allbnds)

  expect_identical(Centers(Idt),AllCenters)
    
  X.Ranges <- Xbnds$XUB - Xbnds$XLB 
  Y.Ranges <- Ybnds$YUB - Ybnds$YLB
  AllRanges <- as.data.frame(cbind(X.Ranges,Y.Ranges))
  row.names(AllRanges) <- row.names(Allbnds)
  
  expect_identical(Ranges(Idt),AllRanges)
  
} )

test_that("intData reads correctly a data frame of all lower bounds followed by all upper bounds", {
  
  Lbnds <- data.frame(XLB=c(1,2,4),YLB=c(10,3,5),row.names=paste("Unit",1:3))
  Ubnds <- data.frame(XUB=c(9,7,6),YUB=c(15,8,6),row.names=paste("Unit",1:3))
  Allbnds <- cbind(Lbnds,Ubnds)
  
  Idt <- intData(Allbnds,Seq="AllLb_AllUb",VarNames = c("X","Y"))
  
  expect_equal(nrow(Idt),3)
  expect_equal(ncol(Idt),2)
  expect_equal(row.names(Idt),row.names(Allbnds))
  expect_equal(rownames(Idt),rownames(Allbnds))
  
  X.Centers <- (Lbnds$XLB + Ubnds$XUB) /2 
  Y.Centers <- (Lbnds$YLB + Ubnds$YUB) /2 
  AllCenters <- as.data.frame(cbind(X.Centers,Y.Centers))
  row.names(AllCenters) <- row.names(Allbnds)
  
  expect_identical(Centers(Idt),AllCenters)
  
  X.Ranges <- Ubnds$XUB - Lbnds$XLB
  Y.Ranges <- Ubnds$YUB - Lbnds$YLB
  AllRanges <- as.data.frame(cbind(X.Ranges,Y.Ranges))
  row.names(AllRanges) <- row.names(Allbnds)
  
  expect_identical(Ranges(Idt),AllRanges)
  
} )

test_that("intData reads correctly a data frame of Centersoints and Rangesanges presented variable by variable", {
  
  Xbnds <- data.frame(XLB=c(1,2,4),XUB=c(9,7,6),row.names=paste("Unit",1:3))
  Ybnds <- data.frame(YLB=c(10,3,5),YUB=c(15,8,6),row.names=paste("Unit",1:3))
  X.Centers <- (Xbnds$XLB + Xbnds$XUB) /2 
  Y.Centers <- (Ybnds$YLB + Ybnds$YUB) /2 
  X.Ranges <- Xbnds$XUB - Xbnds$XLB
  Y.Ranges <- Ybnds$YUB - Ybnds$YLB
  RangesDF <- data.frame(cbind(X.Centers,X.Ranges,Y.Centers,Y.Ranges),row.names=rownames(Xbnds))
  
  Idt <- intData(RangesDF,Seq="CenRng_VarbyVar",VarNames = c("X","Y"))
  
  expect_equal(nrow(Idt),3)
  expect_equal(ncol(Idt),2)
  expect_equal(row.names(Idt),row.names(Xbnds))
  expect_equal(rownames(Idt),rownames(Xbnds))
  
  AllCenters <- as.data.frame(cbind(X.Centers,Y.Centers))
  row.names(AllCenters) <- row.names(Xbnds)
  expect_identical(Centers(Idt),AllCenters)
  
  AllRanges <- as.data.frame(cbind(X.Ranges,Y.Ranges))
  row.names(AllRanges) <- row.names(Xbnds)
  expect_identical(Ranges(Idt),AllRanges)
  
} )

test_that("intData reads correctly a data frame of all Centers followed by all Ranges", {
  
  Xbnds <- data.frame(XLB=c(1,2,4),XUB=c(9,7,6),row.names=paste("Unit",1:3))
  Ybnds <- data.frame(YLB=c(10,3,5),YUB=c(15,8,6),row.names=paste("Unit",1:3))
  X.Centers <- (Xbnds$XLB + Xbnds$XUB) /2 
  Y.Centers <- (Ybnds$YLB + Ybnds$YUB) /2 
  X.Ranges <- Xbnds$XUB - Xbnds$XLB
  Y.Ranges <- Ybnds$YUB - Ybnds$YLB 

  AllCenters <- as.data.frame(cbind(X.Centers,Y.Centers))
  row.names(AllCenters) <- row.names(Xbnds)
  AllRanges <- as.data.frame(cbind(X.Ranges,Y.Ranges))
  row.names(AllRanges) <- row.names(Xbnds)
  RangesDF <- cbind(AllCenters,AllRanges)
  
  Idt <- intData(RangesDF,Seq="AllCen_AllRng",VarNames = c("X","Y"))
  
  expect_equal(nrow(Idt),3)
  expect_equal(ncol(Idt),2)
  expect_equal(row.names(Idt),row.names(Xbnds))
  expect_equal(rownames(Idt),rownames(Xbnds))
  
  expect_identical(Centers(Idt),AllCenters)
  expect_identical(Ranges(Idt),AllRanges)
  
} )

test_that("rbind works correctly with two arguments", {
  
  Idt1 <- intData(data.frame(list(c(1,2,4),c(9,7,6),c(1,3,4),c(9,8,6))),VarNames=c("X","Y"), ObsNames = c("A","B","C"))
  Idt2 <- intData(data.frame(list(c(3,8,4),c(5,9,7)),c(2,6,3),c(7,8,4)),VarNames=c("X","Y"), ObsNames = c("D","E","F"))
  Idt12 <- intData(data.frame(list(c(1,2,4,3,8,4),c(9,7,6,5,9,7),c(1,3,4,2,6,3),c(9,8,6,7,8,4))),
                 VarNames=c("X","Y"),ObsNames = c("A","B","C","D","E","F"))
  
  expect_identical(rbind(Idt1,Idt2),Idt12)
  
  
  Idt1 <- intData(data.frame(list(c(1,2,4),c(9,7,6),c(1,3,4),c(9,8,6))),VarNames=c("X","Y"))
  Idt2 <- intData(data.frame(list(c(3,8,4),c(5,9,7)),c(2,6,3),c(7,8,4)),VarNames=c("X","Y"))
  Idt12 <- intData(data.frame(list(c(1,2,4,3,8,4),c(9,7,6,5,9,7),c(1,3,4,2,6,3),c(9,8,6,7,8,4))),
                 VarNames=c("X","Y"),ObsNames = as.character(c(1,2,3,11,21,31)))
  
  expect_identical(rbind(Idt1,Idt2),Idt12)
} )

test_that("rbind works correctly with more than two arguments", {
  
  Idt1 <- intData(data.frame(list(c(1,2,4),c(9,7,6),c(1,3,4),c(9,8,6))),VarNames=c("X","Y"), ObsNames = c("A","B","C"))
  Idt2 <- intData(data.frame(list(c(3,8,4),c(5,9,7)),c(2,6,3),c(7,8,4)),VarNames=c("X","Y"), ObsNames = c("D","E","F"))
  Idt3 <- intData(data.frame(list(2,3,6,8)),VarNames=c("X","Y"), ObsNames = "G")
  Idt123 <- intData(data.frame(list(c(1,2,4,3,8,4,2),c(9,7,6,5,9,7,3),c(1,3,4,2,6,3,6),c(9,8,6,7,8,4,8))),
                 VarNames=c("X","Y"),ObsNames = c("A","B","C","D","E","F","G"))
  
  expect_identical(rbind(Idt1,Idt2,Idt3),Idt123)
  
} )

test_that("row-only indexing works correctly for intData objects", {

  Xbnds <- data.frame(XLB=c(1,2,4),XUB=c(9,7,6),row.names=paste("Unit",1:3))
  Ybnds <- data.frame(YLB=c(10,3,5),YUB=c(15,8,6),row.names=paste("Unit",1:3))
  Allbnds <- cbind(Xbnds,Ybnds)
  Idt <- intData(Allbnds,VarNames = c("X","Y"))

  Idt2 <- intData(Allbnds[2,],VarNames = c("X","Y"))

  Idt13 <- intData(Allbnds[c(1,3),],VarNames = c("X","Y"))
  Idt31 <- intData(Allbnds[c(3,1),],VarNames = c("X","Y"))
  Idt23 <- intData(Allbnds[2:3,],VarNames = c("X","Y"))
  Idt32 <- intData(Allbnds[3:2,],VarNames = c("X","Y"))
  
  expect_identical(Idt[2,],Idt2)
  expect_identical(Idt[-c(1,3),],Idt2)
  expect_identical(Idt[c(1,3),],Idt13)
  expect_identical(Idt[-2,],Idt13)
  expect_identical(Idt[c(3,1),],Idt31)
  expect_identical(Idt[2:3,],Idt23)
  expect_identical(Idt[-1,],Idt23)
  expect_identical(Idt[3:2,],Idt32)

} )

test_that("column-only indexing works correctly for intData objects", {
  
  Lbnds <- data.frame(XLB=c(1,2,4),YLB=c(10,3,5),ZLB=c(8,5,4),row.names=paste("Unit",1:3))
  Ubnds <- data.frame(XUB=c(9,7,6),YUB=c(15,8,6),ZUB=c(12,9,7),row.names=paste("Unit",1:3))
  Idt <- intData(cbind(Lbnds,Ubnds),Seq="AllLb_AllUb",VarNames = c("X","Y","Z"))
  
  Idt2 <- intData(cbind(Lbnds[,2,drop=FALSE],Ubnds[,2,drop=FALSE]),Seq="AllLb_AllUb",VarNames = "Y")
  Idt13 <- intData(cbind(Lbnds[,c(1,3)],Ubnds[,c(1,3)]),Seq="AllLb_AllUb",VarNames = c("X","Z"))
  Idt31 <- intData(cbind(Lbnds[,c(3,1)],Ubnds[,c(3,1)]),Seq="AllLb_AllUb",VarNames = c("Z","X"))
  Idt23 <- intData(cbind(Lbnds[,2:3],Ubnds[,2:3]),Seq="AllLb_AllUb",VarNames = c("Y","Z"))
  Idt32 <- intData(cbind(Lbnds[,3:2],Ubnds[,3:2]),Seq="AllLb_AllUb",VarNames = c("Z","Y"))
  
  expect_identical(Idt[,2],Idt2)
  expect_identical(Idt[,-c(1,3)],Idt2)
  expect_identical(Idt[,c(1,3)],Idt13)
  expect_identical(Idt[,-2],Idt13)
  expect_identical(Idt[,c(3,1)],Idt31)
  expect_identical(Idt[,2:3],Idt23)
  expect_identical(Idt[,-1],Idt23)
  expect_identical(Idt[,3:2],Idt32)
  
} )

test_that("indexing by both rows and columns works correctly for intData objects", {
  
  Lbnds <- data.frame(XLB=c(1,2,4),YLB=c(10,3,5),ZLB=c(8,5,4),row.names=paste("Unit",1:3))
  Ubnds <- data.frame(XUB=c(9,7,6),YUB=c(15,8,6),ZUB=c(12,9,7),row.names=paste("Unit",1:3))
  Idt <- intData(cbind(Lbnds,Ubnds),Seq="AllLb_AllUb",VarNames = c("X","Y","Z"))
  
  Idtr2c3 <- intData(cbind(Lbnds[2,3,drop=FALSE],Ubnds[2,3,drop=FALSE]),Seq="AllLb_AllUb",VarNames = "Z")
  Idtr2c13 <- intData(cbind(Lbnds[2,c(1,3),drop=FALSE],Ubnds[2,c(1,3)]),Seq="AllLb_AllUb",VarNames = c("X","Z"))
  Idtr13c2 <- intData(cbind(Lbnds[c(1,3),2,drop=FALSE],Ubnds[c(1,3),2]),Seq="AllLb_AllUb",VarNames = "Y")
  Idtr13c21 <- intData(cbind(Lbnds[c(1,3),2:1],Ubnds[c(1,3),2:1]),Seq="AllLb_AllUb",VarNames = c("Y","X"))
  Idtr32c12 <- intData(cbind(Lbnds[3:2,1:2],Ubnds[3:2,1:2]),Seq="AllLb_AllUb",VarNames = c("X","Y"))
  
  expect_identical(Idt[2,3],Idtr2c3)
  expect_identical(Idt[-c(1,3),3],Idtr2c3)
  expect_identical(Idt[2,-(1:2)],Idtr2c3)
  expect_identical(Idt[-c(1,3),-c(1,2)],Idtr2c3)

  expect_identical(Idt[2,c(1,3)],Idtr2c13)
  expect_identical(Idt[-c(1,3),c(1,3)],Idtr2c13)
  expect_identical(Idt[2,-2],Idtr2c13)
  expect_identical(Idt[-c(1,3),-2],Idtr2c13)
  
  expect_identical(Idt[c(1,3),2],Idtr13c2)
  expect_identical(Idt[-2,2],Idtr13c2)
  expect_identical(Idt[c(1,3),-c(1,3)],Idtr13c2)
  expect_identical(Idt[-2,-c(1,3)],Idtr13c2)
  
  expect_identical(Idt[c(1,3),2:1],Idtr13c21)
  expect_identical(Idt[-2,2:1],Idtr13c21)

  expect_identical(Idt[3:2,1:2],Idtr32c12)
  expect_identical(Idt[3:2,-3],Idtr32c12)

} )

test_that("intData LatentParam validation", {
  Data <- data.frame(L1 = c(1,2), U1 = c(2,3))
  expect_error(intData(Data, LatentParam = 1, LatentDist = "Unif"), "`LatentParam` must be either")
  expect_error(intData(Data, LatentParam = list(1)), "Error: If LatentParam is provided, LatentDist must also be provided.")
  obj <- intData(Data, LatentParam = list(1), LatentDist = "Unif")
  expect_equal(LatentCase(obj), "U_id_symmetric")
})

test_that("NbMicroUnits handling", {
  Data <- data.frame(L1 = 1:3, U1 = 2:4)
  obj <- intData(Data, VarNames = "X", NbMicroUnits = 3)
  expect_identical(NbMicroUnits(obj), as.integer(3))
  obj2 <- intData(Data, VarNames = "X")
  expect_null(NbMicroUnits(obj2))
})

test_that("bounds and log ranges", {
  Data <- data.frame(L1 = c(1,2), U1 = c(3,4))
  obj <- intData(Data, VarNames = "X")
  expect_equal(names(LowerBounds(obj)), "X.Lbnd")
  expect_equal(names(UpperBounds(obj)), "X.Ubnd")
  expect_equal(as.numeric(LogRanges(obj)[,1]), as.numeric(log(Ranges(obj)[,1])))
})

test_that("head and tail behavior", {
  Data <- data.frame(L1 = 1:5, U1 = 2:6)
  obj <- intData(Data, VarNames = "X")
  expect_identical(head(obj, n = 2), obj[1:2, ])
  expect_identical(tail(obj, n = 1), obj[nrow(obj), ])
})

test_that("plot error conditions for too many variables", {
  Data <- data.frame(L1 = 1:3, U1 = 2:4, L2 = 1:3, U2 = 2:4, L3 = 1:3, U3 = 2:4)
  obj3 <- intData(Data, VarNames = c("X","Y","Z"))
  expect_error(plot(obj3), "Currently method plot can only plot at most two interval variables")

  obj2 <- intData(Data[,1:4], VarNames = c("X","Y"))
  expect_error(plot(obj2, obj2), "Currently intData method plot can plot only one integer variable on the horizontal axis")
})

test_that("summary and show output", {
  Data <- data.frame(L1 = 1:2, U1 = 2:3)
  obj <- intData(Data, VarNames = "X", ObsNames = c("A","B"))
  expect_output(summary(obj), "Centers summary:")
  expect_output(show(obj), "A")
})

test_that("equality comparison and errors", {
  Data <- data.frame(L1 = 1:2, U1 = 2:3)
  a <- intData(Data, VarNames = "X")
  b <- intData(Data, VarNames = "X")
  eq <- a == b
  expect_true(all(eq))
  expect_error(a == 1, "comparison")
  c <- intData(data.frame(L1 = 1:3, U1 = 2:4), VarNames = "X")
  expect_error(a == c, "== only defined for equally-sized intData objects")
})

test_that("inequality comparison and errors", {
  Data <- data.frame(L1 = 1:2, U1 = 2:3)
  a <- intData(Data, VarNames = "X")
  b <- intData(Data, VarNames = "X")
  neq <- a != b
  expect_true(all(!neq))
  expect_error(a != 1, "comparison")
  c <- intData(data.frame(L1 = 1:3, U1 = 2:4), VarNames = "X")
  expect_error(a != c, "!= only defined for equally-sized intData objects")
})

test_that("indexing by character and numeric names", {
  Data <- data.frame(L1 = c(1,2,3), U1 = c(2,3,4))
  obj <- intData(Data, VarNames = "X", ObsNames = c("one","two","three"))
  expect_identical(obj["two", ], obj[2, ])
  expect_identical(obj[, "X"], obj[,1])
})

test_that("General latent case subsetting preserves LatentParam matrices", {
  Data <- data.frame(L1 = 1:3, U1 = 2:4, L2 = 2:4, U2 = 3:5)
  mat1 <- matrix(c(1,0,0,1),2,2)
  mat2 <- matrix(c(2,0,0,2),2,2)
  obj <- intData(Data, VarNames = c("A","B"), LatentParam = list(mat1, mat2), LatentCase = "General", LatentDist = c("Unif","Triang"))
  sub <- obj[, "A"]
  lp <- LatentParam(sub)
  expect_true(is.list(lp) && is.matrix(lp[[1]]) && dim(lp[[1]])[1]==1)
  expect_equal(as.numeric(lp[[1]]), as.numeric(mat1[1,1]))
  expect_equal(LatentDist(sub), "Unif")
})

test_that("plotting branches run without error (two-object and single-object)", {
  Data <- data.frame(L1 = c(1,2,3), U1 = c(2,3,4))
  x <- intData(Data, VarNames = "X")
  y <- intData(Data, VarNames = "Y")
  # two-object plots (NIVar must be 1)
  png(filename = tempfile(fileext = ".png"))
  expect_silent(plot(x, x, type = "crosses"))
  expect_silent(plot(x, x, type = "rectangles"))
  expect_silent(plot(x, x, type = "crosses2"))
  dev.off()

  # single-object plots vertical/horizontal with append
  png(filename = tempfile(fileext = ".png"))
  expect_silent(plot(x, layout = "vertical"))
  expect_silent(plot(x, layout = "horizontal", append = TRUE))
  dev.off()
})

test_that("rbind errors on mismatched properties", {
  Data1 <- data.frame(L1 = 1:2, U1 = 2:3)
  Data2 <- data.frame(L1 = 1:3, U1 = 2:4, L2 = 8:6, U2 = 11:13)
  a <- intData(Data1, VarNames = "X", LatentParam = list(1), LatentDist = "Unif")
  a@ObsNames <- c("a.1","a.2")
  b <- intData(Data2, VarNames = "X", LatentParam = list(1), LatentDist = "Unif")
  expect_error(rbind(a, b), "Arguments x and y have a different number of interval-valued variables|== only defined for equally-sized intData objects")

  # different LatentDist
  c <- intData(Data1, VarNames = "X", LatentParam = list(1), LatentDist = "Triang")
  expect_error(rbind(a, c), "Arguments x and y have different LatentDist")
})

test_that("basic accessors and names/dim methods", {
  Data <- data.frame(L1 = 1:4, U1 = 2:5, L2 = 3:6, U2 = 4:7)
  obj <- intData(Data, VarNames = c("X","Y"), ObsNames = c("a","b","c","d"), Seq = "LbUb_VarbyVar")
  expect_equal(nrow(obj), 4)
  expect_equal(ncol(obj), 2)
  expect_equal(dim(obj), c(4,2))
  expect_equal(rownames(obj), c("a","b","c","d"))
  expect_equal(colnames(obj), c("X","Y"))
  expect_equal(names(obj), c("X","Y"))
  expect_equal(Centers(obj)[1,1], (1+2)/2)
})

Try the AIDA package in your browser

Any scripts or data that you put into this service are public.

AIDA documentation built on Nov. 4, 2026, 9:06 a.m.

R Package Documentation

rdrr.io home R language documentation Run R code online

Browse R Packages

CRAN packages Bioconductor packages R-Forge packages GitHub packages

We want your feedback!

Note that we can't provide technical support on individual packages. You should contact the package authors for that.
GitHub issue tracker
ian@mutexlabs.com
Personal blog

 
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.

Close