# -------------------------------------------------------------------------------------------------------------------------  #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  #                                                                                                                            #
  #           File Name              :  countFlips.R                                                                           #
  #           Last Updated Funclist  :  15 Feb 2014,  1:13 AM (Saturday)                                                       #
  #                                                                                                                            #
  #           Author Name            :  Rick Saporta                                                                           #
  #           Author Email           :  RickSaporta@gmail.com                                                                  #
  #           Author URL             :  www.github.com/rsaporta                                                                #
  #                                                                                                                            #
  #           Packages Called        :  NA                                                                                     #
  #           Packages Used via NS   :  NA                                                                                     #
  #                                                                                                                            #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  #                                                                                                                            #
  #   coinflip           ( n=1, levs=c("H", "T") )                                                                             #
  #   tableSeq           ( flips, max=NULL, byfactor=TRUE, only=NULL )                                                         #
  #   mergeTablesByNames ( tables, rnames=NULL, cnames=NULL )                                                                  #
  #   tableSeq.usingWhileLoop ( flips, max=NULL, bylevels=TRUE )                                                               #
  #                                                                                                                            #
  #                                                                                                                            #
  #                                                     <END FUNCS>                                                            #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  # -------------------------------------------------------------------------------------------------------------------------  #

coinflip <- function(n=1, levs=c("H", "T")) {
# creates a random sequence of n events, 
# whose potential outcomes are levs
	
	#lng used to calculate runif limits
	lng <- ifelse(length(levs)<2, 2, length(levs))

	flips <- factor(round(runif(n, 1, lng)))
	levels(flips) <- levs

	return(flips)
}

#------------------------

tableSeq <- function(flips, max=NULL, byfactor=TRUE, only=NULL) {
	
	lng <- length(flips)	


	# Sames is a vector that determines wheter or not an element is same as previous neighbor; first element is false. 
	#  Every FALSE will represent the start of a new sequence. 
	#  Every TRUE  will represent a +1 to the counter
	#  Instead of counting via iteration, we will convert the entire vector `same` to a 
	#    string vector of a long series of 0's and 1's, eg:  00101111010001101001101, 
	#    where 0 represents a new sequence and 1 represents continuing the current sequence 
	#  Then we will split the string on along the 0's to get strings of different lengths, 
	#    where the length of the string is one-less than the length of the sequence. 

		# compare each element in flips with the one prior, we add an NA to avoid the warning of different lengths
		sames <- c(flips[-1]) == c(flips[-lng])
	
		# add a FALSE for first element (ie, starting a new sequence at first element) 
		sames <- c(FALSE, sames)

		# add names to sames equivalent to flips' value. Used for aggregating by factor
		names(sames) <- flips
		

	## AGGREGATE

	# if just a full tally required, count em up. Else, sapply and count by factor
	if (!byfactor) {
		counts <- table(sapply(strsplit(paste(as.numeric(sames), collapse=""), 0), nchar) + 1)
		ret    <- cbind(length=as.numeric(names(counts)), totals=counts)
	} else {
		tables <- sapply(unique(names(sames)), function(x)
				table(sapply(strsplit(paste(as.numeric(sames[names(sames)==x]), collapse=""), 0), nchar) + 1)
			)

		# calculate the factor names
		factorNames <- ifelse(is.null(levels(flips)), list(unique(flips)), list(levels(flips)))[[1]]

		# if user specified either a `max` or an `only`, find the max between them 
		if ( !is.null(max) || !is.null(only) )  {
				maximum <- max(c(as.numeric(max), as.numeric(only)))  # note: max is used as argument and func. be careful
				
				# if `only` would be truncated by max, issue warning, but keep maximum as it is
				if (any(only>max) && !is.null(max))
					warning("Values in `only` are larger than `max`. Using ", maximum, " as max.")
		# else find the largest count by taking all the names of all the tables, as numbers
		} else {
	      maximum <- max(as.numeric(unique(unlist(sapply(tables, names)))))
		}

		# rnames is used for mergeTableByNames and again for the return 
		rnames=as.character(1:maximum)

		# create a merged table
		ret <- mergeTablesByNames(tables, rnames=rnames, cnames=factorNames)

		# add columns for totals and length
		ret <- cbind(length=as.numeric(rownames(ret)), totals=rowSums(ret), ret)

	} # end else

	# if values given for `only`, crop ret accordingly
		# note: originally had additional if loop nested here, `if (!all(only %in% rnames))`
		# but not needed since that is an impossible condition
	if (!is.null(only)) 
		ret <- ret[as.character(only), ]

	ret[order(ret[,"totals"], decreasing=TRUE), ]
} # end tableSeq


#------------------------

mergeTablesByNames <- function(tables, rnames=NULL, cnames=NULL) {

	# tables should be a list of tables.  if it is not, return error
	if (!is.list(tables))
		stop("tables must be a list")

	# if no row names explicitly given, calculate by combining all names within the list
	if (is.null(rnames)) 
		rnames <- unique(unlist(sapply(tables, names)))

	# if no col names explicitly given, calculate by taking the names of the list elements
	if (is.null(rnames)) {
		cnames <- names(tables)
	
	# if col names are given, ensure they are all represented in tables and sort tables according to cnames
	} else {
		# any cnames missing from tables, add as NA
		tables[cnames[!(cnames %in% names(tables))]] <- NA

		# reorder tables to match the order in cnames
		tables <- tables[cnames]
	}

	# count each table, according to rnames
	ret <- sapply(tables, "[", rnames)

	# clean NA's, add totals and make pretty
	ret[is.na(ret)] <- 0
	dimnames(ret) <- list(rnames, cnames)
	
	return(ret)
}


#--------------------------------------

# Keep the old function as a good example of going from a 
#  while-loop algorithm to one leveraging vectors

tableSeq.usingWhileLoop <- function(flips, max=NULL, bylevels=TRUE) {
	
	lng <- length(flips)	

# --   beging while loop implementaiton

	# intialize counter
	tIndx <- 0
	totals <- list()
	
	# intialize flip index
	flip <- 1
	
	# Count the sequences
	while (flip <= lng) {
		curnt <- flips[[flip]]
		tIndx <- tIndx + 1
		totals[[tIndx]] <- 0
		names(totals)[[tIndx]] <- as.character(curnt)
		while (flip <= lng  && flips[[flip]] == curnt) {
			totals[[tIndx]] <- totals[[tIndx]] + 1
			flip <- flip+1
		}			
	}	

	# make the list of sequences into a simplified vector
	totals <- unlist(totals)

	### AGGREGATE

		# We will return results upto maximum, which unless user specified, is the largest sequence in the table
		maximum <- ifelse(is.null(max), max(as.numeric(names(table(totals)))), max)

		# the column names in table will either be the levels of flips if available, else the names of flips. 
		factorNames <- ifelse(is.null(levels(flips)), list(unique(flips)), list(levels(flips)))[[1]]
		countNames  <- as.character(1:maximum)
				
		# create table count, first tally-up by factor, then aggregate to nice table
		tables <- lapply(factorNames, function(x) table(totals[names(totals)==x]))
		mat    <- sapply(tables, "[", countNames)

		# clean NA's, add totals and make pretty
		mat[is.na(mat)] <- 0
		mat <- cbind(mat, rowSums(mat, na.rm=TRUE))
		dimnames(mat) <- list(countNames, c(factorNames, "totals"))
		
		# return matrix ordered by totals
		mat[order(mat[,"totals"],decreasing=TRUE),]	

}