From eba8705d9edd303d8b9f8707440f4f2ecd1390e5 Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Mon, 19 Oct 2020 15:32:34 +0200 Subject: [PATCH 1/5] Implemented basic functionality of setdiff --- R/setdiff.R | 13 +++++++++++++ tests/testthat/test-convertedBaseFunctions.R | 15 +++++++++++---- 2 files changed, 24 insertions(+), 4 deletions(-) create mode 100644 R/setdiff.R diff --git a/R/setdiff.R b/R/setdiff.R new file mode 100644 index 0000000..49e5633 --- /dev/null +++ b/R/setdiff.R @@ -0,0 +1,13 @@ +#' @title Set differences of two arrays +#' @description Loosely replicates the behavior of the homonym Matlab function +#' @param A first array +#' @param B second awway +#' @param legacy if `TRUE`, preserves the behavior of +#' @return +#' @author Waldir Leoncio +#' @export +setdiff <- function(A, B, legacy = FALSE) { + values <- sort(unique(A[is.na(match(A, B))])) + # browser() # TEMP + return(values) +} \ No newline at end of file diff --git a/tests/testthat/test-convertedBaseFunctions.R b/tests/testthat/test-convertedBaseFunctions.R index 11988f8..08e36cc 100644 --- a/tests/testthat/test-convertedBaseFunctions.R +++ b/tests/testthat/test-convertedBaseFunctions.R @@ -158,10 +158,10 @@ test_that("find works as expected", { }) test_that("sortrows works as expected", { - mx <- matrix(c(3, 2, 2, 1, 1, 10, 0, pi), 4) - expect_equal(sortrows(mx), matrix(c(1, 2, 2, 3, pi, 10, 0, 1), 4)) - expect_equal(sortrows(mx, 2), matrix(c(2, 3, 1, 2, 0, 1, pi, 10), 4)) - expect_equal(sortrows(mx, 1:2), mx[order(mx[, 1], mx[, 2]), ]) + mx <- matrix(c(3, 2, 2, 1, 1, 10, 0, pi), 4) + expect_equal(sortrows(mx), matrix(c(1, 2, 2, 3, pi, 10, 0, 1), 4)) + expect_equal(sortrows(mx, 2), matrix(c(2, 3, 1, 2, 0, 1, pi, 10), 4)) + expect_equal(sortrows(mx, 1:2), mx[order(mx[, 1], mx[, 2]), ]) }) test_that("cell works as expected", { @@ -217,4 +217,11 @@ test_that("nargin works correctly", { expect_equal(addme(13, 42), 55) expect_equal(addme(13), 26) expect_equal(addme(), 0) +}) + +test_that("setdiff works as expected", { + A <- c(3, 6, 2, 1, 5, 1, 1) + B <- c(2, 4, 6) + expect_equal(setdiff(A, B), list(c(1, 3, 5), 4, 1, 5)) + # TODO: add more examples from https://se.mathworks.com/help/matlab/ref/double.setdiff.html;jsessionid=0d8d42582d4d299b8224403899f1 }) \ No newline at end of file From 6b1a1910e3194bfc0919b815e9f4b95e40dac78e Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Mon, 19 Oct 2020 15:57:15 +0200 Subject: [PATCH 2/5] Improvements to setdiff --- NAMESPACE | 1 + R/setdiff.R | 10 +++++++--- tests/testthat/test-convertedBaseFunctions.R | 19 ++++++++++++++++++- 3 files changed, 26 insertions(+), 4 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 2dd1c5e..51d5cf2 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -34,6 +34,7 @@ export(randdir) export(repmat) export(rivinSisaltamienMjonojenLkm) export(selvitaDigitFormat) +export(setdiff_MATLAB) export(simulateAllFreqs) export(simulateIndividuals) export(simuloiAlleeli) diff --git a/R/setdiff.R b/R/setdiff.R index 49e5633..af199a9 100644 --- a/R/setdiff.R +++ b/R/setdiff.R @@ -6,8 +6,12 @@ #' @return #' @author Waldir Leoncio #' @export -setdiff <- function(A, B, legacy = FALSE) { - values <- sort(unique(A[is.na(match(A, B))])) - # browser() # TEMP +setdiff_MATLAB <- function(A, B, legacy = FALSE) { + if (is(A, "numeric") & is(B, "numeric")) { + values <- sort(unique(A[is.na(match(A, B))])) + } else if (is(A, "data.frame") & is(B, "data.frame")) { + stop("Not implemented for data frames") + } + # TODO: add support for indices (if necessary) return(values) } \ No newline at end of file diff --git a/tests/testthat/test-convertedBaseFunctions.R b/tests/testthat/test-convertedBaseFunctions.R index 08e36cc..01f6e2e 100644 --- a/tests/testthat/test-convertedBaseFunctions.R +++ b/tests/testthat/test-convertedBaseFunctions.R @@ -222,6 +222,23 @@ test_that("nargin works correctly", { test_that("setdiff works as expected", { A <- c(3, 6, 2, 1, 5, 1, 1) B <- c(2, 4, 6) - expect_equal(setdiff(A, B), list(c(1, 3, 5), 4, 1, 5)) + C <- c(1, 3, 5) + expect_equal(setdiff(A, B), C) + A <- data.frame( + Var1 = 1:5, + Var2 = LETTERS[1:5], + Var3 = c(FALSE, TRUE, FALSE, TRUE, FALSE) + ) + B <- data.frame( + Var1 = seq(1, 9, by = 2), + Var2 = LETTERS[seq(1, 9, by = 2)], + Var3 = rep(FALSE, 5) + ) + C <- data.frame( + Var1 = c(2, 4), + Var2 = c('B', 'D'), + Var3 = c(TRUE, TRUE) + ) + expect_equal(setdiff(A, B), C) # TODO: add more examples from https://se.mathworks.com/help/matlab/ref/double.setdiff.html;jsessionid=0d8d42582d4d299b8224403899f1 }) \ No newline at end of file From 637df694bb2559e1346160a623b07f20412475c1 Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Mon, 19 Oct 2020 15:57:30 +0200 Subject: [PATCH 3/5] Updated docs --- NAMESPACE | 1 + man/admixture_initialization.Rd | 11 +++++++++++ man/laskeMuutokset4.Rd | 4 ++-- man/max_MATLAB.Rd | 22 ++++++++++++++++++++++ man/min_MATLAB.Rd | 18 +++++++++++++++++- man/setdiff_MATLAB.Rd | 24 ++++++++++++++++++++++++ 6 files changed, 77 insertions(+), 3 deletions(-) create mode 100644 man/admixture_initialization.Rd create mode 100644 man/max_MATLAB.Rd create mode 100644 man/setdiff_MATLAB.Rd diff --git a/NAMESPACE b/NAMESPACE index 51d5cf2..94690c0 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -23,6 +23,7 @@ export(linkage) export(logml2String) export(lueGenePopData) export(lueNimi) +export(max_MATLAB) export(min_MATLAB) export(noIndex) export(ownNum2Str) diff --git a/man/admixture_initialization.Rd b/man/admixture_initialization.Rd new file mode 100644 index 0000000..ae2c9bc --- /dev/null +++ b/man/admixture_initialization.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/admixture_initialization.R +\name{admixture_initialization} +\alias{admixture_initialization} +\title{Seuraavat kolme funktiota liittyvat alkupartition muodostamiseen.} +\usage{ +admixture_initialization(data_matrix, nclusters, Z) +} +\description{ +Seuraavat kolme funktiota liittyvat alkupartition muodostamiseen. +} diff --git a/man/laskeMuutokset4.Rd b/man/laskeMuutokset4.Rd index 7c16a19..5c41852 100644 --- a/man/laskeMuutokset4.Rd +++ b/man/laskeMuutokset4.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/laskeMuutokset4.R +% Please edit documentation in R/laskeMuutokset12345.R \name{laskeMuutokset4} \alias{laskeMuutokset4} \title{Calculate changes?} @@ -20,6 +20,6 @@ laskeMuutokset4(osuus, osuusTaulu, omaFreqs, logml, COUNTS = matrix(0)) \description{ Palauttaa npops*npops taulun, jonka alkio (i,j) kertoo, mik?on muutos logml:ss? mikäli populaatiosta i siirretään osuuden verran -todennäköisyysmassaa populaatioon j. Mikäli populaatiossa i ei ole mitään +todennäköisyysmassaa populaatioon j. Mikäli populaatiossa i ei ole mitään siirrettävää, on vastaavassa kohdassa rivi nollia. } diff --git a/man/max_MATLAB.Rd b/man/max_MATLAB.Rd new file mode 100644 index 0000000..d7fbdf7 --- /dev/null +++ b/man/max_MATLAB.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/min_max_MATLAB.R +\name{max_MATLAB} +\alias{max_MATLAB} +\title{Maximum (MATLAB version)} +\usage{ +max_MATLAB(X, indices = TRUE) +} +\arguments{ +\item{X}{matrix} + +\item{indices}{return indices?} +} +\value{ +Either a list or a vector +} +\description{ +Finds the minimum value for each column of a matrix, potentially returning the indices instead +} +\author{ +Waldir Leoncio +} diff --git a/man/min_MATLAB.Rd b/man/min_MATLAB.Rd index bd1113e..9bb1166 100644 --- a/man/min_MATLAB.Rd +++ b/man/min_MATLAB.Rd @@ -1,11 +1,15 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/min.R, R/min_MATLAB.R +% Please edit documentation in R/min.R, R/min_MATLAB.R, R/min_max_MATLAB.R \name{min_MATLAB} \alias{min_MATLAB} \title{Minimum (MATLAB version)} \usage{ min_MATLAB(X, indices = TRUE) +min_MATLAB(X, indices = TRUE) + +min_MATLAB(X, indices = TRUE) + min_MATLAB(X, indices = TRUE) } \arguments{ @@ -16,15 +20,27 @@ min_MATLAB(X, indices = TRUE) \value{ Either a list or a vector +Either a list or a vector + +Either a list or a vector + Either a list or a vector } \description{ Finds the minimum value for each column of a matrix, potentially returning the indices instead +Finds the minimum value for each column of a matrix, potentially returning the indices instead + +Finds the minimum value for each column of a matrix, potentially returning the indices instead + Finds the minimum value for each column of a matrix, potentially returning the indices instead } \author{ Waldir Leoncio +Waldir Leoncio + +Waldir Leoncio + Waldir Leoncio } diff --git a/man/setdiff_MATLAB.Rd b/man/setdiff_MATLAB.Rd new file mode 100644 index 0000000..681e9f9 --- /dev/null +++ b/man/setdiff_MATLAB.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/setdiff.R +\name{setdiff_MATLAB} +\alias{setdiff_MATLAB} +\title{Set differences of two arrays} +\usage{ +setdiff_MATLAB(A, B, legacy = FALSE) +} +\arguments{ +\item{A}{first array} + +\item{B}{second awway} + +\item{legacy}{if `TRUE`, preserves the behavior of} +} +\value{ + +} +\description{ +Loosely replicates the behavior of the homonym Matlab function +} +\author{ +Waldir Leoncio +} From 74e11205b72092508a13a18125f1bdf5a9704fcd Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Mon, 19 Oct 2020 15:58:08 +0200 Subject: [PATCH 4/5] Fixed syntax --- R/addToSummary.R | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/R/addToSummary.R b/R/addToSummary.R index 1c79147..4affbe9 100644 --- a/R/addToSummary.R +++ b/R/addToSummary.R @@ -1,4 +1,4 @@ -addToSummary <- funciton(logml, partitionSummary, worstIndex) { +addToSummary <- function(logml, partitionSummary, worstIndex) { # Tiedet��n, ett� annettu logml on isompi kuin huonoin arvo # partitionSummary taulukossa. Jos partitionSummary:ss� ei viel� ole # annettua logml arvoa, niin lis�t��n worstIndex:in kohtaan uusi logml ja @@ -6,13 +6,13 @@ addToSummary <- funciton(logml, partitionSummary, worstIndex) { apu <- find(abs(partitionSummary[, 2] - logml) < 1e-5) if (isempty(apu)) { - # Nyt l�ydetty partitio ei ole viel� kirjattuna summaryyn. - npops <- length(unique(PARTITION)) - partitionSummary[worstIndex, 1] <- npops - partitionSummary[worstIndex, 2] <- logml - added <- 1 + # Nyt l�ydetty partitio ei ole viel� kirjattuna summaryyn. + npops <- length(unique(PARTITION)) + partitionSummary[worstIndex, 1] <- npops + partitionSummary[worstIndex, 2] <- logml + added <- 1 } else { - added <- 0 + added <- 0 } return(list(partitionSummary = partitionSummary, added = added)) } \ No newline at end of file From 448373796cbf80d8498a2314e6f42552fa4da001 Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Mon, 19 Oct 2020 15:58:17 +0200 Subject: [PATCH 5/5] Added FIXME --- tests/testthat/test-convertedBaseFunctions.R | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/testthat/test-convertedBaseFunctions.R b/tests/testthat/test-convertedBaseFunctions.R index 01f6e2e..5623e38 100644 --- a/tests/testthat/test-convertedBaseFunctions.R +++ b/tests/testthat/test-convertedBaseFunctions.R @@ -164,6 +164,7 @@ test_that("sortrows works as expected", { expect_equal(sortrows(mx, 1:2), mx[order(mx[, 1], mx[, 2]), ]) }) +# FIXME: failing tests test_that("cell works as expected", { expect_equal(cell(0), array(dim = c(0, 0))) expect_equal(cell(1), array(dim = c(1, 1)))