From e645d00fca3fcaeb6bd2f60d9781eaf8609e5eb8 Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Thu, 30 Jan 2020 15:44:13 +0100 Subject: [PATCH 1/3] Implemented base MATLAB function in R --- R/size.R | 30 ++++++++++++++++++++ man/size.Rd | 23 +++++++++++++++ tests/testthat/test-convertedBaseFunctions.R | 19 +++++++++++++ 3 files changed, 72 insertions(+) create mode 100644 R/size.R create mode 100644 man/size.Rd diff --git a/R/size.R b/R/size.R new file mode 100644 index 0000000..ce245f7 --- /dev/null +++ b/R/size.R @@ -0,0 +1,30 @@ +#' @title Size of an object +#' @description This functions tries to replicate the behavior of the base function "size" in Matlab +#' @param x object to be evaluated +#' @param d dimension of object to be evaluated +#' @note On MATLAB, size(1, 100) returns 1. As a matter of fact, if the user +#' calls for a dimension which x doesn't have `size()` always returns 1. R's +#' default behavior is more reasonable in those cases (i.e., returning NA), +#' but since the point of this function is to replicate MATLAB behaviors +#' (bugs and questionable behaviors included), this function also does this. +size <- function(x, d) { + # Determining the number of dimensions + if (length(x) == 1) { + # x is surely a scalar + return(1) + } else { + # x is a vector, a matrix or an array + n_dim <- ifelse(is.null(dim(x)), 1, length(dim(x))) + if (missing(d)) { + if (n_dim == 1) { + out <- range(x) + } else { + out <- dim(x) + } + } else { + out <- ifelse(n_dim == 1, range(x)[d], dim(x)[d]) + if (is.na(out)) out <- 1 # for MATLAB compatibility + } + return(out) + } +} \ No newline at end of file diff --git a/man/size.Rd b/man/size.Rd new file mode 100644 index 0000000..5c2c3cb --- /dev/null +++ b/man/size.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/size.R +\name{size} +\alias{size} +\title{Size of an object} +\usage{ +size(x, d) +} +\arguments{ +\item{x}{object to be evaluated} + +\item{d}{dimension of object to be evaluated} +} +\description{ +This functions tries to replicate the behavior of the base function "size" in Matlab +} +\note{ +On MATLAB, size(1, 100) returns 1. As a matter of fact, if the user +calls for a dimension which x doesn't have `size()` always returns 1. R's +default behavior is more reasonable in those cases (i.e., returning NA), +but since the point of this function is to replicate MATLAB behaviors +(bugs and questionable behaviors included), this function also does this. +} diff --git a/tests/testthat/test-convertedBaseFunctions.R b/tests/testthat/test-convertedBaseFunctions.R index 9a9c9c4..f4bf346 100644 --- a/tests/testthat/test-convertedBaseFunctions.R +++ b/tests/testthat/test-convertedBaseFunctions.R @@ -65,4 +65,23 @@ test_that("times works as expected", { test_that("colon works as expected (hee hee)", { expect_equal(colon(1, 4), 1:4) expect_length(colon(4, 1), 0) +}) + +test_that("size works as on MATLAB", { + sk <- 10 + vk <- 1:4 + mx <- matrix(1:6, 2) + ra <- array(1:24, c(2, 3, 4)) + expect_equal(size(sk), 1) + expect_equal(size(vk), c(1, 4)) + expect_equal(size(mx), c(2, 3)) + expect_equal(size(ra), c(2, 3, 4)) + expect_equal(size(sk, 199), 1) + expect_equal(size(vk, 199), 1) + expect_equal(size(mx, 199), 1) + expect_equal(size(ra, 199), 1) + expect_equal(size(vk, 2), 4) + expect_equal(size(mx, 2), 3) + expect_equal(size(ra, 2), 3) + expect_equal(size(ra, 3), 4) }) \ No newline at end of file From 2e8ad9a89d6b4ab9570b11ae9c31c866341eeff6 Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Thu, 30 Jan 2020 16:20:36 +0100 Subject: [PATCH 2/3] Implemented simulateIndividuals --- NAMESPACE | 1 + R/admix1.R | 25 ------------------------- R/simulateIndividuals.R | 27 +++++++++++++++++++++++++++ man/simulateIndividuals.Rd | 12 ++++++++++++ tests/testthat/test-admix1.R | 20 ++++++++++++++++++++ 5 files changed, 60 insertions(+), 25 deletions(-) create mode 100644 R/simulateIndividuals.R create mode 100644 man/simulateIndividuals.Rd diff --git a/NAMESPACE b/NAMESPACE index 79a2e2f..f49f1d9 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -14,6 +14,7 @@ export(proportion2str) export(rand) export(randdir) export(repmat) +export(simulateIndividuals) export(simuloiAlleeli) export(suoritaMuutos) export(times) diff --git a/R/admix1.R b/R/admix1.R index d611540..8251e22 100644 --- a/R/admix1.R +++ b/R/admix1.R @@ -453,29 +453,4 @@ admix1 <- function(tietue) { # simuloidut = randdir(counts(1:noalle(j),j,i) , noalle(j)); # allfreqs(1:noalle(j),j,i) = simuloidut; # end -# end - -# %-------------------------------------------------------------------------- - - -# function refData = simulateIndividuals(n,rowsFromInd,allfreqs,pop, missing_level) -# % simulate n individuals from population pop, such that approximately -# % proportion "missing_level" of the alleles are present. - -# nloci = size(allfreqs,2); - -# refData = zeros(n*rowsFromInd,nloci); -# counter = 1; % which row will be generated next. - -# for ind = 1:n -# for loc = 1:nloci -# for k=0:rowsFromInd-1 -# if rand Date: Thu, 30 Jan 2020 16:20:52 +0100 Subject: [PATCH 3/3] Fixed bug involving scalar parsing --- R/simuloiAlleeli.R | 17 ++++++++++++++--- tests/testthat/test-admix1.R | 2 ++ 2 files changed, 16 insertions(+), 3 deletions(-) diff --git a/R/simuloiAlleeli.R b/R/simuloiAlleeli.R index 9f26d21..955684a 100644 --- a/R/simuloiAlleeli.R +++ b/R/simuloiAlleeli.R @@ -4,11 +4,22 @@ #' @export simuloiAlleeli <- function(allfreqs, pop, loc) { - if (length(dim(allfreqs)) == 3) { # distinguish between arrays and matrices - freqs <- allfreqs[, loc, pop] + if (length(dim(allfreqs)) == 0) { + freqs <- 1 } else { - freqs <- allfreqs[, loc] + if (length(dim(allfreqs)) == 3) { # distinguish between array and matrix + freqs <- allfreqs[, loc, pop] + } else { + freqs <- allfreqs[, loc] + } } + # freqs <- ifelse(is.null(length(dim(allfreqs)), allfreqs[loc], 0) + # freqs <- switch() + 1, + # allfreqs[, loc], + # allfreqs[, loc, pop] + # ) + + cumsumma <- cumsum(freqs) arvo <- runif(1) isommat <- which(cumsumma > arvo) diff --git a/tests/testthat/test-admix1.R b/tests/testthat/test-admix1.R index 962dcdf..04e004a 100644 --- a/tests/testthat/test-admix1.R +++ b/tests/testthat/test-admix1.R @@ -183,9 +183,11 @@ test_that("computePersonalAllFreqs works like on Matlab", { test_that("simuloiAlleeli works like on Matlab", { # TODO: test on vector + sk1 <- 2 ra1 <- array(1:12, c(2, 2, 3)) mx1 <- matrix(c(3, 5, 0, 9), 2) mx2 <- matrix(c(3, 5, 0, 9, 5, 8), 2) + expect_equal(simuloiAlleeli(sk1, 1, 1), 1) expect_equal(simuloiAlleeli(ra1, 2, 1), 1) expect_equal(simuloiAlleeli(mx1, 1, 2), 2) expect_equal(simuloiAlleeli(mx2, 1, 3), 1)