Merge branch 'fix-lueGenePopData' into import-genepop

R/addAlleles.R

@@ -12,22 +12,25 @@ addAlleles <- function(data, ind, line, divider) {
 	# line. Jos data on 3 digit formaatissa on divider=1000.
 	# Jos data on 2 digit formaatissa on divider=100.
 
-	nloci <- size(data, 2) - 1
+	nloci <- size(data, 2) # added 1 from original code
 	if (size(data, 1) < (2 * ind)) {
-		data <- c(data, zeros(100, nloci + 1))
+		data <- rbind(data, zeros(100, nloci)) # subtracted 1 from original code
 	}
 
 	k <- 1
-	merkki <- line[k]
+	merkki <- substring(line, k, k)
 	while (merkki != ',') {
 	   k <- k + 1
-	   merkki <- line[k]
+	   merkki <- substring(line, k, k)
 	}
-	line <- line[k + 1:length(line)]
+	line <- substring(line, k + 1)
 	# clear k; clear merkki;
 
-	alleeliTaulu <- as.numeric(strsplit(line, split = " ")[[1]])
+	if (grepl(" ", line)) {
-
+		alleeliTaulu <- as.numeric(strsplit(line, split = " ")[[1]])
+	} else if (grepl("\t", line)) {
+		alleeliTaulu <- as.numeric(strsplit(line, split = "\t")[[1]])
+	}
 
 	if (length(alleeliTaulu) != nloci) {
 		stop('Incorrect data format.')
@@ -35,9 +38,9 @@ addAlleles <- function(data, ind, line, divider) {
 
 	for (j in seq_len(nloci)) {
 		ekaAlleeli <- floor(alleeliTaulu[j] / divider)
-		if (ekaAlleeli == 0) ekaAlleeli <- -999
+		if (is.na(ekaAlleeli) | ekaAlleeli == 0) ekaAlleeli <- -999
 		tokaAlleeli <- alleeliTaulu[j] %% divider
-		if (tokaAlleeli == 0) tokaAlleeli <- -999
+		if (is.na(tokaAlleeli) | tokaAlleeli == 0) tokaAlleeli <- -999
 
 		data[2 * ind - 1, j] <- ekaAlleeli
 		data[2 * ind, j] <- tokaAlleeli

R/cell.R

@@ -6,10 +6,10 @@
 #' @return An array of zeroes with the dimensions passed on call
 cell <- function(n, sz = c(n, n), ...) {
 	if (length(sz) == 1 & missing(...)) {
-		return(array(dim = c(n, sz)))
+		return(array(0, dim = c(n, sz)))
 	} else if (length(sz) == 2) {
-		return(array(dim = sz))
+		return(array(0, dim = sz))
 	} else {
-		return(array(dim = c(n, sz, ...)))
+		return(array(0, dim = c(n, sz, ...)))
 	}
 }

R/lueGenePopData.R

@@ -4,17 +4,16 @@
 #' @return list containing data and popnames
 #' @export
 lueGenePopData <- function (tiedostonNimi) {
-
+	fid   <- readLines(tiedostonNimi)
-	fid   <- load(tiedostonNimi)
+	line <- fid[1] # ensimmäinen rivi
-	line1 <- readLines(fid)[1] # ensimmäinen rivi
+	line <- fid[2] # toinen rivi
-	line2 <- readLines(fid)[2] # toinen rivi
 	count <- rivinSisaltamienMjonojenLkm(line)
 
-	line <- readLines(fid)[3]
+	line <- fid[3]
 	lokusRiveja <- 1
 	while (testaaPop(line) == 0) {
 		lokusRiveja <- lokusRiveja + 1 # locus row
-		line <- readLines(fid)[3 + lokusRiveja]
+		line <- fid[2 + lokusRiveja]
 	}
 
 	if (lokusRiveja > 1) {
@@ -29,38 +28,34 @@ lueGenePopData <- function (tiedostonNimi) {
 	ninds <- 0
 	poimiNimi <- 1
 	digitFormat <- -1
-	while (line != -1) {
+	while (lokusRiveja < length(fid) - 2) {
-		line <- readLines(fid)[lokusRiveja + 1]
+		lokusRiveja <- lokusRiveja + 1 # Keeps the loop moving along
-		lokusRiveja <- lokusRiveja + 1
+		line <- fid[lokusRiveja + 2]
-
 		if (poimiNimi == 1) {
-			# Edellinen rivi oli 'pop'
+			# Edellinen rivi oli 'pop' (previous line was pop)
 			nimienLkm <- nimienLkm + 1
 			ninds <- ninds + 1
 			if (nimienLkm > size(popnames, 1)) {
-				popnames <- c(popnames, cell(10, 2))
+				popnames <- rbind(popnames, cell(10, 2))
 			}
 			nimi <- lueNimi(line)
 			if (digitFormat == -1) {
 				digitFormat <- selvitaDigitFormat(line)
 				divider <- 10 ^ digitFormat
 			}
-			popnames[nimienLkm, 1] <- nimi   #N<>in se on greedyMix:iss<73>kin?!?
+			popnames[nimienLkm, 1] <- nimi #N<>in se on greedyMix:iss<73>kin?!?
 			popnames[nimienLkm, 2] <- ninds
 			poimiNimi <- 0
-
 			data <- addAlleles(data, ninds, line, divider)
-
 		 } else if (testaaPop(line)) {
 			poimiNimi <- 1
-
+		 } else if (!is.na(line)) {
-		 } else if (line != -1) {
 			ninds <- ninds + 1
 			data <- addAlleles(data, ninds, line, divider)
 		}
 	}
 
-	data <- data[1:(ninds * 2),]
+	data <- data[1:(ninds * 2), ]
-	popnames <- popnames[seq_len(nimienLkm),]
+	popnames <- popnames[seq_len(nimienLkm), ]
 	return(list(data = data, popnames = popnames))
 }

R/lueNimi.R

@@ -1,17 +1,23 @@
 #' @title Read the Name
-#' @description Reads the line name
+#' @description Returns the part of the line from the beginning that is before the comma. Useful for returning the name of a GenePop area
 #' @param line line
 #' @return nimi
 #' @export
 lueNimi <- function(line) {
+	# ==========================================================================
+	# Validation
+	# ==========================================================================
+	if (!grepl(",", line)) {
+		stop("There are no commas in this line")
+	}
 	# Palauttaa line:n alusta sen osan, joka on ennen pilkkua.
 	n <- 1
-	merkki <- line[n]
+	merkki <- substring(line, n, n)
 	nimi <- ''
 	while (merkki != ',') {
 		nimi <- c(nimi, merkki)
 		n <- n + 1
-		merkki <- line[n]
+		merkki <- substring(line, n, n)
 	}
-	return(nimi)
+	return(paste(nimi, collapse=""))
 }

R/selvitaDigitFormat.R

@@ -7,23 +7,22 @@ selvitaDigitFormat <- function(line) {
 	# Genepop-formaatissa olevasta datasta. funktio selvitt<74><74>
 	# rivin muodon perusteella, ovatko datan alleelit annettu
 	# 2 vai 3 numeron avulla.
-
 	n <- 1
-	merkki <- line[n]
+	merkki <- substring(line, n, n)
 	while (merkki != ',') {
 		n <- n + 1
-		merkki <- line[n]
+		merkki <- substring(line, n, n)
 	}
 
-	while (!any(merkki == '0123456789')) {
+	while (!any(merkki %in% as.character(0:9))) {
 		n <- n + 1
-		merkki <- line[n]
+		merkki <- substring(line, n, n)
 	}
 	numeroja <- 0
-	while (any(merkki == '0123456789')) {
+	while (any(merkki %in% as.character(0:9))) {
 		numeroja <- numeroja + 1
 		n <- n + 1
-		merkki <- line[n]
+		merkki <- substring(line, n, n)
 	}
 
 	df <- numeroja / 2