Merge branch 'issue-3' into develop

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: rBAPS
 Title: Bayesian Analysis of Population Structure
-Version: 0.0.0.9009
+Version: 0.0.0.9010
 Date: 2020-11-09
 Authors@R:
     c(

NAMESPACE

@@ -35,6 +35,7 @@ export(simulateIndividuals)
 export(simuloiAlleeli)
 export(suoritaMuutos)
 export(takeLine)
+export(testaaKoordinaatit)
 export(testaaOnkoKunnollinenBapsData)
 export(testaaPop)
 export(writeMixtureInfo)

R/testaaKoordinaatit.R

@@ -0,0 +1,77 @@
+#' @title Test the coordinates
+#' @param ninds ninds
+#' @param coordinates coordinates
+#' @param interactive prompt user for relevant questions during execution
+#' @return a list of defectives ("viallinen") and coordinates
+#' @export
+testaaKoordinaatit <- function(ninds, coordinates, interactive = TRUE) {
+ # Testaa onko koordinaatit kunnollisia.
+ # modified by Lu Cheng, 05.12.2012
+  viallinen <- 1
+  if (any(sapply(coordinates, class) != "numeric")) {
+    warning('Coordinates are not numerical!')
+    return()
+  }
+  oikeanKokoinen <- size(coordinates, 1) == ninds & (size(coordinates, 2) == 2)
+  if (!oikeanKokoinen) {
+    warning('Wrong coordinates dimension!')
+    return()
+  }
+  posstr <- sapply(coordinates, function(x) sprintf('%.10f', x))
+  posstr <- gsub('\\.0.+', '.', posstr)
+  posstr <- matrix(posstr, nrow = nrow(coordinates))
+  uni1 <- unique(posstr[, 1])
+  uni2 <- unique(posstr[, 2])
+  posstr_new <- posstr
+  if (length(uni1) == ninds && length(uni2) == ninds) {
+    viallinen <- 0
+    return(list(viallinen = viallinen, coordinates = coordinates))
+  } else {
+    ans <- "Yes"
+    if (interactive) {
+      ans <- questdlg(
+        'Input coordinates are not unique. Do you want to make them unique?',
+        'coordinates NOT unique', c('Yes', 'No'), 'Yes'
+      )
+    }
+    if (strcmp(tolower(ans), 'no')) {
+      warning('Coordinates are not unique!')
+      return(list(viallinen = viallinen, coordinates = coordinates))
+    }
+  }
+
+  for (i in 1:length(uni1)) {
+    tmpinds <- find(posstr[, 1] %in% uni1[i])
+    tmpNinds <- length(tmpinds)
+    if (tmpNinds == 1) {
+      next
+    }
+    if (tmpNinds >= 100) stop("Assertion failed. tmpNinds not < 100")
+    tmparr <- round(seq(0, 99, length.out = tmpNinds))
+    tmparr <- tmparr[sample(tmpNinds)]
+    for (j in 1:tmpNinds) {
+      posstr_new[tmpinds[j], 1] <- sprintf('%s%02d', posstr[tmpinds[j], 1], tmparr[j])
+    }
+  }
+
+  for (i in 1:length(uni2)) {
+    tmpinds <- find(posstr[, 2] %in% uni2[i])
+    tmpNinds <- length(tmpinds)
+    if (tmpNinds == 1) next
+    if (tmpNinds >= 100) stop("Assertion failed. tmpNinds not < 100")
+    tmparr <- round(seq(0, 99, length.out = tmpNinds))
+    tmparr <- tmparr[sample(tmpNinds)]
+      for (j in 1:tmpNinds) {
+          posstr_new[tmpinds[j], 2] <- sprintf('%s%02d', posstr[tmpinds[j], 2], tmparr[j])
+      }
+  }
+  coordinates <- matrix(sapply(posstr_new, as.double), ncol = 2)
+  uni1 <- unique(coordinates[, 1])
+  uni2 <- unique(coordinates[, 2])
+  if (length(uni1 )== ninds && length(uni2) == ninds) {
+      viallinen <- 0
+  } else {
+      warning('Can not make coordinates unique!')
+  }
+  return(list(viallinen = viallinen, coordinates = coordinates))
+}

man/testaaKoordinaatit.Rd

@@ -0,0 +1,19 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/testaaKoordinaatit.R
+\name{testaaKoordinaatit}
+\alias{testaaKoordinaatit}
+\title{Test the coordinates}
+\usage{
+testaaKoordinaatit(ninds, coordinates)
+}
+\arguments{
+\item{ninds}{ninds}
+
+\item{coordinates}{coordinates}
+}
+\value{
+a list of defectives ("viallinen") and coordinates
+}
+\description{
+Test the coordinates
+}

tests/testthat/test-spatialMixture.R

@@ -15,3 +15,21 @@ test_that("functions work with basic input", {
   expect_equal(computeDiffInCliqCounts(r, 0), matrix(c(0, 0, 0)))
   expect_equal(mysetdiff(t, y), c(2, 5))
 })
+
+test_that("testaaKoordinaatit works as expected", {
+  m1 <- matrix(c(11.1, 22.2, 33.3, 44.4), 2, byrow = TRUE)
+  m2 <- matrix(c(11.1, 22.2, 33.3, 44.4, 55.5, 66.6), byrow = TRUE)
+  m3 <- matrix(c(11, 22.2, 11, 44.4, 11, 66.6), ncol = 2, byrow = TRUE)
+  expect_equal(
+    testaaKoordinaatit(2, m1), list("viallinen" = 0, "coordinates" = m1)
+  )
+  expect_warning(testaaKoordinaatit(2, m2), "Wrong coordinates dimension!")
+  expect_equal(
+    {set.seed(5676402); testaaKoordinaatit(3, m3, FALSE)},
+    list(
+      "viallinen" = 0,
+      "coordinates" = matrix(
+        c(11.99, 22.2, 11.50, 44.4, 11.00, 66.6), ncol = 2, byrow = TRUE)
+      )
+  )
+})