Merge pull request #8 from lsteinmann/master

update branch

Author: lsteinmann

.Rbuildignore

@@ -1,3 +1,4 @@
 ^.*\.Rproj$
 ^\.Rproj\.user$
 ^\.github$
+^data-raw$

.github/ISSUE_TEMPLATE/bug_report.md

@@ -0,0 +1,38 @@
+---
+name: Bug report
+about: Create a report to help us improve
+title: ''
+labels: ''
+assignees: ''
+
+---
+
+**Describe the bug**
+A clear and concise description of what the bug is.
+
+**To Reproduce**
+Steps to reproduce the behavior:
+1. Go to '...'
+2. Click on '....'
+3. Scroll down to '....'
+4. See error
+
+**Expected behavior**
+A clear and concise description of what you expected to happen.
+
+**Screenshots**
+If applicable, add screenshots to help explain your problem.
+
+**Desktop (please complete the following information):**
+ - OS: [e.g. iOS]
+ - Browser [e.g. chrome, safari]
+ - Version [e.g. 22]
+
+**Smartphone (please complete the following information):**
+ - Device: [e.g. iPhone6]
+ - OS: [e.g. iOS8.1]
+ - Browser [e.g. stock browser, safari]
+ - Version [e.g. 22]
+
+**Additional context**
+Add any other context about the problem here.

.github/ISSUE_TEMPLATE/feature_request.md

@@ -0,0 +1,20 @@
+---
+name: Feature request
+about: Suggest an idea for this project
+title: ''
+labels: ''
+assignees: ''
+
+---
+
+**Is your feature request related to a problem? Please describe.**
+A clear and concise description of what the problem is. Ex. I'm always frustrated when [...]
+
+**Describe the solution you'd like**
+A clear and concise description of what you want to happen.
+
+**Describe alternatives you've considered**
+A clear and concise description of any alternative solutions or features you've considered.
+
+**Additional context**
+Add any other context or screenshots about the feature request here.

.github/workflows/R-CMD-check.yaml

@@ -2,6 +2,7 @@ on:
   push:
     branches:
       - master
+      - inscrbithynia
   pull_request:
     branches:
       - master

.travis.yml

@@ -0,0 +1,11 @@
+# R for travis: see documentation at https://docs.travis-ci.com/user/languages/r
+
+language: R
+cache: packages
+
+
+r_packages:
+  - covr
+
+after_success:
+  - Rscript -e 'library(covr); codecov()'

DESCRIPTION

@@ -1,20 +1,25 @@
 Package: datplot
 Type: Package
 Title: Preparation of object dating ranges for density plots
-Version: 0.2.2
+Version: 0.2.3
 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.
 License: CC BY-SA 4.0
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.1.0
+RoxygenNote: 7.1.1
 Suggests: 
     testthat,
     devtools,
     knitr,
     rmarkdown,
-    ggplot2
+    tidyverse,
+    ggplot2,
+    ggridges,
+    readxl,
+    reshape2,
+    covr
 Depends: 
     R (>= 2.10)
 VignetteBuilder: knitr

R/data.R

@@ -7,7 +7,7 @@
 #'   \item ID. Identifier of the Objects (has to be unique)
 #'   \item var. Grouping variable, such as a Type or a Findspot
 #'   \item DAT_min. Integer: lower range of the dating, BCE in negative numbers
-#'   \item DAT_max. Integer: uppder range of the dating, BCE in negative numbers
+#'   \item DAT_max. Integer: upper range of the dating, BCE in negative numbers
 #' }
 #'
 #' @docType data
@@ -30,7 +30,7 @@ NULL
 #'   \item Identifier (Vase.Number in BAPD)
 #'   \item Technique: Sample contains only red- or blackfigured objects
 #'   \item DAT_min. Integer: lower range of the dating, BCE in negative numbers
-#'   \item DAT_max. Integer: uppder range of the dating, BCE in negative numbers
+#'   \item DAT_max. Integer: upper range of the dating, BCE in negative numbers
 #' }
 #'
 #' @docType data
@@ -42,3 +42,25 @@ NULL
 
 "Beazley"
 NULL
+
+
+#' @title Inscr_Bithynia
+#' @description The data set was gathered by Barbora Weissov\'a and published as part
+#' of her dissertation “Regional Economy, Settlement Patterns and the Road System in
+#' Bithynia (4th Century BC - 6th Century AD). Spatial and Quantitative Analysis.”.
+#'
+#'
+#' @format A data frame with 2878 rows and 9 variables:
+#' \describe{
+#'   \item{\code{ID}}{character COLUMN_DESCRIPTION}
+#'   \item{\code{ikey}}{character ID at \url{https://inscriptions.packhum.org/}, if available}
+#'   \item{\code{Location}}{factor Findspot of the Inscription (City)}
+#'   \item{\code{Source}}{character Corpus/Citation of the Inscription}
+#'   \item{\code{Dating}}{character Original Chronological Assesment, may contain inconsistencies}
+#'   \item{\code{Language}}{factor Language of the Inscription, can either be Latin, Greek, or both}
+#'   \item{\code{uncertain_dating}}{logical TRUE if Dating is not certain, FALSE if dating is certain}
+#'   \item{\code{DAT_min}}{integer lower border of the dating timespan, negative values for BCE, positive values for CE}
+#'   \item{\code{DAT_max}}{integer uppper border of the dating timespan, negative values for BCE, positive values for CE}
+#'}
+#' @source Weissová, Barbora. 2019. “Regional Economy, Settlement Patterns and the Road System in Bithynia (4th Century BC - 6th Century AD). Spatial and Quantitative Analysis.” Dissertation, Berlin: Freie Universität Berlin. \url{https://refubium.fu-berlin.de/handle/fub188/23730}, partially after \url{https://inscriptions.packhum.org/}
+"Inscr_Bithynia"

R/datplot_utility.R

@@ -130,6 +130,9 @@ get.step.sequence <- function(datmin = 0, datmax = 100, stepsize = 25) {
     if (timespan > (stepsize*0.6)) {
       # If the timespan exceeds 60% of the stepsize, three steps will be created corresponding to minimum, mean and maximum dating
       sequence <- c(datmin, round(((datmin+datmax)/2), digits = 0), datmax)
+    } else if (timespan == 0) {
+      # for objects dated to one year, only use one year!
+      sequence <- datmin
     } else {
       # if the timespan is less than 60% of the stepsize, just two values corresponding to minimum and maximum dating will be returned
       sequence <- c(datmin, datmax)
@@ -142,7 +145,7 @@ get.step.sequence <- function(datmin = 0, datmax = 100, stepsize = 25) {
     if (resid >= (stepsize/2)) {
       # if the residual is larger or equals half the stepsize, the stepsize is temporarily modified to fit the as many values
       # as it would with the length of the sequence generated
-      stepsize_mod <- (datmax-datmin)/length(sequence)
+      stepsize_mod <- (datmax-datmin)/(length(sequence)+1) ## length(sequence + 1 might be better!)
       sequence <- seq(datmin, datmax, stepsize_mod)
       # then rounds all values except first and last, which need to stay as minumum and maximum date
       sequence[-c(1,length(sequence))] <- round(sequence[-c(1,length(sequence))], digits = 0)
@@ -203,17 +206,14 @@ create.sub.objects <- function(DAT_mat, stepsize) {
   for (i in 1:nrow(DAT_mat)) {
     sequence <- NULL
     sequence <- get.step.sequence(DAT_mat[i,"datmin"], DAT_mat[i,"datmax"], stepsize)
-    for (step in sequence) {
-      wip <- as.vector(DAT_mat[i,])
-      wip[5] <- step
-      wip[4] <- wip[4] #/ length(sequence)
-      first_na <- match(NA, result[,1])
-      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]
-    }
+
+    first_na <- match(NA, result[,1])
+    last_row <- first_na + (length(sequence)-1)
+    result[first_na:last_row,1] <- DAT_mat[i,1]
+    result[first_na:last_row,3] <- DAT_mat[i,2]
+    result[first_na:last_row,4] <- DAT_mat[i,3]
+    result[first_na:last_row,5] <- DAT_mat[i,4]
+    result[first_na:last_row,6] <- sequence
   }
   result <- result[-c(match(NA, result[,1]):nrow(result)), ]
   return(result)
@@ -231,13 +231,8 @@ create.sub.objects <- function(DAT_mat, stepsize) {
 
 
 check.number <- function(value) {
-  result <- is.integer(value)
-  if (result == FALSE) {
-    result <- is.numeric(value)
-    if  (result == FALSE) {
-      result <- is.double(value)
-    }
-  }
+  result <- c(is.integer(value), is.numeric(value), is.double(value))
+  result <- any(result)
   return(result)
 }
 
@@ -256,15 +251,16 @@ check.structure <- function(DAT_df) {
   names(dat_df_structure) <- c("is.df", "is.id", "is.var", "is.minDAT", "is.maxDAT")
 
   dat_df_structure["is.df"] <- is.data.frame(DAT_df)
-  dat_df_structure["is.id"] <- is.character(DAT_df[,1])
-  dat_df_structure["is.var"] <- is.factor(DAT_df[,2])
-  dat_df_structure[c("is.minDAT", "is.maxDAT")] <- c(check.number(DAT_df[,3]), check.number(DAT_df[,4]))
+  dat_df_structure["is.id"] <- is.character(DAT_df[,1, drop = TRUE])
+  dat_df_structure["is.var"] <- is.factor(DAT_df[,2, drop = TRUE])
+  dat_df_structure[c("is.minDAT", "is.maxDAT")] <- c(check.number(DAT_df[,3, drop = TRUE]),
+                                                     check.number(DAT_df[,4, drop = TRUE]))
 
   if (dat_df_structure[1] == FALSE) {
     result <- FALSE
     stop("datsteps requires an object of class data.frame")
   } else { result <- TRUE }
-  if (any(dat_df_structure[4:5] == FALSE)) {
+  if (any(dat_df_structure[c("is.minDAT", "is.maxDAT")] == FALSE)) {
     result <- FALSE
     stop("The 3rd or 4th columns of your data.frame are not numbers.")
   } else { result <- TRUE }

R/datsteps.R

@@ -18,7 +18,7 @@
 #' @export datsteps
 
 datsteps <- function(DAT_df, stepsize = 25) {
-
+  DAT_df <- as.data.frame(DAT_df)
   # Checking the overall structure
   check.structure(DAT_df)
 

R/get.histogramscale.R

@@ -1,42 +1,40 @@
 #' @title Scaling Factor for Combined Histogramm Plots
 #'
-#' @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'
+#' @description Requires a dataframe as produced by datsteps() or a number as DAT_df_steps. Calculated the value with which the
+#' y-axis of a density graph should be multplied in order to be visible in the corresponding histogram.
 #'
-#' @param DAT_df a dataframe as returned by datsteps
-#' @param bw the bandwidth to use for the density function and histogram. Should be stepsize used to
-#' create the dataframe. If a df as returned by datsteps() is given, stepsize is automatically assigned
-#' using the corresponding attribute.
+#' @param DAT_df_steps a dataframe as returned by datsteps
+#' @param binwidth the bandwidth to use for the density function and histogram. Should be stepsize used to
+#' create the dataframe. If a df as returned by datsteps() is given, stepsize can be automatically assigned
+#' using the corresponding attribute (binwidth = "stepsize")
 #'
 #' @return the value with which to scale the density curve to a histogram plot so that both will be visible
 #'
 #' @examples
 #' DAT_df_steps <- datsteps(DAT_df[1:100,], stepsize = 25)
 #' get.histogramscale(DAT_df_steps)
 #'
+#' get.histogramscale(500, binwidth = 20)
+#'
 #' @export get.histogramscale
 
-get.histogramscale <- function(DAT_df, bw = "auto") {
-  if (bw == "auto") {
-    if (!is.null(attributes(DAT_df)$stepsize)) {
-      bw <- attributes(DAT_df)$stepsize
-    } else {
-      stop("Either specify stepsize/bandwidth (bw = ) or use a data.frame as returned by datsteps()")
+get.histogramscale <- function(DAT_df_steps, binwidth = "stepsize") {
+  if (check.number(DAT_df_steps)) {
+    nrow <- DAT_df_steps
+    if (binwidth == "stepsize") {
+      stop("'binwidth == stepsize' cannot be used with a number, supply either a dataframe as returned by datsteps or a numerical bindwidth")
+    }
+  } else {
+    nrow <- nrow(DAT_df_steps)
+    if (binwidth == "stepsize") {
+      binwidth <- attributes(DAT_df_steps)$stepsize
+      if (is.null(binwidth)) {
+        stop("Supply numerical binwidth or dataframe as returned by datsteps")
+      }
+    } else if (!check.number(binwidth)) {
+      stop('Supply numerical binwidth or use binwidth = "stepsize".')
     }
-  } else if (!is.numeric(bw)) {
-    stop("Either specify stepsize/bandwidth (bw = ) or use a data.frame as returned by datsteps()")
   }
-  density <- density(DAT_df$DAT_step, weights = DAT_df$weight, bw = bw)
-  breaks <- range(DAT_df$DAT_step)
-  breaks <- breaks[2] - breaks [1]
-  breaks <- round(breaks / bw, digits = 0)
-  hist <- hist(DAT_df$DAT_step, breaks = breaks)
-  histogramscale <- max(hist$counts) / max(density$y)
+  histogramscale <- nrow * binwidth
   return(histogramscale)
 }