cleared problems from switching to matrix

Author: lsteinmann

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: datplot
 Type: Package
 Title: Preparation of object dating ranges for density plots
-Version: 0.1.0
+Version: 0.2.1
 Author: Lisa Steinmann
 Maintainer: Lisa Steinmann <lisa.steinmann@rub.de>
 Description: Converting date ranges into dating 'steps' eases the visualization of changes in e.g. pottery consumption, style and other variables over time. This package provides tools to process and prepare data for visualization.

R/datplot_utility.R

@@ -9,7 +9,7 @@
 #' @export generate.stepsize
 
 generate.stepsize <- function(DAT_mat) {
-  timespans <- abs(DAT_mat[,3] - DAT_mat[,4])
+  timespans <- abs(DAT_mat[,"datmin"] - DAT_mat[,"datmax"])
   stepsize <- min(timespans)
   if(stepsize < 1) {
     stepsize <- 1
@@ -23,16 +23,16 @@ generate.stepsize <- function(DAT_mat) {
 #' @description Requires a dataframe with 4 variables: ID (ideally factor), group (ideally factor),
 #' minimum date (int/numeric) and maximum date (int/numeric).
 #'
-#' @param DAT_mat a dataframe with 4 variable: ID, group, minimum date (int/num) maximum date (int/num)
+#' @param DAT_df a dataframe with 4 variable: ID, group, minimum date (int/num) maximum date (int/num)
 #' @param DAT_err a vector containing the indizes of the dates which are in wrong order
 #'
 #' @return corrected DAT_mat
 #'
 #' @export switch.dating
 
-switch.dating <- function(DAT_mat, DAT_err) {
-  DAT_mat[DAT_err,3:4] <- DAT_mat[DAT_err,4:3]
-  return(DAT_mat)
+switch.dating <- function(DAT_df, DAT_err) {
+  DAT_df[DAT_err,3:4] <- DAT_df[DAT_err,4:3]
+  return(DAT_df)
 }
 
 
@@ -81,12 +81,12 @@ get.weights <- function(DAT_min, DAT_max) {
 #' @export calculate.outputrows
 
 calculate.outputrows <- function(DAT_mat, stepsize) {
-  mean_year_index <- which(DAT_mat[,4]-DAT_mat[,3] < stepsize)
+  mean_year_index <- which(DAT_mat[,"datmax"]-DAT_mat[,"datmin"] < stepsize)
 
   if (length(mean_year_index) == 0) {
-    outputrows <- ceiling(sum(((abs(DAT_mat[,3]-DAT_mat[,4]))/stepsize)+1))
+    outputrows <- ceiling(sum(((abs(DAT_mat[,"datmin"]-DAT_mat[,"datmax"]))/stepsize)+1))
   } else {
-    outputrows <- ceiling(sum(((abs(DAT_mat[-mean_year_index,3]-DAT_mat[-mean_year_index,4]))/stepsize)+1))
+    outputrows <- ceiling(sum(((abs(DAT_mat[-mean_year_index,"datmin"]-DAT_mat[-mean_year_index,"datmax"]))/stepsize)+1))
     outputrows <- outputrows+length(mean_year_index)
   }
   return(outputrows)
@@ -110,31 +110,34 @@ create.sub.objects <- function(DAT_mat, stepsize) {
 
   outputrows <- calculate.outputrows(DAT_mat, stepsize)
 
-  result <- as.data.frame(matrix(ncol = ncol(DAT_mat)+1, nrow = outputrows+100))
+  result <- as.data.frame(matrix(ncol = 6, nrow = outputrows+100))
 
-  diffs <- DAT_mat[,4]-DAT_mat[,3]
+  diffs <- DAT_mat[,"datmax"]-DAT_mat[,"datmin"]
 
   if (any(diffs < stepsize)) {
     diffs <- diffs[diffs < stepsize]
-    warning(paste("stepsize is larger than the range of the closest dated object: ",
-                paste(DAT_mat[which(diffs < stepsize),1], collapse = ", "), " (Index = ",
+    warning(paste("stepsize is larger than the range of the closest dated object at Index = ",
                 paste(which(diffs < stepsize), collapse = ", "), "). Using mean as year.", sep = ""))
   }
 
   for (i in 1:nrow(DAT_mat)) {
     sequence <- NULL
-    if ((DAT_mat[i,4]-DAT_mat[i,3]) < stepsize) {
-      sequence <- (DAT_mat[i,3]+DAT_mat[i,4])/2
+    if ((DAT_mat[i,"datmax"]-DAT_mat[i,"datmin"]) < stepsize) {
+      sequence <- (DAT_mat[i,"datmin"]+DAT_mat[i,"datmax"])/2
     } else {
-      sequence <- seq(DAT_mat[i,3], DAT_mat[i,4], by = stepsize)
+      sequence <- seq(DAT_mat[i,"datmin"], DAT_mat[i,"datmax"], by = stepsize)
     }
     length <- length(sequence)
     for (step in sequence) {
       wip <- as.vector(DAT_mat[i,])
-      wip[6] <- step
-      wip[5] <- wip[5] / length(sequence)
+      wip[5] <- step
+      wip[4] <- wip[4] / length(sequence)
       first_na <- match(NA, result[,1])
-      result[first_na,1:6] <- wip
+      result[first_na,1] <- wip[1]
+      result[first_na,3] <- wip[2]
+      result[first_na,4] <- wip[3]
+      result[first_na,5] <- wip[4]
+      result[first_na,6] <- wip[5]
     }
   }
   result <- result[-c(match(NA, result[,1]):nrow(result)), ]

R/datsteps.R

@@ -26,22 +26,22 @@ datsteps <- function(DAT_df, stepsize = 25) {
     DAT_df <- switch.dating(DAT_df, DAT_err)
   }
 
-  DAT_mat <- matrix(ncol = 6, nrow = nrow(DAT_df))
-  DAT_mat[,3] <- DAT_df[,3]
-  DAT_mat[,4] <- DAT_df[,4]
+  DAT_mat <- matrix(ncol = 5, nrow = nrow(DAT_df))
   DAT_mat[,1] <- 1:nrow(DAT_df)
-  DAT_mat[,2] <- as.integer(DAT_df[,2])
+  DAT_mat[,2] <- DAT_df[,3]
+  DAT_mat[,3] <- DAT_df[,4]
+
+  colnames(DAT_mat) <- c("index", "datmin", "datmax", "weight", "step")
 
   if (stepsize == "auto") {
     stepsize <- generate.stepsize(DAT_mat)
   } else if (!is.numeric(stepsize)) {
     stop(print("stepsize has to be either 'auto' or numeric."))
   }
 
-  weights <- get.weights(DAT_mat[,3], DAT_mat[,4])
+  weights <- get.weights(DAT_mat[,"datmin"], DAT_mat[,"datmax"])
 
-  DAT_mat[,5] <- weights[,1]
-  DAT_mat[,6] <- NA
+  DAT_mat[,"weight"] <- weights[,1]
   DAT_res <- create.sub.objects(DAT_mat, stepsize)
 
 

man/switch.dating.Rd

@@ -1,16 +1,18 @@
 library(datplot)
 library(devtools)
 
-testmat <- matrix(c(1,2,3,4,6,6,8,8,0,0,50,-200,5,-200,50,5), byrow = FALSE, ncol = 4)
-DAT_err <- which(testmat[,3] > testmat[,4])
+testmat <- matrix(c(1,2,3,4,0,0,50,-200,5,-200,50,5), byrow = FALSE, ncol = 3)
+colnames(testmat) <- c("index", "datmin", "datmax")
+DAT_err <- which(testmat[,2] > testmat[,3])
 DAT_err
 
 
 test_that("generate.stepsize returns one", {
   expect_equal(generate.stepsize(testmat), 1)
 })
 
-corrmat <- matrix(c(1,2,3,4,6,6,8,8,0,-200,50,-200,5,0,50,5), byrow = FALSE, ncol = 4)
+corrmat <- as.data.frame(matrix(c(1,2,3,4,6,6,8,8,0,-200,50,-200,5,0,50,5), byrow = FALSE, ncol = 4))
+testmat <- as.data.frame(matrix(c(1,2,3,4,6,6,8,8,0,0,50,-200,5,-200,50,5), byrow = FALSE, ncol = 4))
 test_that("switch.dating returns values correctly", {
-  expect_equal(switch.dating(testmat, DAT_err), corrmat)
+  expect_equal(switch.dating(as.data.frame(testmat), DAT_err), corrmat)
 })