mw.scree {ldsa}R Documentation

~~function to do ... ~~

Description

~~ A concise (1-5 lines) description of what the function does. ~~

Usage

mw.scree(dat, freqcount = FALSE, lim.frac = 1, lim.iter = NULL)

Arguments

dat ~~Describe dat here~~
freqcount ~~Describe freqcount here~~
lim.frac ~~Describe lim.frac here~~
lim.iter ~~Describe lim.iter here~~

Details

~~ If necessary, more details than the description above ~~

Value

~Describe the value returned If it is a LIST, use

comp1 Description of 'comp1'
comp2 Description of 'comp2'

...

Warning

....

Note

~~further notes~~

~Make other sections like Warning with section{Warning }{....} ~

Author(s)

~~who you are~~

References

~put references to the literature/web site here ~

See Also

~~objects to See Also as help, ~~~

Examples

##---- Should be DIRECTLY executable !! ----
##-- ==>  Define data, use random,
##--    or do  help(data=index)  for the standard data sets.

## The function is currently defined as
function(dat,freqcount=FALSE,lim.frac=1,lim.iter=NULL){
  #Create functions to calculate binary values
  bv<-function(x)
    sum(2^(1:length(x)-1)*x)
  bn<-function(x,len){
    v<-rep(0,len)
    for(i in 1:len){
      v[i]<-x%%2
      x<-x%/%2
    }
    v
  }
  #Write a function to add values and freqs to y (and to eliminate duplicates)
  addvalfreq<-function(y){
    #Create a function to calculate binary values
    y<-cbind(y,apply(y,1,bv))  #Compute binary values for all sequences
    y<-y[order(y[,NCOL(y)]),]      #Sort rows into ascending order
    frq<-as.vector(table(y[,NCOL(y)]))    #Build a frequency vector
    y<-y[!duplicated(y[,NCOL(y)]),]       #Remove duplicates
    y<-cbind(y,frq)   #Append the frequencies (which are ordered by bv)
    y
  }
  #Tabulate the existing data
  nmb<-NCOL(dat)
  if(freqcount){
    dat<-cbind(dat[,1:(NCOL(dat)-1)],apply(dat[,1:(NCOL(dat)-1)],1,bv),dat[,NCOL(dat)])
  }else{
    dat<-dat[!apply(is.na(dat),1,any),]
    dat<-addvalfreq(dat)
  }  
  dat<-dat[rev(order(dat[,NCOL(dat)])),] #Sort in descending order by freq
  #Accumulate the scree statistics
  tab<-matrix(c(0,0,0,0,0),nr=1,nc=5)
  i<-1
  pop<-sum(dat[,NCOL(dat)])
  flag<-FALSE
  while(!flag){
    stats<-vector()
    if(i>1)
      lat<-mw.intclose(dat[1:i,1:(NCOL(dat)-2)])  #Draw the lattice
    else
      lat<-matrix(dat[1:i,1:(NCOL(dat)-2)],nr=1)
    stats[1]<-i
    stats[2]<-NROW(lat)
    stats[3]<-sum(dat[1:i,NCOL(dat)])
    stats[4]<-0
    if(i>2)
      stats[5]<-NROW(mw.D(lat))
    else
      stats[5]<-1
    for(j in 1:NROW(lat)){  #Accumulate covered cases
      m<-match(bv(lat[j,]),dat[,NCOL(dat)-1])
      if(!is.na(m))
        stats[4]<-stats[4]+dat[m,NCOL(dat)]
    }
    #Have we covered enough states?
    if((is.null(lim.iter)&&(stats[4]>=pop*lim.frac))||(i==lim.iter))
        flag<-TRUE
    tab<-rbind(tab,stats)
    i<-i+1
  }
  #Apply some post-processing
  tab<-cbind(tab[,c(1,2,5,3)],tab[,3]/pop,pop-tab[,3],(pop-tab[,3])/pop,tab[,4],tab[,4]/pop,pop-tab[,4],(pop-tab[,4])/pop)
  colnames(tab)<-c("N","Lattice Size","N MIREs","N Covered","% Covered","N Uncovered","% Uncovered","N Lattice Covered","% Lattice Covered","N Lattice Uncovered","% Lattice Uncovered")
  rownames(tab)<-1:NROW(tab)
  #Return the result
  class(tab)<-"mw.scree"
  tab
  }

[Package ldsa version 0.1-2 Index]