diff search.R @ 0:e66bb061af06 draft

planemo upload for repository https://github.com/workflow4metabolomics/lcmsmatching.git commit 3529b25417f8e1a5836474c9adec4b696d35099d-dirty
author prog
date Tue, 12 Jul 2016 12:02:37 -0400
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/search.R	Tue Jul 12 12:02:37 2016 -0400
@@ -0,0 +1,64 @@
+if ( ! exists('binary.search')) { # Do not load again if already loaded
+
+	# Run a binary search on a sorted array.
+	# val       The value to search.
+	# tab       The array of values, sorted in ascending order.
+	# lower     If set to NA, then search for the first value found by the binary search. If set to TRUE, find the value with the lowest index in the array. If set to FALSE, find the value with the highest index in the array.
+	# first     The index of the array from which to start (1 by default).
+	# last      The index of the array where to stop searching (end of the array by default).
+	# Returns the index of the found value, or NA.
+	binary.search <- function(val, tab, lower = NA, first = 1L, last = length(tab)) 
+	{ 
+		# Check array & value
+		if (is.null(tab))
+			stop('Argument "tab" is NULL.')
+		if (is.null(val))
+			stop('Argument "val" is NULL.')
+	
+		# Wrong arguments
+		if (is.na(val) || last < first || length(tab) == 0)
+			return(NA_integer_)
+	
+		# Find value
+		l <- first
+		h <- last
+		while (h >= l) { 
+	
+			# Take middle point
+			m <- (h + l) %/% 2
+			# Found value
+			if (tab[m] == val) {
+				if (is.na(lower))
+					return(m)
+				if (lower && m > first) {
+					for (i in (m-1):first)
+						if (tab[i] != val)
+							return(i+1)
+				}
+				else if ( ! lower && m < last)
+					for (i in (m+1):last)
+						if (tab[i] != val)
+							return(i-1)
+				return(m)
+			}
+			
+			# Decrease higher bound
+			else if (tab[m] > val) h <- m - 1
+	
+			# Increase lower bound
+			else l <- m + 1
+		} 
+	
+		# Value not found
+		if ( ! is.na(lower)) {
+			# Look for lower or higher bound
+			if (lower)
+				return(if (h < first) NA_integer_ else h)
+			else
+				return(if (l > last) NA_integer_ else l)
+		}
+		
+		return(NA_integer_)
+	} 
+
+} # end of load safe guard