Skip to content

Commit 42428d6

Browse files
lsteinmannlsteinmann
committed
get.histogramscale() function
1 parent c959575 commit 42428d6

6 files changed

Lines changed: 126 additions & 60 deletions

File tree

‎NAMESPACE‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@ export(calculate.outputrows)
44
export(create.sub.objects)
55
export(datsteps)
66
export(generate.stepsize)
7+
export(get.histogramscale)
78
export(get.step.sequence)
89
export(get.weights)
910
export(scaleweight)

‎R/datsteps.R‎

Lines changed: 61 additions & 59 deletions
Original file line numberDiff line numberDiff line change
@@ -1,59 +1,61 @@
1-
#' @title Create 'steps' of dates for each object in a dataframe
2-
#'
3-
#' @description Requires a dataframe with 4 variables: ID (ideally factor), group (ideally factor),
4-
#' minimum date (int/numeric) and maximum date (int/numeric). It's expected that dates BCE are
5-
#' displayed as negative values while dates CE are positive values. Ignoring this will cause problems
6-
#' in any case.
7-
#'
8-
#' @param DAT_df a dataframe with 4 variables: ID, group, minimum date (int/num) maximum date (int/num), _must_ be in this order, colnames are irrelevant; each object _must_ be one row.
9-
#' @param stepsize defaults to 5. Number of years that should be used as an interval for creating dating steps.
10-
#'
11-
#' @return a larger dataframe with a number of steps for each object as well as a 'weight' value, that is a quantification of how well the object is dated (lesser value means object is dated to larger timespans, i.e. with less confidence)
12-
#'
13-
#' @examples
14-
#' DAT_df_steps <- datsteps(DAT_df[1:100,], stepsize = 25)
15-
#' plot(density(DAT_df_steps$DAT_step))
16-
#'
17-
#'
18-
#' @export datsteps
19-
20-
datsteps <- function(DAT_df, stepsize = 25) {
21-
if (any(DAT_df[,3] > DAT_df[,4])) {
22-
warning(paste("Warning: Dating seems to be in wrong order at ID ", paste(DAT_df[which(DAT_df[,3] > DAT_df[,4]),1], collapse = ", "), " (Index: ",
23-
paste(which(DAT_df[,3] > DAT_df[,4]), collapse = ", "), ")",
24-
". Dates have been switched, but be sure to check your original data for possible mistakes.", sep = ""))
25-
DAT_err <- which(DAT_df[,3] > DAT_df[,4])
26-
DAT_df <- switch.dating(DAT_df, DAT_err)
27-
}
28-
29-
DAT_mat <- matrix(ncol = 5, nrow = nrow(DAT_df))
30-
DAT_mat[,1] <- 1:nrow(DAT_df)
31-
DAT_mat[,2] <- DAT_df[,3]
32-
DAT_mat[,3] <- DAT_df[,4]
33-
34-
colnames(DAT_mat) <- c("index", "datmin", "datmax", "weight", "step")
35-
36-
if (stepsize == "auto") {
37-
stepsize <- generate.stepsize(DAT_mat)
38-
} else if (!is.numeric(stepsize)) {
39-
stop(print("stepsize has to be either 'auto' or numeric."))
40-
}
41-
42-
weights <- get.weights(DAT_mat[,"datmin"], DAT_mat[,"datmax"])
43-
44-
DAT_mat[,"weight"] <- weights[,1]
45-
DAT_res <- create.sub.objects(DAT_mat, stepsize)
46-
47-
48-
result <- as.data.frame(DAT_res)
49-
50-
51-
result[,2] <- DAT_df[result[,1],2]
52-
result[,1] <- DAT_df[result[,1],1]
53-
54-
colnames(result) <- c("ID", "variable", "DAT_min", "DAT_max", "weight", "DAT_step")
55-
attr(result$DAT_step, "descr") <- "step"
56-
attr(result$weight, "descr") <- "weight"
57-
58-
return(result)
59-
}
1+
#' @title Create 'steps' of dates for each object in a dataframe
2+
#'
3+
#' @description Requires a dataframe with 4 variables: ID (ideally factor), group (ideally factor),
4+
#' minimum date (int/numeric) and maximum date (int/numeric). It's expected that dates BCE are
5+
#' displayed as negative values while dates CE are positive values. Ignoring this will cause problems
6+
#' in any case.
7+
#'
8+
#' @param DAT_df a dataframe with 4 variables: ID, group, minimum date (int/num) maximum date (int/num), _must_ be in this order, colnames are irrelevant; each object _must_ be one row.
9+
#' @param stepsize defaults to 5. Number of years that should be used as an interval for creating dating steps.
10+
#'
11+
#' @return a larger dataframe with a number of steps for each object as well as a 'weight' value, that is a quantification of how well the object is dated (lesser value means object is dated to larger timespans, i.e. with less confidence)
12+
#'
13+
#' @examples
14+
#' DAT_df_steps <- datsteps(DAT_df[1:100,], stepsize = 25)
15+
#' plot(density(DAT_df_steps$DAT_step))
16+
#'
17+
#'
18+
#' @export datsteps
19+
20+
datsteps <- function(DAT_df, stepsize = 25) {
21+
if (any(DAT_df[,3] > DAT_df[,4])) {
22+
warning(paste("Warning: Dating seems to be in wrong order at ID ", paste(DAT_df[which(DAT_df[,3] > DAT_df[,4]),1], collapse = ", "), " (Index: ",
23+
paste(which(DAT_df[,3] > DAT_df[,4]), collapse = ", "), ")",
24+
". Dates have been switched, but be sure to check your original data for possible mistakes.", sep = ""))
25+
DAT_err <- which(DAT_df[,3] > DAT_df[,4])
26+
DAT_df <- switch.dating(DAT_df, DAT_err)
27+
}
28+
29+
DAT_mat <- matrix(ncol = 5, nrow = nrow(DAT_df))
30+
DAT_mat[,1] <- 1:nrow(DAT_df)
31+
DAT_mat[,2] <- DAT_df[,3]
32+
DAT_mat[,3] <- DAT_df[,4]
33+
34+
colnames(DAT_mat) <- c("index", "datmin", "datmax", "weight", "step")
35+
36+
if (stepsize == "auto") {
37+
stepsize <- generate.stepsize(DAT_mat)
38+
} else if (!is.numeric(stepsize)) {
39+
stop(print("stepsize has to be either 'auto' or numeric."))
40+
}
41+
42+
weights <- get.weights(DAT_mat[,"datmin"], DAT_mat[,"datmax"])
43+
44+
DAT_mat[,"weight"] <- weights[,1]
45+
DAT_res <- create.sub.objects(DAT_mat, stepsize)
46+
47+
48+
result <- as.data.frame(DAT_res)
49+
50+
51+
result[,2] <- DAT_df[result[,1],2]
52+
result[,1] <- DAT_df[result[,1],1]
53+
54+
colnames(result) <- c("ID", "variable", "DAT_min", "DAT_max", "weight", "DAT_step")
55+
attr(result$DAT_step, "descr") <- "step"
56+
attr(result$weight, "descr") <- "weight"
57+
attr(result, "stepsize") <- "datplot: stepsize used to calculate DAT_step"
58+
attributes(result)$stepsize <- stepsize
59+
60+
return(result)
61+
}

‎R/get.histogramscale.R‎

Lines changed: 29 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,29 @@
1+
#' @title Scaling Factor for Combined Histogramm Plots
2+
#'
3+
#' @description Requires a dataframe as produced by datsteps(). (Meaning 6 columns in the following order: ID, group, minimum/earliest date, maximum/latest date, weight, 'DAT_Steps')
4+
#'
5+
#' @param DAT_df a dataframe as returned by datsteps
6+
#' @param bw the bandwidtg to use. shoudl be stepsize used to compute the dataframe, and if a df as returned by datsteps() is automatically assigned
7+
#'
8+
#' @return the factor with which to scale the density curve to a histogram plot
9+
#'
10+
#' @export get.histogramscale
11+
12+
get.histogramscale <- function(DAT_df, bw = "auto") {
13+
if (bw == "auto") {
14+
if (!is.null(attributes(DAT_df)$stepsize)) {
15+
bw <- attributes(DAT_df)$stepsize
16+
} else {
17+
stop("Either specify stepsize or use a data.frame as returned by datsteps()")
18+
}
19+
} else if (!is.numeric(bw)) {
20+
stop("Either specify stepsize or use a data.frame as returned by datsteps()")
21+
}
22+
density <- density(DAT_df$DAT_step, weights = DAT_df$weight, bw = bw)
23+
breaks <- range(DAT_df$DAT_step)
24+
breaks <- breaks[2] - breaks [1]
25+
breaks <- round(breaks / bw, digits = 0)
26+
hist <- hist(DAT_df$DAT_step, breaks = breaks)
27+
histogramscale <- max(hist$counts) / max(density$y)
28+
return(histogramscale)
29+
}

‎man/get.histogramscale.Rd‎

Lines changed: 19 additions & 0 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎tests/testthat/test-datplot_utility.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
source(file = "../create_testing_df.R")
12
library(datplot)
23
library(devtools)
34

@@ -17,7 +18,6 @@ test_that("switch.dating returns values correctly", {
1718
expect_equal(switch.dating(as.data.frame(testmat), DAT_err), corrmat)
1819
})
1920

20-
source(file = "../create_testing_df.R")
2121
testdf <- create.testing.df()
2222

2323
fristlast <- matrix(nrow = nrow(testdf), ncol = 2)

‎tests/testthat/test-get.R‎

Lines changed: 15 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,15 @@
1+
source(file = "../create_testing_df.R")
2+
3+
4+
testdf <- create.testing.df()
5+
6+
testdfsteps <- scaleweight(datsteps(testdf))
7+
teststeps_wrong <- testdfsteps
8+
attributes(teststeps_wrong)$stepsize <- NULL
9+
#str(teststeps_wrong)
10+
11+
12+
test_that("multiplication works", {
13+
#expect_type(get.histogramscale(teststeps), c("numeric", "double", "integer"))
14+
expect_error(get.histogramscale(teststeps_wrong))
15+
})

0 commit comments

Comments
 (0)