package MotifObject;
use strict;

=head1 Class:MotifObject

=head2 Attributes

=over 4

=item 1
$self->{ELEMENTS} - The array of sequences and annotation that make up a motif

=item 2
$self->{LOGO} - The array containing the information content at each position used to generate logos 

=item 3
$self->{ERROR} - The approximate information error per position

=item 4
$self->{BITS} - The bit score of the current MotifObject

=item 5
$self->{MOTIFSCORE} - The motif finder score of the current motif

=item 6
$self->{GROUP} - The group specificity of the current MotifObject

=item 7
$self->{POSITIONAL} - The positional specificity of the current MotifObject

=item 8
$self->{POSITION} - The most common position of the current MotifObject

=item 9
$self->{PROGRAM} - The program that identified the current MotifObject

=item 10
$self->{CONSENSUS} - The motif consensus sequence generated by MotifStats

=item 11
$self->{ASTERIX} - Asterix sequence equal to the length of the motif used as a place holder

=item 12
$self->{ACTASTER} - Asterix sequence denoting positions with more than 0.5 bits of information

=item 13
$self->{MOTIFNUMBER} - The motif number

=item 14
$self->{FILE} - The motif finder output file from which the current MotifObject was derived

=item 15
$self->{SCANSTATS} - Stores a SCANFUNCTIONS object for the current MotifObject

=item 16
$self->{SCANFILE} - The ScanACE outfile for the current MotifObject

=item 17
$self->{TRANSFAC} - The transfac id of the motif to which the current MotifObject matches (as defined by correlation)

=item 18
$self->{TRANSCORR} - The correlation of the current MotifObject to the corresponding Transfac hit

=item 19
$self->{CLUSTER} - The cluster in which the current MotifObject resides

=item 20
$self->{ORIENTATION} - The best viewing orientation for the motif

=item 21
$self->{BITRANK} - The rank of the current MotifObject with respect to Bit Score

=item 22
$self->{RATIORANK} - The rank of the current MotifObject with respect to frequency ratio

=item 23
$self->{MOTIFSCORERANK} - The rank of the current MotifObject with respect to Motif Score

=item 24
$self->{GROUPRANK} - The rank of the current MotifObject with respect to Group Specificity

=item 25
$self->{SITERANK} - The rank of the current MotifObject with respect to Site Specificity


=item 26
$self->{TOTALRANK} - The total rank of the current MotifObject.  Total rank is defined by all of the current defined ranks

=item 27
$self->{ACTIVE} - Whether the motif object is active

=back

=head2 Methods


=head3 new


=head4 Parameters

=over 4

=item 1
none

=back

=head4 Returns

=over 4

=item 1 
A new uninitialized MotifObject

=back

=head4 Description

=over 4

=item 1
Constructor. Returns a new MotifObject.  All attributes still need to be set

=back

=cut

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self  = {};
    
    #Arrays that hold information the motit
    $self->{ELEMENTS} = (); #This array contains information about the sequences that make up the motif 
    $self->{LOGO} = (); #This array contains information about the information contained at each position
    $self->{GENES} = (); #This array contains the nonredundent names of the genes used to make the motif
    $self->{PFM} = (); #This array contains a position frequency matrix of the motif
    
    #scores generated while loading the motifs
    $self->{PROGRAM} = ''; #name of the motiffinder used to obtain the motif
    $self->{FINDERS} = (); #name of the motiffinder used to obtain the motif
    $self->{SETS} = ();
    $self->{SET} = '';
    $self->{ERROR} = ''; #This is the positional bit error estimate 
    $self->{BITS} = ''; #This is the number of bits of information for the whole motif
    $self->{ORIENTATION} = ''; #This is best viewing orientation for the motif
    $self->{BLOCKS} = (); #this holds all of the blocks within a motif over an information threshold
    $self->{DESCRIPTION} = (); #Hold information about the motif such as gapping, repeats and palendroms
    
    #scores from MotifStats
    $self->{FILE} = '';  #file name of the scanace file used to generate motif statistics
    $self->{MOTIFSCORE} = ''; #This is the score that is generated by the motif finder
    $self->{GROUP} = ''; #The is the group specificity score as calculated by MotifStats
    $self->{POSITIONAL} = ''; #This is the positional bias score as calculated by MotifStats
    $self->{POSITION} = ''; #This is the most favored position at which the motif is found
    $self->{CONSENSUS} = ''; #This is the consensus sequence representing the motif
    
    $self->{ASTERIX} = ''; #This is a string of asterix that is the same length as the motif
    $self->{ACTASTER} = ''; #This string of asterix denote positions with more than 0.5 bits of information
    $self->{MOTIFNUMBER} = '';
    
    #scores from ScanFunctions->analysis
    $self->{SCANSTATS} = (); #holds a reference to a ScanFunction object
    $self->{SCANFILE} = ''; #The ScanACE output file containing hits for the current motif
    
    #transfac related programs
    $self->{TRANSFAC} = (); # a transfac identification
    
    #compareace cluster information
    $self->{CLUSTER} = ''; #This function holds the current cluster assignment for the motif
    
    #ranks from marks code
    $self->{BITRANK} = '';
    $self->{SUPPORTRANK} = '';
    $self->{RATIORANK} = '';
    $self->{MOTIFSCORERANK} = '';
    $self->{GROUPRANK} = '';
    $self->{SITERANK} = '';
    $self->{TOTALRANK} = '';
    
    $self->{ACTIVE} = 1;
    
    bless($self, $class);
    return $self;
};

=head3 DESTROY

=head4 Parameters

=over 4

=item 1
none

=back

=head4 Returns

=over 4

=item 1 
Nothing

=back

=head4 Description

=over 4

=item 1
Destructor. Destroys the current MotifObject

=back

=cut

sub DESTROY {
    my $self = shift;
    return;
};

=head3 set_motifscore_rank

=head4 Parameters

=over 4

=item 1
An integer that is the MOTIFSCORERANK for the current MotifObject

=back

=head4 Returns

=over 4

=item 1 
Nothing

=back

=head4 Description

=over 4

=item 1
Sets the MOTIFSCORERANK of the current MotifObject

=back

=cut


sub set_motifscore_rank {
    my $self = shift;
    my $rank = shift;
    $self->{MOTIFSCORERANK} = $rank;
    return;
};

#Update method to change rank of a motif in terms of Support Score

=head3 set_support_rank


=head4 Parameters

=over 4

=item 1
An integer that is the SUPPORTRANK for the current MotifObject

=back

=head4 Returns

=over 4

=item 1 
Nothing

=back

=head4 Description

=over 4

=item 1
Sets the SUPPORTRANK of the current MotifObject

=back

=cut


sub set_support_rank {
    my $self = shift;
    my $rank = shift;
    $self->{SUPPORTRANK} = $rank;
    return;
};

#Update method to change rank of a motif in terms of Group Specificity

=head3 set_group_rank

=head4 Parameters

=over 4

=item 1
An integer that is the GROUPRANK for the current MotifObject

=back

=head4 Returns

=over 4

=item 1 
Nothing

=back

=head4 Description

=over 4

=item 1
Sets the GROUPRANK of the current MotifObject

=back

=cut

sub set_group_rank {
    my $self = shift;
    my $rank = shift;
    $self->{GROUPRANK} = $rank;
    return;
}

#Update method to change the rank of a motif in terms of ratio score

=head3 set_ratio_rank


=head4 Parameters

=over 4

=item 1
An integer that is the RATIORANK for the current MotifObject

=back

=head4 Returns

=over 4

=item 1 
Nothing

=back

=head4 Description

=over 4

=item 1
Sets the RATIORANK of the current MotifObject

=back

=cut

sub set_ratio_rank {
    my $self = shift;
    my $rank = shift;
    $self->{RATIORANK} = $rank;
    return;
}

#update method to change the rank of a motif in terms of bit score

=head3 set_bits_rank


=head4 Parameters

=over 4

=item 1
An integer that is the BITRANK for the current MotifObject

=back

=head4 Returns

=over 4

=item 1 
Nothing

=back

=head4 Description

=over 4

=item 1
Sets the BITRANK of the current MotifObject

=back

=cut

sub set_bits_rank{
    my $self = shift;
    my $rank = shift;
    $self->{BITRANK} = $rank;
    return;
}

#update method to change the rank of a motif in terms of site specificity

=head3 set_site_rank


=head4 Parameters

=over 4

=item 1
An integer that is the SITERANK for the current MotifObject

=back

=head4 Returns

=over 4

=item 1 
Nothing

=back

=head4 Description

=over 4

=item 1
Sets the SITERANK of the current MotifObject

=back

=cut

sub set_site_rank {
    my $self = shift;
    my $rank = shift;
    $self->{SITERANK} = $rank;
    return;
}

=head3 set_total_rank


=head4 Parameters

=over 4

=item 1
An integer that is the TOTALRANK for the current MotifObject

=back

=head4 Returns

=over 4

=item 1 
Nothing

=back

=head4 Description

=over 4

=item 1
Sets the TOTALRANK of the current MotifObject

=back

=cut

sub set_total_rank{
    my $self = shift;
    my $rank = shift;
    $self->{TOTALRANK} = $rank;
    return;
}


#Accessor method to get the motif rank

=head3 get_motifscore_rank


=head4 Parameters

=over 4

=item 1
None

=back

=head4 Returns

=over 4

=item 1 
An integer that is the MOTIFSCORERANK for the current MotifObject

=back

=head4 Description

=over 4

=item 1
Accessor method to get the MOTIFSCORERANK of the current MotifObject

=back

=cut

sub get_motifscore_rank {
    my $self = shift;
    if (defined $self->{MOTIFSCORERANK}){
        return $self->{MOTIFSCORERANK}
    }
    else { return 0 };
}

#Accessor method to get the group specificity rank


=head3 get_group_rank


=head4 Parameters

=over 4

=item 1
None

=back

=head4 Returns

=over 4

=item 1 
An integer that is the GROUPRANK for the current MotifObject

=back

=head4 Description

=over 4

=item 1
Accessor method to get the GROUPRANK of the current MotifObject

=back

=cut


sub get_group_rank {
    my $self = shift;
    if (defined $self->{GROUPRANK}){
        return $self->{GROUPRANK}
    }
    else { return 0 };
}

#Accessor method to get the group specificity rank


=head3 get_support_rank


=head4 Parameters

=over 4

=item 1
None

=back

=head4 Returns

=over 4

=item 1 
An integer that is the SUPPORTRANK for the current MotifObject

=back

=head4 Description

=over 4

=item 1
Accessor method to get the SUPPORTRANK of the current MotifObject

=back

=cut


sub get_support_rank {
    my $self = shift;
    if (defined $self->{SUPPORTRANK}){
        return $self->{SUPPORTRANK}
    }
    else { return 0 };
}

#Accessor method to get the ratio rank of a motif


=head3 get_ratio_rank


=head4 Parameters

=over 4

=item 1
None

=back

=head4 Returns

=over 4

=item 1 
An integer that is the RATIORANK for the current MotifObject

=back

=head4 Description

=over 4

=item 1
Accessor method to get the RATIORANK of the current MotifObject

=back

=cut


sub get_ratio_rank {
    my $self = shift;
    if (defined $self->{RATIORANK}){
        return $self->{RATIORANK}
    }
    else { return 0 };
}

#Accessor method to get the bit rank of a motif

=head3 get_bit_rank


=head4 Parameters

=over 4

=item 1
None

=back

=head4 Returns

=over 4

=item 1 
An integer that is the BITRANK for the current MotifObject

=back

=head4 Description

=over 4

=item 1
Accessor method to get the BITRANK of the current MotifObject

=back

=cut


sub get_bit_rank {
    my $self = shift;
    if (defined $self->{BITRANK}){
        return $self->{BITRANK}
    }
    else { return 0 };
}

#Accessor method to the site rank of a motif

=head3 get_site_rank


=head4 Parameters

=over 4

=item 1
None

=back

=head4 Returns

=over 4

=item 1 
An integer that is the SITERANK for the current MotifObject

=back

=head4 Description

=over 4

=item 1
Accessor method to get the SITERANK of the current MotifObject

=back

=cut

sub get_site_rank {
    my $self = shift;
    if (defined $self->{SITERANK}){
        return $self->{SITERANK}
    }
    else { return 0 };
}

#Accessor method to get the total rank of a motif

=head3 get_total_rank

=head4 Parameters

=over 4

=item 1
None

=back

=head4 Returns

=over 4

=item 1 
An integer that is the TOTALRANK for the current MotifObject

=back

=head4 Description

=over 4

=item 1
Accessor method to get the TOTALRANK of the current MotifObject

=back

=cut

sub get_total_rank{
    my $self = shift;
    if (defined $self->{TOTALRANK}){
        return $self->{TOTALRANK}
    }
    else { return 0 };
}

#a method to list the total rank of a motif object

=head3 list_total_rank


=head4 Parameters

=over 4

=item 1
None

=back

=head4 Returns

=over 4

=item 1 
A tab deliminated string containing the parent file name, total rank, motif score, group speficity, positional specificity, average position, the frequency ratio and the bit score of the current MotifObject

=back

=head4 Description

=over 4

=item 1
Method that returns a tab deliminated string that contains the information outlined above

=back

=cut

sub list_total_rank{
    my $self = shift;
    my $line = join("\t", $self->{FILE},
                $self->get_total_rank(),
                $self->{MOTIFSCORE},
                $self->{GROUP},
                $self->{POSITIONAL},
                $self->{POSITION},
                $self->get_ratio(),
                $self->get_bits(),
                $self->{CONSENSUS}
                );
    return $line;
}

=head3 list_ranks


=head4 Parameters

=over 4

=item 1
None

=back

=head4 Returns

=over 4

=item 1 
A tab deliminated string with (in this order) GROUPRANK, MOTIFSCORERANK, BITRANK, RATIORANK, SITERANK, and TOTALRANK of the current MotifObject

=back

=head4 Description

=over 4

=item 1
If a rank is not defined a 0 is inserted as a place holder

=back

=cut

sub list_ranks {
    my $self = shift;
    my @ranks;
    if (defined($self->{GROUPRANK})) {
        push @ranks, $self->{GROUPRANK};
    }
    else {
        my $notDefined = 0;
        push @ranks, $notDefined;
    }
    if (defined($self->{MOTIFSCORERANK})) {
        push @ranks, $self->{MOTIFSCORERANK};
    }
    else {
        my $notDefined = 0;
        push @ranks, $notDefined;
    }
    if (defined($self->{BITRANK})) {
        push @ranks, $self->{BITRANK};
    }
    else {
        my $notDefined = 0;
        push @ranks, $notDefined;
    }
    if (defined($self->{RATIORANK})) {
        push @ranks, $self->{RATIORANK};
    }
    else {
        my $notDefined = 0;
        push @ranks, $notDefined;
    }
    if (defined($self->{SUPPORTRANK})) {
        push @ranks, $self->{SUPPORTRANK};
    }
    else {
        my $notDefined = 0;
        push @ranks, $notDefined;
    }
    if (defined($self->{SITERANK})) {
        push @ranks, $self->{SITERANK};
    }
    else {
        my $notDefined = 0;
        push @ranks, $notDefined;
    }
    if (defined($self->{TOTALRANK})) {
        push @ranks, $self->{TOTALRANK};
    }
    else {
        my $notDefined = 0;
        push @ranks, $notDefined;
    }
    my $returnRank = join("\t", @ranks);
    return $returnRank;
}

#A method to list all of the defined ranks associated with a motif object
#Assigns a value of 0 to those ranks not previously defined

=head3 list_all_ranks

=head4 Parameters

=over 4

=item 1
None

=back

=head4 Returns

=over 4

=item 1 
A tab deliminated string with (in this order) parent file, GROUPRANK, MOTIFSCORERANK, BITRANK, RATIORANK, SITERANK, TOTALRANK, and the consensus sequence of the current MotifObject

=back

=head4 Description

=over 4

=item 1
If a rank is not defined a 0 is inserted as a place holder

=item 2
Very similar to list_ranks except also returns the parent file name and the consensus sequence

=back

=cut

sub list_all_ranks {
    my $self = shift;
    my @ranks;
    push @ranks, $self->{FILE};
    #lets make sure the total rank is set
    if (defined($self->{GROUPRANK})) {
        push @ranks, $self->{GROUPRANK};
    }
    else {
        my $notDefined = 0;
        push @ranks, $notDefined;
    }
    if (defined($self->{MOTIFSCORERANK})) {
        push @ranks, $self->{MOTIFSCORERANK};
    }
    else {
        my $notDefined = 0;
        push @ranks, $notDefined;
    }
    if (defined($self->{BITRANK})) {
        push @ranks, $self->{BITRANK};
    }
    else {
        my $notDefined = 0;
        push @ranks, $notDefined;
    }
    if (defined($self->{RATIORANK})) {
        push @ranks, $self->{RATIORANK};
    }
    else {
        my $notDefined = 0;
        push @ranks, $notDefined;
    }
    if (defined($self->{SUPPORTRANK})) {
        push @ranks, $self->{SUPPORTRANK};
    }
    else {
        my $notDefined = 0;
        push @ranks, $notDefined;
    }
    if (defined($self->{SITERANK})) {
        push @ranks, $self->{SITERANK};
    }
    else {
        my $notDefined = 0;
        push @ranks, $notDefined;
    }
    if (defined($self->{TOTALRANK})) {
        push @ranks, $self->{TOTALRANK};
    }
    else {
        my $notDefined = 0;
        push @ranks, $notDefined;
    }
    push @ranks, $self->{CONSENSUS};
    my $returnRank = join("\t", @ranks);
    return $returnRank;
}

=head3 get_support

=head4 Parameters

=over 4

=item 1
None

=back

=head4 Returns

=over 4

=item 1 
Support score from ScanFunctions

=back

=head4 Description

=over 4

=item 1
This function returns the support score from ScanFunctions

=back

=cut

#Accessor function for the support score which is the same as log likelihood
sub get_support {
    my $self = shift;
    return $self->{SCANSTATS}->get_support();
};

=head3 get_ratio

=head4 Parameters

=over 4

=item 1
None

=back

=head4 Returns

=over 4

=item 1 
Ratio score from ScanFunctions

=back

=head4 Description

=over 4

=item 1
This function returns the ratio score from ScanFunctions

=back

=cut

#Accessor function for the motif frequency ratio score
sub get_ratio {
    my $self = shift;
    return $self->{SCANSTATS}->get_ratio();
};

sub set_ratio {
    my $self = shift;
    my $ratio = shift;
    $self->{SCANSTATS}->set_ratio($ratio);
};

=head3 get_site

=head4 Parameters

=over 4

=item 1
None

=back

=head4 Returns

=over 4

=item 1 
Site specificity score from ScanFunctions

=back

=head4 Description

=over 4

=item 1
This function returns the site specificity score from ScanFunctions

=back

=cut

#Accessor function for the site specificity score
sub get_site {
    my $self = shift;
    return $self->{SCANSTATS}->get_site();
};

sub set_site {
    my $self = shift;
    my $site = shift;
    $self->{SCANSTATS}->set_site($site);
};

=head3 get_testhits

=head4 Parameters

=over 4

=item 1
None

=back

=head4 Returns

=over 4

=item 1
The number of ScanACE hits within the test set

=back

=head4 Description

=over 4

=item 1
This function returns the number test set hits from ScanFunctions

=back

=cut

#Accessor function for the number of scanace hits in the test set
sub get_testhits {
    my $self = shift;
    return $self->{SCANSTATS}->get_testhits();
};

sub set_testhits {
    my $self = shift;
    my $hits = shift;
    $self->{SCANSTATS}->set_testhits($hits);
};

=head3 get_testave

=head4 Parameters

=over 4

=item 1
None

=back

=head4 Returns

=over 4

=item 1 
The average number of ScanACE hits within the test set

=back

=head4 Description

=over 4

=item 1
This function returns the average number of hits within the test set

=back

=cut

#Accessor function for average nuber of hits in the test set
sub get_testave {
    my $self = shift;
    return $self->{SCANSTATS}->get_testave();
};

sub set_testave {
    my $self = shift;
    my $average = shift;
    $self->{SCANSTATS}->set_testave($average);
};

=head3 get_testsd

=head4 Parameters

=over 4

=item 1
None

=back

=head4 Returns

=over 4

=item 1 
The standard deviation number of ScanACE hits within the test set

=back

=head4 Description

=over 4

=item 1
This function returns the standard deviation number of hits within the test set

=back

=cut

#Accessor function for standard deviation in the number of hits in the test set
sub get_testsd {
    my $self = shift;
    return $self->{SCANSTATS}->get_testsd();
};

sub set_testsd {
    my $self = shift;
    my $sd = shift;
    $self->{SCANSTATS}->set_testsd($sd);
};

=head3 get_genomehits

=head4 Parameters

=over 4

=item 1
None

=back

=head4 Returns

=over 4

=item 1
The number of ScanACE hits within the genome

=back

=head4 Description

=over 4

=item 1
This function returns the number genome hits from ScanFunctions

=back

=cut

#Accessor function for the number of scanace hits in the genome background
sub get_genomehits {
    my $self = shift;
    return $self->{SCANSTATS}->get_genomehits();
};

sub set_genomehits {
    my $self = shift;
    my $hits = shift;
    $self->{SCANSTATS}->set_genomehits($hits);
};

=head3 get_genomeave

=head4 Parameters

=over 4

=item 1
None

=back

=head4 Returns

=over 4

=item 1 
The average number of ScanACE hits within the genome

=back

=head4 Description

=over 4

=item 1
This function returns the average number of hits within the genome

=back

=cut

#Accessor function for average nuber of hits in the genome background
sub get_genomeave {
    my $self = shift;
    return $self->{SCANSTATS}->get_genomeave();
};

sub set_genomeave {
    my $self = shift;
    my $average = shift;
    $self->{SCANSTATS}->set_genomeave($average);
    return;
};

=head3 get_genomesd

=head4 Parameters

=over 4

=item 1
None

=back

=head4 Returns

=over 4

=item 1 
The standard deviation number of ScanACE hits within the genome

=back

=head4 Description

=over 4

=item 1
This function returns the standard deviation number of hits within the genome

=back

=cut

#Accessor function for standard deviation in the number of hits in the genome background
sub get_genomesd {
    my $self = shift;
    return $self->{SCANSTATS}->get_genomesd();
};

sub set_genomesd {
    my $self = shift;
    my $sd = shift;
    $self->{SCANSTATS}->set_genomesd($sd);
    return;
};

=head3 get_bits

=head4 Parameters

=over 4

=item 1
None

=back

=head4 Returns

=over 4

=item 1 
The bit score

=back

=head4 Description

=over 4

=item 1
This function returns the bit score for the current MotifObject

=back

=cut

#Accessor function for the motif bit score
sub get_bits {
    my $self = shift;
    if (defined $self->{BITS}){
        my $rounded = sprintf("%.2f", $self->{BITS});  
        return $rounded;
    }
    else {return 0};
};

sub set_bits {
    my $self = shift;
    $self->{BITS} = shift;  
    return;
};

=head3 get_finders

=head4 Parameters

=over 4

=item 1
None

=back

=head4 Returns

=over 4

=item 1 
Reference to a hash containing motif finder names

=back

=head4 Description

=over 4

=item 1
This function returns a hash containing the names of all of the motif finders that found motifs belonging to the same cluster as the current motif

=back

=cut

#Accessor function for the motif bit score
sub get_finders {
    my $self = shift;
    if (defined $self->{FINDERS}){
        return $self->{FINDERS};
    }
    else {return 0};
};

=head3 set_finders

=head4 Parameters

=over 4

=item 1
referenct to a hash containing the names of motif finders

=back

=head4 Returns

=over 4

=item 1 
Reference to a hash containing motif finder names

=back

=head4 Description

=over 4

=item 1
This function associates a hash containing the names of all of the motif finders that found motifs belonging to the same cluster as the current motif

=back

=cut

sub set_finders {
    my $self = shift;
    my $finder = shift;
    $self->{FINDERS} = $finder;
    return;
};

=head3 put_element

=head4 Parameters

=over 4

=item 1
Sequence string

=item 2
Gene name

=item 3
Sequence position

=item 4
DNA strand

=back

=head4 Returns

=over 4

=item 1 
Nothing

=back

=head4 Description

=over 4

=item 1
This function pushes a sequence element into a MotifObject

=back

=cut

#This function pushes an motif element into the stack of motif elements
#There is one sequence per element
sub put_element {
    my $self = shift;
    my $sequence = shift;
    my $gene = shift;
    my $position = shift;
    my $strand = shift;
    my $element = { SEQUENCE => $sequence,
                GENE => $gene,
                POSITION => $position,
                STRAND => $strand
               };
    push @{$self->{ELEMENTS}}, $element;
    return;
};

=head3 put_scanstats

=head4 Parameters

=over 4

=item 1
Reference to a ScanFunctions object

=back

=head4 Returns

=over 4

=item 1 
Nothing

=back

=head4 Description

=over 4

=item 1
This function allows the results from ScanFunctions to be attached to a MotifObject

=back

=cut

#This function allows the results of scanstats to be added to the
#MotifObjects data structure
sub put_scanstats{
    my $self = shift;
    $self->{SCANSTATS} = shift;
    return;
};

=head3 get_scan_sites

=head4 Parameters

=over 4

=item 1
none

=back

=head4 Returns

=over 4

=item 1 
The ScanACE sites contained in the ScanFunctions object for the current MotifObject

=back

=head4 Description

=over 4

=item 1
This function returns all the sites found by ScanFunctions for the current MotifObject

=back

=cut

sub get_scan_sites{
    my $self = shift;
    my %sites = $self->{SCANSTATS}->get_sites();
    return %sites;
};

=head3 put_motifscore

=head4 Parameters

=over 4

=item 1
The motif score for the current MotifObject

=back

=head4 Returns

=over 4

=item 1 
Nothing

=back

=head4 Description

=over 4

=item 1
This function sets the motif score for the current MotifObject

=back

=cut

#This function sets the finder specific motif score 
sub put_motifscore {
    my $self = shift;
    $self->{MOTIFSCORE} = shift;
    return;
};

=head3 put_scanfile

=head4 Parameters

=over 4

=item 1
Name of the ScanACE file generated for the current MotifObject

=back

=head4 Returns

=over 4

=item 1 
Nothing

=back

=head4 Description

=over 4

=item 1
This function puts the name of a ScanACE file into the current MotifObject

=back

=cut

#This sets the name of the scanfile for later reference
sub put_scanfile {
    my $self = shift;
    $self->{SCANFILE} = shift;
    return;
};

=head3 get_scanfile

=head4 Parameters

=over 4

=item 1
none

=back

=head4 Returns

=over 4

=item 1 
Name of the current MotifObject ScanACE file

=back

=head4 Description

=over 4

=item 1
This function gets the name of the ScanACE results file for the current MotifObject

=back

=cut

#this function returns the name of the ScanACE file for the current motif
sub get_scanfile {
    my $self = shift;
    if (defined $self->{SCANFILE}){
        return $self->{SCANFILE};
    }
    else {return 0};
};

=head3 put_cluster

=head4 Parameters

=over 4

=item 1
MotifObject cluster number

=back

=head4 Returns

=over 4

=item 1 
Nothing

=back

=head4 Description

=over 4

=item 1
This function sets the current motif cluster membership

=back

=cut

#This function sets the current motif cluster membership 
sub put_cluster {
    my $self = shift;
    $self->{CLUSTER} = shift;
    return;
};

=head3 put_cluster

=head4 Parameters

=over 4

=item 1
none

=back

=head4 Returns

=over 4

=item 1 
MotifObject cluster number

=back

=head4 Description

=over 4

=item 1
This function gets the current motif cluster membership

=back

=cut

#This function returns the current motifs cluster membership
sub get_cluster {
    my $self = shift;
    if (defined $self->{CLUSTER}){
        return $self->{CLUSTER};
    }
    else {return 0};
};

=head3 set_correlation

=head4 Parameters

=over 4

=item 1
Sets the correlation coefficent for the current MotifObject

=back

=head4 Returns

=over 4

=item 1 
Nothing

=back

=head4 Description

=over 4

=item 1
This function sets the correlation coefficent for the current MotifObject

=back

=cut

#This function sets the threshold correlation coeffiecnt used to assign transfac ids
sub set_correlation{
    my $self = shift;
    $self->{TRANSCORR} = shift;
    return;
}

=head3 get_correlation

=head4 Parameters

=over 4

=item 1
none

=back

=head4 Returns

=over 4

=item 1 
The correlation coefficent for the current MotifObject

=back

=head4 Description

=over 4

=item 1
This function gets the correlation coefficent for the current MotifObject

=item2
This function is used to assign transfac ids 

=back

=cut

#This function checks the current value of the transfac best match 
sub get_correlation{
    my $self = shift;
    my $motif = shift;
    if (exists $self->{TRANSFAC}[$motif]->{CORRELATION}){
        return $self->{TRANSFAC}[$motif]->{CORRELATION};
    }
    else {return ''};
};

sub check_transfac_hits{
    my $self = shift;
    if (exists $self->{TRANSFAC}[0]){return ($#{$self->{TRANSFAC}} + 1)}
    else{return 0};
};

sub get_transfac_hits{
    my $self = shift;
    return $self->{TRANSFAC};
};

=head3 put_transfac_id

=head4 Parameters

=over 4

=item 1
Transfac id number

=item 2
Correlation coefficent for this Transfac motif

=back

=head4 Returns

=over 4

=item 1 
Nothing

=back

=head4 Description

=over 4

=item 1
This function assigns a transfac id to the current MotifObject 

=item2
This function also updates the correlation coefficent each time the transfac id is changed

=back

=cut

sub load_transfac_hit{
    my $self = shift;
    my $coefficent = shift;
    my $index = shift;
    my $transfac = shift;
    my $name = $transfac->{MOTIFS}[$index]->get_gene_element('0');
    my $element = {ID => $name,
                   CORRELATION => $coefficent,
                   ORIENTATION => $transfac->{MOTIFS}[$index]->get_orientation(),
                   LOGO => $transfac->{MOTIFS}[$index]->get_logo()};
    push @{$self->{TRANSFAC}}, $element;
    @{$self->{TRANSFAC}} = sort {$b->{CORRELATION} <=> $a->{CORRELATION} } @{$self->{TRANSFAC}};
    return;
};

sub clear_transfac_hits{
    my $self = shift;
    $self->{TRANSFAC} = ();
    return;
};

sub put_transfac_id{
    my $self = shift;
    my $name = shift;
    my $coefficent = shift;
    my $transfac = shift;
    if (exists $transfac->{TRANSFAC}{$name}){
        my $element = {ID => $name,
                       CORRELATION => $coefficent,
                       ORIENTATION => $transfac->{MOTIFS}[$transfac->{TRANSFAC}{$name}->{MOTIF}]->get_orientation(),
                       LOGO => $transfac->{MOTIFS}[$transfac->{TRANSFAC}{$name}->{MOTIF}]->get_logo() };
        push @{$self->{TRANSFAC}}, $element;
    };
    return;
};

sub load_pfm{
    my $self = shift;
    $self->{PFM} = shift;
    return;
};

sub load_logo{
    my $self = shift;
    $self->{LOGO} = shift;
    return;
};

sub load_transfac_logo{
    my $self = shift;
    $self->{TRANSLOGO} = shift;
    return;
};

sub load_transfac_ori{
    my $self = shift;
    $self->{TRANSORI} = shift;
    return;
};


sub get_pfm{
    my $self = shift;
    return \@{$self->{PFM}};
};


sub get_logo{
    my $self = shift;
    return \@{$self->{LOGO}};
};


=head3 get_transfac_logo

=head4 Parameters

=over 4

=item 1
none

=back

=head4 Returns

=over 4

=item 1 
Reference to a position frequency matrix for the current MotifObject

=back

=head4 Description

=over 4

=item 1
This function gets a position frequency matrix from the current motif object

=back

=cut


sub get_transfac_logo{
    my $self = shift;
    return \@{$self->{TRANSLOGO}};
};


=head3 get_transfac_ori

=head4 Parameters

=over 4

=item 1
none

=back

=head4 Returns

=over 4

=item 1 
Reference to a position frequency matrix for the current MotifObject

=back

=head4 Description

=over 4

=item 1
This function gets a position frequency matrix from the current motif object

=back

=cut


sub get_transfac_ori{
    my $self = shift;
    return $self->{TRANSORI};
};

=head3 get_pfm

=head4 Parameters

=over 4

=item 1
File name

=item 2
Group specificity score

=item 3
Positional bias score

=item 4
Most biased position

=item 5
Consensus sequence

=back

=head4 Returns

=over 4

=item 1 
Nothing

=back

=head4 Description

=over 4

=item 1
This function loads the information from MotifStats into the current motif

=back

=cut

#This function loads the information from MotifStats into the current motif
sub put_stats {
    my $self = shift;
    $self->{FILE} = shift;
    $self->{GROUP} = shift;
    $self->{POSITIONAL} = shift;
    $self->{POSITION} = shift;
    $self->{CONSENSUS} = shift;
    return;
};

=head3 list_stats

=head4 Parameters

=over 4

=item 1
Motif number

=back

=head4 Returns

=over 4

=item 1 
String containing statistics for the current MotifObject

=back

=head4 Description

=over 4

=item 1
This function lists the statistics for the current MotifObject in the MotifStats style

=back

=cut

#This function list the motif information in MotifStats format
sub list_stats{
    my $self = shift;
    my $motif = shift;
    my $list = join ("\t",$self->{FILE},
                     $motif,
                     $self->{MOTIFSCORE},
                     $self->{GROUP},
                     $self->{POSITIONAL},
                     $self->{POSITION},
                     $self->{CONSENSUS}
                    );
    return $list;
};

=head3 list_consensus

=head4 Parameters

=over 4

=item 1
None

=back

=head4 Returns

=over 4

=item 1 
Consensus sequence from the current MotifObject

=back

=head4 Description

=over 4

=item 1
This function returns the consensus sequence from the current motif

=back

=cut

sub list_consensus {
    my $self = shift;
    return $self->{CONSENSUS};
};

sub put_consensus {
    my $self = shift;
    $self->{CONSENSUS} = shift;
    return;
};

=head3 list_stats_full

=head4 Parameters

=over 4

=item 1
Motif number

=back

=head4 Returns

=over 4

=item 1 
String containing statistics for the current MotifObject

=back

=head4 Description

=over 4

=item 1
This function lists the extended statistics for the current MotifObject

=back

=cut

sub list_stats_full{
    my $self = shift;
    my $motif = shift;
    my $list = join ("\t",$self->{FILE},
                     $motif,
                     $self->{MOTIFSCORE},
                     $self->get_group(),
                     $self->{POSITIONAL},
                     $self->{POSITION},
		     $self->get_site(),
		     $self->get_bits(),
		     $self->get_support(),
		     $self->get_ratio(),
                     $self->{CONSENSUS}
                    );
    return $list;
};

=head3 set_program

=head4 Parameters

=over 4

=item 1
Program name

=back

=head4 Returns

=over 4

=item 1 
Nothing

=back

=head4 Description

=over 4

=item 1
This function sets the name of the program used to find the current MotifObject

=back

=cut

#Sets the name of the motif finder used to find the current motif
sub set_program {
    my $self = shift;
    $self->{PROGRAM} = shift;
    return;
};

=head3 set_motif_number

=head4 Parameters

=over 4

=item 1
Motif number

=back

=head4 Returns

=over 4

=item 1 
Nothing

=back

=head4 Description

=over 4

=item 1
This function sets the motif number for the current MotifObject

=back

=cut

#Assigns the order of the motifs
sub set_motif_number {
    my $self = shift;
    $self->{MOTIFNUMBER} = shift;
    return;
};

=head3 put_origin

=head4 Parameters

=over 4

=item 1
Motif finding program

=item 2
Motif number

=back

=head4 Returns

=over 4

=item 1 
Nothing

=back

=head4 Description

=over 4

=item 1
This function sets both the motif finding program and the motif number for the current MotifObject

=back

=cut

#Assign values to both program and motifnumber
sub put_origin {
    my $self = shift;
    $self->{PROGRAM} = shift;
    $self->{MOTIFNUMBER} = shift;
    return;
};

=head3 get_motif_number

=head4 Parameters

=over 4

=item 1
none

=back

=head4 Returns

=over 4

=item 1 
Motif number for the current MotifObject

=back

=head4 Description

=over 4

=item 1
This function returns the motif number for the current MotifObject

=back

=cut

#Gets the value of motif number
sub get_motif_number {
    my $self = shift;
    return $self->{MOTIFNUMBER};
};

=head3 set_aster

=head4 Parameters

=over 4

=item 1
none

=back

=head4 Returns

=over 4

=item 1 
Nothing

=back

=head4 Description

=over 4

=item 1
This function creats a string of asterix the same length as the width of the motif

=item 2
The width of the motif is the actual length of an individual element and not based on active positions

=back

=cut

#Builds a sequence the width of the motif filled with asterix
sub set_aster {
    my $self = shift;
    if (defined($self->{ELEMENTS}[0]->{SEQUENCE})){$self->{ASTERIX} = '*' x length($self->{ELEMENTS}[0]->{SEQUENCE})};
    return;
};


=head3 set_actaster

=head4 Parameters

=over 4

=item 1
none

=back

=head4 Returns

=over 4

=item 1 
Nothing

=back

=head4 Description

=over 4

=item 1
This function creats a string of asterix and spaces

=item 2
Each position in the string that contains more than 0.5 bits of information is assigned an asterix

=back

=cut

#Bulids the information matrix that is used to generate the logo
#Builds a sequence containing asterix at each position with greater than 0.5 bits of information
#Calculates the best orientation of the logo and assigns a bit score
sub set_actaster {
    my $self = shift;
    my @holder = ();
    my $motiflength = length($self->{ELEMENTS}[0]->{SEQUENCE}) - 1;
    my $motifs = $#{$self->{ELEMENTS}} + 1;
    $self->{ERROR} = 3 / (2 * log(2) * $motifs);
    for my $j (0 .. $motiflength){
        $holder[$j][0] = {score => 0, base => 'A', uncertainty => 0, info => 0};
        $holder[$j][1] = {score => 0, base => 'T', uncertainty => 0, info => 0};
        $holder[$j][2] = {score => 0, base => 'G', uncertainty => 0, info => 0};
        $holder[$j][3] = {score => 0, base => 'C', uncertainty => 0, info => 0};
    };
    for my $i (0 .. $#{$self->{ELEMENTS}}){
        for my $j (0 .. $motiflength){
            my $base = substr($self->{ELEMENTS}[$i]->{SEQUENCE}, $j, 1);
            my $index = undef;
            if ($base =~ /A/){$index = 0};
            if ($base =~ /T/){$index = 1};
            if ($base =~ /G/){$index = 2};
            if ($base =~ /C/){$index = 3};
            $holder[$j][$index]->{score} = $holder[$j][$index]->{score} + (1/$motifs);
            $holder[$j][$index]->{base} = $base;
        };
    };
    for my $j (0 .. $motiflength){
        for my $i (0 .. 3){
            if ($holder[$j][$i]->{score} < 1 and $holder[$j][$i]->{score} > 0){
                $holder[$j][$i]->{uncertainty} = -($holder[$j][$i]->{score} * ((log($holder[$j][$i]->{score}))/log(2)));
            }
            else {$holder[$j][$i]->{uncertainty} = 0};
        };
    };
    my $total_bits = 0;
    $self->{ACTASTER} = '*' x ($motiflength + 1);
    for my $j (0 .. $motiflength){
        my $total_info = 2 - $holder[$j][0]->{uncertainty} -
        $holder[$j][1]->{uncertainty} -
        $holder[$j][2]->{uncertainty} -
        $holder[$j][3]->{uncertainty} - $self->{ERROR};
        for my $i (0 .. 3){
            $holder[$j][$i]->{info} = $holder[$j][$i]->{score} * $total_info;
        };
        if ($total_info < 0.5){substr($self->{ACTASTER},$j , 1, ' ')}
        $total_bits += $total_info;
    };
    for my $j (0 .. $motiflength){
        @{$holder[$j]} = sort {$a->{score} <=> $b->{score}} @{$holder[$j]};
    };
    my $ori = 0;
    for my $j (0 .. $motiflength){
        for my $i (0 .. 3){
            if ($holder[$j][$i]->{base} =~ /G/){
                $ori += (1.5 * $holder[$j][$i]->{info});
            };
            if ($holder[$j][$i]->{base} =~ /A/){
                $ori += $holder[$j][$i]->{info};
            };
            if ($holder[$j][$i]->{base} =~ /T/){
                $ori -= $holder[$j][$i]->{info};
            };
            if ($holder[$j][$i]->{base} =~ /C/){
                $ori -= (1.5 * $holder[$j][$i]->{info});
            };
        };
    };
    if ($ori >= 0){$self->{ORIENTATION} = 1}
    else{$self->{ORIENTATION} = 0};
    $self->{LOGO} = \@holder;
    $self->{BITS} = $total_bits;
    return;
};

=head3 get_aster

=head4 Parameters

=over 4

=item 1
none

=back

=head4 Returns

=over 4

=item 1 
A string of asterix

=back

=head4 Description

=over 4

=item 1
This function returns a string of asterix the same length as the width of the motif

=back

=cut

#Get a string of asterix the length of the motif
sub get_aster {
    my $self = shift;
    return $self->{ASTERIX};
};

=head3 get_actaster

=head4 Parameters

=over 4

=item 1
none

=back

=head4 Returns

=over 4

=item 1 
A string of asterix

=back

=head4 Description

=over 4

=item 1
This function returns a string of asterix and spaces the same length as the width of the motif

=item 2
Positions in the string with an asterix contain 0.5 bits or more information

=item 3
Positions with asterix are treated as active search positions by AlignACE support programs

=back

=cut

#Gets the string of asterix corresponding to the positions containing more than 0.5 bits of information
sub get_actaster {
    my $self = shift;
    return $self->{ACTASTER};
};

=head3 get_program

=head4 Parameters

=over 4

=item 1
none

=back

=head4 Returns

=over 4

=item 1 
Name of the program used to generate the MotifObject

=back

=head4 Description

=over 4

=item 1
This function returns the name of the program used to generate the motif

=back

=cut

#Gets the name of the program used to generate the motif
sub get_program {
    my $self = shift;
    return $self->{PROGRAM};
};

=head3 get_motifscore

=head4 Parameters

=over 4

=item 1
none

=back

=head4 Returns

=over 4

=item 1 
Score generated by the motif finder used to find the current MotifObject

=back

=head4 Description

=over 4

=item 1
This function returns the motif score for the current MotifObject

=back

=cut

#Gets the motif score from the motif finder
sub get_motifscore {
    my $self = shift;
    if (defined $self->{CLUSTER}){
        return $self->{MOTIFSCORE};
    }
    else {return 0};
};

sub set_motifscore {
    my $self = shift;
    $self->{MOTIFSCORE} = shift;
    return;
};

=head3 get_group

=head4 Parameters

=over 4

=item 1
none

=back

=head4 Returns

=over 4

=item 1 
Group specificity score

=back

=head4 Description

=over 4

=item 1
This function returns the group specificity score for the current MotifObject

=back

=cut

#Gets group specificty from MotofStats
sub get_group {
    my $self = shift;
    return $self->{SCANSTATS}->get_group();
};

sub set_group {
    my $self = shift;
    $self->{GROUP} = shift;
    $self->{SCANSTATS}->set_group($self->{GROUP});
    return;
};

=head3 get_info

=head4 Parameters

=over 4

=item 1
none

=back

=head4 Returns

=over 4

=item 1 
Program name

=item 2 
Motif number

=back

=head4 Description

=over 4

=item 1
This function returns information about the current MotifObject including the program name and motif number

=back

=cut

#Get some information about the current motif
sub get_info {
    my $self = shift;
    return ($self->{PROGRAM}, $self->{MOTIFNUMBER});
};

=head3 get_id

=head4 Parameters

=over 4

=item 1
none

=back

=head4 Returns

=over 4

=item 1 
The transfac id

=back

=head4 Description

=over 4

=item 1
This function returns transfac id for the current MotifObject

=back

=cut

#Get the current transfac name assignment
sub get_id {
    my $self = shift;
    my $motif = shift;
    if (exists $self->{TRANSFAC}[$motif]->{ID}){
        return $self->{TRANSFAC}[$motif]->{ID};
    }
    else {return ''};
};

=head3 list_motif

=head4 Parameters

=over 4

=item 1
none

=back

=head4 Returns

=over 4

=item 1 
Nothing

=back

=head4 Description

=over 4

=item 1
This function prints out all of the sequence elements that make up a motif

=back

=cut

#This function just outputs the sequences that make up the motif
sub list_motif {
    my $self = shift;
    for my $n (0 .. $#{$self->{ELEMENTS}}){
        print "$self->{ELEMENTS}[$n]->{SEQUENCE}\n";
    };
    return;
};

=head3 list_record

=head4 Parameters

=over 4

=item 1
Reference to a structure containing the names of all the genes from a motif search

=back

=head4 Returns

=over 4

=item 1 
Returns all the elements from a MotifObject

=back

=head4 Description

=over 4

=item 1
This function returns all the elements of a MotifObject in the AlignACE format

=back

=cut

#lists the current motif in alignace format
sub list_record {
    my $self = shift;
    my $arg = shift;
    my %refs = %{$arg};
    my @rows = ();
    for my $n (0 .. $#{$self->{ELEMENTS}}){
        my $list = join ("\t",$self->{ELEMENTS}[$n]->{SEQUENCE},
        $refs{$self->{ELEMENTS}[$n]->{GENE}}->{pos},
        $self->{ELEMENTS}[$n]->{POSITION},
        $self->{ELEMENTS}[$n]->{STRAND});
        push @rows, $list;
    };
    return join("\n", @rows);
};

=head3 get_gene_element

=head4 Parameters

=over 4

=item 1
Number of a MotifObject element

=back

=head4 Returns

=over 4

=item 1 
Returns the gene where the element was found

=back

=head4 Description

=over 4

=item 1
This function returns the gene where an element of MotifObject was found

=back

=cut

sub get_gene_element{
    my $self  = shift;
    my $element = shift;
    return $self->{ELEMENTS}[$element]->{GENE};
};

=head3 list_genes

=head4 Parameters

=over 4

=item 1
Reference to a hash that will be filled with gene names

=back

=head4 Returns

=over 4

=item 1 
Nothing

=back

=head4 Description

=over 4

=item 1
This function adds gene names into a hash

=item 2
This eliminates duplicate gene names

=back

=cut

#May not need this function?
sub list_genes {
    my $self = shift;
    my $hashref = shift;
    for my $n (0 .. $#{$self->{ELEMENTS}}){
        if ($self->{ELEMENTS}[$n]->{GENE} =~ /\S+/){
            ${$hashref}{$self->{ELEMENTS}[$n]->{GENE}} = { id => 1};
        };
    };
    return;
};

=head3 set_genes

=head4 Parameters

=over 4

=item 1
none

=back

=head4 Returns

=over 4

=item 1 
Nothing

=back

=head4 Description

=over 4

=item 1
This function reads through all of the non-duplicate genes in a MotifObject and assigns them to the GENES array

=back

=cut

#This function takes all of the genes in a motif, removes duplicates and
#returns an array of gene names
#find a better less implicit way of doing this
sub set_genes {
    my $self = shift;
    my %hashref = ();
    for my $n (0 .. $#{$self->{ELEMENTS}}){
        if ($self->{ELEMENTS}[$n]->{GENE} =~ /\S+/){
            $hashref{$self->{ELEMENTS}[$n]->{GENE}}++;
        };
    };
    my @genes = keys %hashref;
    $self->{GENES} = \@genes;
    return;
};

=head3 get_info_array

=head4 Parameters

=over 4

=item 1
none

=back

=head4 Returns

=over 4

=item 1 
The information array for the current MotifObject

=back

=head4 Description

=over 4

=item 1
This function is an accessor function to the information array for the current MotifObject

=item 2
This information can be used to build a motif logo

=back

=cut

#one line from this command can be removed
#This is an accessor function for the information array that was generated by MotifObject
sub get_info_array {
    my $self = shift;
    my @ref = @{$self->{LOGO}};
    return @ref;
};

sub get_transfac_info_array {
    my $self = shift;
    my $hit = shift;
    if (defined $self->{TRANSLOGO}[$hit]){
    my @ref = @{$self->{TRANSLOGO}[$hit]};
    return @ref;
    }
    else {return 0};
};

=head3 get_orientation

=head4 Parameters

=over 4

=item 1
none

=back

=head4 Returns

=over 4

=item 1 
Orientation of the current MotifObject (+/-)

=back

=head4 Description

=over 4

=item 1
This function is an accessor function for the motif orientation

=back

=cut

#sets the orientation of the motif
sub get_orientation {
    my $self = shift;
    return $self->{ORIENTATION};
};

=head3 pfm_to_motif

=head4 Parameters

=over 4

=item 1
The MotifObject identification from transfac

=back

=head4 Returns

=over 4

=item 1 
Nothing

=back

=head4 Description

=over 4

=item 1
This function generates a transfac MotifObject from position frequency matricies

=back

=cut

sub pfm_to_motif
{
    my $self = shift;
    my $id = shift;
    my @matrix = @{$self->{PFM}};
    my ($site_length, $total) = undef;
    my (@arrayA, @arrayC, @arrayG, @arrayT) = undef;
    SIZE: for my $num_sites (10 .. 200)
    {
        (@arrayA, @arrayC, @arrayG, @arrayT) = ();
        #print"$num_sites\n";
        for my $i (0 .. $#matrix)
        {
            push (@arrayA, $matrix[$i]->{A});
            push (@arrayC, $matrix[$i]->{C});
            push (@arrayG, $matrix[$i]->{G});
            push (@arrayT, $matrix[$i]->{T});
        };
        
        $site_length = @arrayA;
        my ($tempA, $tempC, $tempG, $tempT) = undef;
        my ($tempA1, $tempC1, $tempG1, $tempT1) = undef;
        my ($scale, $matdiff, $testdif) = undef;
        
        SCALE: for (my $i=0; $i < $site_length; $i++) {
            $total = $arrayA[$i] + $arrayC[$i] + $arrayG[$i] + $arrayT[$i];
            $scale = $num_sites / $total;
            $tempA = $scale * $arrayA[$i];
            $tempC = $scale * $arrayC[$i];
            $tempG = $scale * $arrayG[$i];
            $tempT = $scale * $arrayT[$i];
	
            $tempA1 = $tempA; $tempC1 = $tempC; $tempG1 = $tempG; $tempT1 = $tempT;
	
            $arrayA[$i] = sprintf("%.0f", $tempA);
            $arrayC[$i] = sprintf("%.0f", $tempC);
            $arrayG[$i] = sprintf("%.0f", $tempG);
            $arrayT[$i] = sprintf("%.0f", $tempT);

            $total = $arrayA[$i] + $arrayC[$i] + $arrayG[$i] + $arrayT[$i];
	
            while ($total > $num_sites) {
                $tempA = $tempA * .999; $tempC = $tempC * .999; $tempG = $tempG * .999; $tempT = $tempT * .999;
                $tempA1 = $tempA; $tempC1 = $tempC; $tempG1 = $tempG; $tempT1 = $tempT;
                $arrayA[$i] = sprintf("%.0f", $tempA);
                $arrayC[$i] = sprintf("%.0f", $tempC);
                $arrayG[$i] = sprintf("%.0f", $tempG);
                $arrayT[$i] = sprintf("%.0f", $tempT);
                $total = $arrayA[$i] + $arrayC[$i] + $arrayG[$i] + $arrayT[$i];
            };
	
            while ($total < $num_sites) {
                $tempA = $tempA * 1.001; $tempC = $tempC * 1.001; $tempG = $tempG * 1.001; $tempT = $tempT * 1.001;
		$tempA1 = $tempA; $tempC1 = $tempC; $tempG1 = $tempG; $tempT1 = $tempT;
                $arrayA[$i] = sprintf("%.0f", $tempA);
                $arrayC[$i] = sprintf("%.0f", $tempC);
                $arrayG[$i] = sprintf("%.0f", $tempG);
                $arrayT[$i] = sprintf("%.0f", $tempT);
                $total = $arrayA[$i] + $arrayC[$i] + $arrayG[$i] + $arrayT[$i];
            };
            $matdiff = abs($arrayA[$i]-$tempA1) + abs($arrayC[$i]-$tempC1) + abs($arrayG[$i]-$tempG1) + abs($arrayT[$i]-$tempT1);
            $testdif += $matdiff/$num_sites;
            #print $matdiff/$num_sites."\t".$testdif."\n";
            #if ($total != $num_sites) {next SIZE};
        };
        if ($testdif > 0.1) {next SIZE};
        if ($total != $num_sites) {next SIZE};
        if ($total == $num_sites) {last SIZE};
    };

    my @motif_array = ();
    for (my $i=0; $i < $site_length; $i++) {
        my @curr_array = ();
        for (my $j=0; $j < $arrayA[$i]; $j++) { push (@curr_array, "A") };
        for (my $j=0; $j < $arrayC[$i]; $j++) { push (@curr_array, "C") };
        for (my $j=0; $j < $arrayG[$i]; $j++) { push (@curr_array, "G") };
        for (my $j=0; $j < $arrayT[$i]; $j++) { push (@curr_array, "T") };
        for (my $x = $#curr_array; $x > 0; --$x ) {
            my $j = int rand ($x+1);
            next if $x == $j;
            @curr_array[$x,$j] = @curr_array[$j,$x];
        }
        push (@motif_array, \@curr_array);
    }
    
    my @motif = ();
    my $i = 0; my $j = 0;
    for ($i=0; $i < $total; $i++) {
        my $sequence = undef;
        for (my $j=0; $j < $site_length; $j++) {
            $sequence = join('', $sequence, ${$motif_array[$j]}[$i]);
        }
        $self->put_element($sequence, $id, '1', '1');
    }
    return;
};

sub set_blocks{
    my $self = shift;
    my $min_width = shift;
    my $min_info = shift;
    my $start = $#{$self->{LOGO}};
    my $end = 0;
    for my $x (0 .. $#{$self->{LOGO}}){
        if ($self->get_position_info($x) > $min_info){
            if ($x < $start){$start = $x};
            $end = $x;
        }
        else {
            if ($end - $start + 1 >= $min_width){
                my $element = {START => $start, END => $end};
                push @{$self->{BLOCKS}}, $element;
            };
            $start = $#{$self->{LOGO}};
            $end = 0;
        };
        if ($x == $#{$self->{LOGO}}){
            if ($end - $start + 1 >= $min_width){
                my $element = {START => $start, END => $end};
                push @{$self->{BLOCKS}}, $element;
            };
        };
    };
};

sub check_blocks{
    my $self = shift;
    my $ungapped_width = shift;
    my $gapped_width = shift;
    my $ungapped = 0;
    my $gapped = 0;
    if (exists $self->{BLOCKS}[0]->{START} and exists $self->{BLOCKS}[0]->{END}){
        for my $block (0 .. $#{$self->{BLOCKS}}){
            if ($self->{BLOCKS}[$block]->{END} - $self->{BLOCKS}[$block]->{START} + 1 >= $ungapped_width){$ungapped++};
            if ($self->{BLOCKS}[$block]->{END} - $self->{BLOCKS}[$block]->{START} + 1 >= $gapped_width){$gapped++};
        }
        my %element = (BLOCKS => $#{$self->{BLOCKS}},
                        GAPPED => $gapped,
                        UNGAPPED => $ungapped,
                        );
        if ($gapped >= 2){$self->put_descriptor('GAPPED', \%element); return};
        if ($ungapped >= 1){$self->put_descriptor('UNGAPPED', \%element); return};
        $self->put_descriptor('FAIL', \%element);
        return;
    }
    else{
        my %element = (BLOCKS => $#{$self->{BLOCKS}},
                        GAPPED => $gapped,
                        UNGAPPED => $ungapped,
                        );
        $self->put_descriptor('FAIL', \%element);
        return;
    };
};

sub block_fail{
    my $self = shift;
    my $descriptors = $self->get_descriptor();
    my @type = keys %{$descriptors};
    for my $i (0 .. $#type){
        if ($type[$i] =~ /FAIL/){return 0};
    };
    return 1;
};

sub get_blocks{
    my $self = shift;
    if (exists $self->{BLOCKS}[0]->{START} and exists $self->{BLOCKS}[0]->{END}){
        return \@{$self->{BLOCKS}}
    }
    else{return 0};

};

sub get_position_info{
    my $self = shift;
    my $pos = shift;
    my $total = 0;
    for my $i (0 .. 3){
        $total += $self->{LOGO}[$pos][$i]->{info};
    };
    return $total;
};

sub calculate_pfm{
    my $self = shift;
    my @matrix = ();
    for my $i (0 .. $#{$self->{LOGO}}){
        my %element = ();
        my $info = 0;
        for my $j (0 .. 3){
            $element{$self->{LOGO}[$i][$j]->{base}} = $self->{LOGO}[$i][$j]->{score};
            $info += $self->{LOGO}[$i][$j]->{info};
        };
        $element{INFO} = $info;
        push @matrix, \%element;
    };
    $self->{PFM} = \@matrix
};

sub get_pfm_length{
    my $self = shift;
    return $#{$self->{PFM}};
};

sub get_pfm_fragment{
    my $self = shift;
    my $start = shift;
    my $end = shift;
    my @pfm = ();
    for my $i ($start .. $end){
        my $element = $self->{PFM}[$i];
        push @pfm, $element;
    }
    return \@pfm;
};

sub put_descriptor {
    my $self = shift;
    my $descriptor = shift;
    my $parameters = shift;
    push @{$self->{DESCRIPTION}{$descriptor}}, $parameters;
};

sub get_descriptor {
    my $self = shift;
    return $self->{DESCRIPTION};
};

sub fragment_check{
    my $self = shift;
    my $width = shift;
    my $count = 0;
    while ($self->{ACTASTER} =~ m/\*/g){$count++};
    if ($count >= $width){return 1}
    else{return 0};
};

sub get_set {
    my $self = shift;
    return $self->{SET};
};

sub put_set  {
    my $self = shift;
    my $set = shift;
    $self->{SET} = $set;
    return;
};

sub set_sets {
    my $self = shift;
    my $set = shift;
    $self->{SETS} = $set;
    return;
}

sub get_sets {
    my $self = shift;
    return $self->{SETS};
}
    
1
