R/complicate.fourier.descriptor.R

Defines functions complicate.fourier.descriptor

Documented in complicate.fourier.descriptor

#' Add amplitude weights to the zero-weighted frequencies of an existing
#' Fourier descriptor generated by
#' \code{\link{random.fourier.descriptor}}
#' 
#' Returns a new Fourier descriptor.
#'
#' @include random-fourier-descriptor.R
#' @param fourier.descriptor A Fourier descriptor object generated by
#'   \code{\link{random.fourier.descriptor}}
#' @param new.frequencies How many frequency components should be added?
#'   Defaults to 1.
#' @param generating.function An anonymous function that returns an amplitude
#'   weight. The default function adds weight 1 to each new frequency.
#' @export
#' @examples
#' fourier.descriptor <- random.fourier.descriptor(12)
#'
#' fd <- complicate.fourier.descriptor(fourier.descriptor)
#'
#' fd <- complicate.fourier.descriptor(fourier.descriptor,
#'                                     generating.fourier = functions() {return(runif(1))})
#' @usage
#' fourier.descriptor <- random.fourier.descriptor(12)
#'
#' fd <- complicate.fourier.descriptor(fourier.descriptor)

complicate.fourier.descriptor <- function(fourier.descriptor,
                                          quantity = 1,
                                          generating.function = function() {return(1)})
{
  zero.frequencies <- which(fourier.descriptor[['Amplitude']] == 0)
  even.frequencies <- which(1:length(fourier.descriptor[['Amplitude']]) %% 2 == 0)
  allowed.frequencies <- intersect(zero.frequencies, even.frequencies)

  if (length(allowed.frequencies) < quantity)
  {
    stop('Not enough frequencies to perform complication')
  }
  
  if (length(allowed.frequencies) == 1)
  {
    add.frequencies <- allowed.frequencies
  }
  else
  {
    add.frequencies <- sample(allowed.frequencies, quantity)
  }
  
  for (frequency in add.frequencies)
  {
    fourier.descriptor[['Amplitude']][frequency] <- generating.function()
  }
  
  return(fourier.descriptor)
}
johnmyleswhite/FourierDescriptors documentation built on May 19, 2019, 5:17 p.m.