| Previous changeset 1:764d562755bd (2018-03-21) Next changeset 3:856008c4a5f3 (2018-10-05) |
|
Commit message:
Add Perl scripts missing from previous upload. |
|
added:
CountUniqueIDs.pl Scan_IUPAC_output_each_match.pl Scan_IUPAC_output_matches_per_seq.pl TFBScluster_candidates.pl |
| b |
| diff -r 764d562755bd -r 2f48cf393d25 CountUniqueIDs.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/CountUniqueIDs.pl Mon Apr 09 04:56:28 2018 -0400 |
| [ |
| @@ -0,0 +1,42 @@ +#! /usr/bin/perl -w + +use strict; + +#### Read thru a GFF file of motifs return the number of unique ids +#### Ian Donaldson Sept 2008 + +#### Usage +unless(@ARGV == 2) { + die("USAGE: $0 | GFF file | Output file\n\n"); +} + +#### Ready output file +open(GFF, "<$ARGV[0]") or die("Could not open GFF file!!\n\n"); +open(OUTPUT, ">$ARGV[1]") or die("Could not open output file!!\n\n"); + +#### Hash to hold ids +my %id_hash = (); + +#### Work thru GFF file +while(defined(my $gff_line = <GFF>)) { + if($gff_line =~ /(^#|^\s)/) { next } + + my @gff_line_bits = split(/\t/, $gff_line); + + my $id = $gff_line_bits[0]; + + $id_hash{$id}=1; +} + +my @all_keys = sort(keys(%id_hash)); + +my $elements = scalar(@all_keys); + +#print OUTPUT "There are $elements unique sequences in the file\n"; +print OUTPUT "$elements non-redundant sequences\n"; + +#### Close files +close(GFF); +close(OUTPUT); + +exit; |
| b |
| diff -r 764d562755bd -r 2f48cf393d25 Scan_IUPAC_output_each_match.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Scan_IUPAC_output_each_match.pl Mon Apr 09 04:56:28 2018 -0400 |
| [ |
| @@ -0,0 +1,210 @@ +#! /usr/bin/perl + +use strict; +use FileHandle; +use Bio::SeqIO; +#use Statistics::Descriptive; + +##### +# Program to count all occurences of a particular REGEX +# in a file containing mutiple FASTA sequences. +# 11 September 2003. Ian Donaldson. +# Revised to convert IUPAC to regex +# Revised to read a multiple FASTA file +# was CountRegexGFF_IUPAC_1input_nosummary.pl +##### + +#### File handles +my $input = new FileHandle; +my $output = new FileHandle; + +#### Variables +my $file_number = 0; +my $count_fwd_regex = 0; +my $count_rvs_regex = 0; +my $count_all_regex = 0; +my $seq_tally = 0; +my @seq_totals = (); + +#### Command line usage +if(@ARGV != 5) { + die ("USAGE: + $0 + IUPAC + Multiple FASTA input file + Output + Label + Skip palindromic (0=F+R-default|1=F only)\n\n"); +} + +#### Search forward strand only? +my $skip = $ARGV[4]; +unless($skip =~ /^[01]$/) { + die("Only accept 0 or 1 for Skip!\n"); +} + +#### Process IUPAC string +my $iupac = $ARGV[0]; +chomp $iupac; +$iupac = uc($iupac); + +if($iupac !~ /^[ACGTRYMKWSBDHVN]+$/) { + die("A non-IUPAC character was detected in your input string!\n"); +} + +#### Forward strand IUPAC +my @fwd_iupac_letters = split(//, $iupac); +my @fwd_regex_list = (); + +foreach my $letter (@fwd_iupac_letters) { + my $converted_iupac = iupac2regex($letter); + push(@fwd_regex_list, $converted_iupac); +} + +my $fwd_regex = join('', @fwd_regex_list); + + +#### Reverse strand IUPAC +my $revcomp_iupac = RevCompIUPAC($iupac); +my @rev_iupac_letters = split(//, $revcomp_iupac); +my @rev_regex_list = (); + +foreach my $letter (@rev_iupac_letters) { + my $converted_iupac = iupac2regex($letter); + push(@rev_regex_list, $converted_iupac); +} + +my $rvs_regex = join('', @rev_regex_list); + +#### Other variables +my $label = $ARGV[3]; + +if($label !~ /^[\w\d]+$/) { + die("A non-letter/number character was detected in your label string!\n"); +} + +my $length = length($iupac); + +#### Open output file +$output->open(">$ARGV[2]") or die "Could not open output file $ARGV[2]!\n"; +#$output->print("##gff-version 2\n"); + +#if($skip == 0) { +# $output->print("##Pattern search: $iupac and $revcomp_iupac\n"); +#} + +#else { +# $output->print("##Pattern search: $iupac\n"); +#} + +#### Work thru FASTA entries in the input file with SeqIO +my $seqio = Bio::SeqIO->new(-file => "$ARGV[1]" , '-format' => 'Fasta'); + +while( my $seqobj = $seqio->next_seq() ) { + $seq_tally++; + my $this_seq_tally = 0; + my $sequence = $seqobj->seq(); # actual sequence as a string + my $seq_id = $seqobj->id(); # header + #print(">$seq_id\n$seq\n\n"); + + #$output->print(">$seq_id\n"); + + #### Clean up $sequence to leave only nucleotides + $sequence =~ s/[\s\W\d]//g; + + while ($sequence =~ /($fwd_regex)/ig) { + $this_seq_tally++; + $count_fwd_regex++; + $count_all_regex++; + + my $end_position = pos($sequence); + my $start_position = $end_position - ($length - 1); + $output->print("$seq_id\tRegexSearch\tCNS\t$start_position\t$end_position\t.\t+\t.\t$label\n"); + } + + #### Count reverse REGEX + unless($skip == 1) { + while ($sequence =~ /($rvs_regex)/ig) { + $this_seq_tally++; + $count_rvs_regex++; + $count_all_regex++; + + my $end_position = pos($sequence); + my $start_position = $end_position - ($length - 1); + $output->print("$seq_id\tRegexSearch\tCNS\t$start_position\t$end_position\t.\t-\t.\t$label\n"); + } + + push(@seq_totals, $this_seq_tally); + #$output->print("$this_seq_tally matches\n"); + } +} + +#### Mean motifs per seq +#my $stat = Statistics::Descriptive::Full->new(); +#$stat->add_data(@seq_totals); +#my $mean = $stat->mean(); + + +#### Print a summary file +if($skip == 0) { +# $output->print("##Forward: $fwd_regex. Reverse: $rvs_regex.\n", +# "##$count_fwd_regex on the forward strand.\n", +# "##$count_rvs_regex on the reverse strand.\n", +# "##$count_all_regex in total.\n", +# "##$seq_tally sequences. Mean motifs per seq = $mean\n"); +# + print STDOUT "There were $count_all_regex instances of $fwd_regex and $rvs_regex.\n"; +} + +if($skip == 1) { +# $output->print("##Forward: $fwd_regex.\n", +# "##$count_fwd_regex on the forward strand.\n", +# "##$seq_tally sequences. Mean motifs per seq = $mean\n"); +# + print STDOUT "There were $count_fwd_regex instances of $fwd_regex on the forward strand.\n"; +} + +$output->close; + +exit; + +sub iupac2regex { +# Convert IUPAC codes to REGEX + my $iupac = shift; + + #### Series of regexes to convert + if($iupac =~ /A/) { return 'A' } + if($iupac =~ /C/) { return 'C' } + if($iupac =~ /G/) { return 'G' } + if($iupac =~ /T/) { return 'T' } + if($iupac =~ /M/) { return '[AC]' } + if($iupac =~ /R/) { return '[AG]' } + if($iupac =~ /W/) { return '[AT]' } + if($iupac =~ /S/) { return '[CG]' } + if($iupac =~ /Y/) { return '[CT]' } + if($iupac =~ /K/) { return '[GT]' } + if($iupac =~ /V/) { return '[ACG]' } + if($iupac =~ /H/) { return '[ACT]' } + if($iupac =~ /D/) { return '[AGT]' } + if($iupac =~ /B/) { return '[CGT]' } + if($iupac =~ /N/) { return '[ACGT]' } + + die("IUPAC not recognised by sub iupac2regex!\n"); +} + +sub RevCompIUPAC { + my $iupac_string = shift; + my @converted_list = (); + + my @iupac_string_list = split(//, $iupac_string); + + @iupac_string_list = reverse(@iupac_string_list); + + foreach my $letter (@iupac_string_list) { + $letter =~ tr/ACGTRYMKWSBDHVN/TGCAYRKMWSVHDBN/; + push(@converted_list, $letter); + } + + my $joined_list = join('', @converted_list); + return $joined_list; +} |
| b |
| diff -r 764d562755bd -r 2f48cf393d25 Scan_IUPAC_output_matches_per_seq.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Scan_IUPAC_output_matches_per_seq.pl Mon Apr 09 04:56:28 2018 -0400 |
| [ |
| @@ -0,0 +1,209 @@ +#! /usr/bin/perl + +use strict; +use FileHandle; +use Bio::SeqIO; +#use Statistics::Descriptive; + +##### +# Program to count all occurences of a particular REGEX +# in a file containing mutiple FASTA sequences. +# 11 September 2003. Ian Donaldson. +# Revised to convert IUPAC to regex +# Revised to read a multiple FASTA file +# was CountRegexGFF_IUPAC_1input_simple_output.pl +##### + +#### File handles +my $input = new FileHandle; +my $output = new FileHandle; + +#### Variables +my $file_number = 0; +my $count_fwd_regex = 0; +my $count_rvs_regex = 0; +my $count_all_regex = 0; +my $seq_tally = 0; +my @seq_totals = (); + +#### Command line usage +if(@ARGV != 4) { + die ("USAGE: + $0 + IUPAC + Multiple FASTA input file + Output + Skip palindromic (0=F+R-default|1=F only)\n\n"); +} + +#### Search forward strand only? +my $skip = $ARGV[3]; +unless($skip =~ /^[01]$/) { + die("Only accept 0 or 1 for Skip!\n"); +} + +#### Process IUPAC string +my $iupac = $ARGV[0]; +chomp $iupac; +$iupac = uc($iupac); + +if($iupac !~ /^[ACGTRYMKWSBDHVN]+$/) { + die("A non-IUPAC character was detected in your input string!\n"); +} + +#### Forward strand IUPAC +my @fwd_iupac_letters = split(//, $iupac); +my @fwd_regex_list = (); + +foreach my $letter (@fwd_iupac_letters) { + my $converted_iupac = iupac2regex($letter); + push(@fwd_regex_list, $converted_iupac); +} + +my $fwd_regex = join('', @fwd_regex_list); + + +#### Reverse strand IUPAC +my $revcomp_iupac = RevCompIUPAC($iupac); +my @rev_iupac_letters = split(//, $revcomp_iupac); +my @rev_regex_list = (); + +foreach my $letter (@rev_iupac_letters) { + my $converted_iupac = iupac2regex($letter); + push(@rev_regex_list, $converted_iupac); +} + +my $rvs_regex = join('', @rev_regex_list); + +#### Other variables +#my $label = $ARGV[3]; +# +#if($label !~ /^[\w\d]+$/) { +# die("A non-letter/number character was detected in your label string!\n"); +#} + +my $length = length($iupac); + +#### Open output file +$output->open(">$ARGV[2]") or die "Could not open output file $ARGV[2]!\n"; +#$output->print("##gff-version 2\n"); + +#if($skip == 0) { +# $output->print("##Pattern search: $iupac and $revcomp_iupac\n"); +#} + +#else { +# $output->print("##Pattern search: $iupac\n"); +#} + +#### Work thru FASTA entries in the input file with SeqIO +my $seqio = Bio::SeqIO->new(-file => "$ARGV[1]" , '-format' => 'Fasta'); + +while( my $seqobj = $seqio->next_seq() ) { + $seq_tally++; + my $this_seq_tally = 0; + my $sequence = $seqobj->seq(); # actual sequence as a string + my $seq_id = $seqobj->id(); # header + #print(">$seq_id\n$seq\n\n"); + + #$output->print(">$seq_id\n"); + + #### Clean up $sequence to leave only nucleotides + #$sequence =~ s/[\s\W\d]//g; + + while ($sequence =~ /($fwd_regex)/ig) { + $this_seq_tally++; + $count_fwd_regex++; + $count_all_regex++; + + #my $end_position = pos($sequence); + #my $start_position = $end_position - ($length - 1); + #$output->print("$seq_id\tRegexSearch\tCNS\t$start_position\t$end_position\t.\t+\t.\t$label\n"); + } + + #### Count reverse REGEX + unless($skip == 1) { + while ($sequence =~ /($rvs_regex)/ig) { + $this_seq_tally++; + $count_rvs_regex++; + $count_all_regex++; + + #my $end_position = pos($sequence); + #my $start_position = $end_position - ($length - 1); + #$output->print("$seq_id\tRegexSearch\tCNS\t$start_position\t$end_position\t.\t-\t.\t$label\n"); + } + } + + push(@seq_totals, $this_seq_tally); + $output->print("$seq_id\t$this_seq_tally\n"); +} + +#### Mean motifs per seq +#my $stat = Statistics::Descriptive::Full->new(); +#$stat->add_data(@seq_totals); +#my $mean = $stat->mean(); + + +#### Print a summary file +#if($skip == 0) { +# $output->print("##Forward: $fwd_regex. Reverse: $rvs_regex.\n", +# "##$count_fwd_regex on the forward strand.\n", +# "##$count_rvs_regex on the reverse strand.\n", +# "##$count_all_regex in total.\n", +# "##$seq_tally sequences. Mean motifs per seq = $mean\n"); +# +# print STDOUT "There were $count_all_regex instances of $fwd_regex and $rvs_regex.\n\n"; +#} + +#if($skip == 1) { +# $output->print("##Forward: $fwd_regex.\n", +# "##$count_fwd_regex on the forward strand.\n", +# "##$seq_tally sequences. Mean motifs per seq = $mean\n"); +# +# print STDOUT "There were $count_fwd_regex instances of $fwd_regex on the forward strand.\n\n"; +#} + +$output->close; + +exit; + +sub iupac2regex { +# Convert IUPAC codes to REGEX + my $iupac = shift; + + #### Series of regexes to convert + if($iupac =~ /A/) { return 'A' } + if($iupac =~ /C/) { return 'C' } + if($iupac =~ /G/) { return 'G' } + if($iupac =~ /T/) { return 'T' } + if($iupac =~ /M/) { return '[AC]' } + if($iupac =~ /R/) { return '[AG]' } + if($iupac =~ /W/) { return '[AT]' } + if($iupac =~ /S/) { return '[CG]' } + if($iupac =~ /Y/) { return '[CT]' } + if($iupac =~ /K/) { return '[GT]' } + if($iupac =~ /V/) { return '[ACG]' } + if($iupac =~ /H/) { return '[ACT]' } + if($iupac =~ /D/) { return '[AGT]' } + if($iupac =~ /B/) { return '[CGT]' } + if($iupac =~ /N/) { return '[ACGT]' } + + die("IUPAC not recognised by sub iupac2regex!\n"); +} + +sub RevCompIUPAC { + my $iupac_string = shift; + my @converted_list = (); + + my @iupac_string_list = split(//, $iupac_string); + + @iupac_string_list = reverse(@iupac_string_list); + + foreach my $letter (@iupac_string_list) { + $letter =~ tr/ACGTRYMKWSBDHVN/TGCAYRKMWSVHDBN/; + push(@converted_list, $letter); + } + + my $joined_list = join('', @converted_list); + return $joined_list; +} |
| b |
| diff -r 764d562755bd -r 2f48cf393d25 TFBScluster_candidates.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/TFBScluster_candidates.pl Mon Apr 09 04:56:28 2018 -0400 |
| [ |
| b'@@ -0,0 +1,964 @@\n+#!/usr/bin/perl\n+\n+# TFBScluster version 2.0 - cluster together TFBSs from distinct \n+# TFBSsearch generated libraries.\n+#\n+# (c) Ian Donaldson 2003 and Mike Chapman (TFBS overlap subs)\n+#\n+# This program is free software; you can redistribute it and/or\n+# modify it under the terms of the GNU General Public License\n+# as published by the Free Software Foundation; either version 2\n+# of the License, or (at your option) any later version.\n+#\n+# This program is distributed in the hope that it will be useful,\n+# but WITHOUT ANY WARRANTY; without even the implied warranty of\n+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n+# GNU General Public License for more details.\n+#\n+# You should have received a copy of the GNU General Public License\n+# along with this program; if not, write to the Free Software\n+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.\n+\n+use strict;\n+use FileHandle;\n+#use integer; # Force floating point into integers\n+\n+$|=1;\n+\n+###########\n+# Program to determine whether a TF site is in close proximity to\n+# one or more other TF sites.\n+# September 2003. Ian Donaldson.\n+# Revised 8 Sept. 2003 to not include the query TF site in the threshold.\n+# This is to allow one to determine whether a TF is near to another of the \n+# same type.\n+# Revised 9 Sept to alter the threshold size to only include the core of a \n+# pattern i.e. gata of nngatann.\n+# Revised 19 Sept to replace query and subject libraries with the statement\n+# of all interested libraries.\n+# Revised 22 Sept to scan output for overlapping patterns.\n+# NOTE: Any overlap in comparative record start with start pattern\n+# Revised 30 Sept to ignore duplication of TFBS in a group record caused by \n+# palindrome. By skipping if name and positions the same.\n+# Revised 6 Oct code for tree searching method to deal with overlapping TFBSs\n+###########\n+\n+#### Command line usage\n+if(@ARGV != 7)\n+{\n+ die ("USAGE: \n+ $0\n+ TF libraries \\(comma delimited NO SPACES\\) \n+ Number of flanking \'N\'s for subject files \\(comma delimited NO SPACES\\) \n+ Minimum number of occurences \\(comma delimited NO SPACES\\)\n+ TF IDs \\(comma delimited NO SPACES\\)\n+ Single range value in bp \\(+/-\\) query start and end values\n+ Include overlapping TFBSs \\(include/exclude\\)\n+ Output file\\n\\n"); \n+}\n+\n+#### File handles\n+my $subject = new FileHandle;\n+my $combined = new FileHandle;\n+my $sorted = new FileHandle;\n+my $groups = new FileHandle;\n+my $filtered_groups = new FileHandle;\n+my $output = new FileHandle;\n+my $output2 = new FileHandle;\n+\n+#### Variables\n+my @subject_files = (); # Array containing the names of selected subject files\n+my @flanking_n = (); # Array containing the number of flanking \'n\' for each pattern\n+my @min_occur = (); # Array containing the minimum occurences for the TF library\n+my @ids = (); # Array containing user defined IDs for the TF libraries\n+my @file_sizes = ();\n+my @sorted_file_sizes = ();\n+my $range = $ARGV[4];\n+my $allow = $ARGV[5];\n+my @regex_ids = ();\n+\n+#####################################################\n+#### Deal with user arguments processed into an array\n+#####################################################\n+\n+#### Convert TF file names string to an array\n+@subject_files = split(/,/, $ARGV[0]);\n+\n+#### Convert flanking \'N\' numbers string into an array\n+@flanking_n = split(/,/, $ARGV[1]);\n+\n+#### Convert minimum occurences string into an array\n+@min_occur = split(/,/, $ARGV[2]);\n+\n+#### Convert minimum occurences string into an array\n+@ids = split(/,/, $ARGV[3]);\n+\n+foreach my $id_string (@ids) {\n+ if($id_string !~ /^[\\w\\d_,]+$/) {\n+ die("A non-letter/number character was detected in your label string!\\n");\n+ }\n+}\n+\n+#### Record how large they are\n+for(my $i=0; $i < $#subject_files + 1; $i++) {\n+ my $size = (-s $subject_files[$i]); # -s performed on an unopened file!\n+\n+ push(@file_si'..b'ord = <$fh>;\n+\n+ $/ = $saveinputsep;\n+ return $record;\n+}\n+\n+sub tf_cluster_tree {\n+\n+my @path;\n+my $node_count;\n+my $node = 0;\n+my $success = 0;\n+my $choice = -1;\n+my @node_contains;\n+my @node_to_choice;\n+my @count;\n+my @branches;\n+$branches[0] = -1;\n+my $path_ref;\n+my $branch_ref;\n+my $node_contains;\n+my $node_to_choice;\n+my ($choice_ref,\n+\t$required_ref,\n+\t$tf_ref) = @_;\n+my @choices = @$choice_ref;\n+my @required = @$required_ref;\n+my @tfs = @$tf_ref;\n+($node,\n+ $choice,\n+ $node_count,\n+ $choice_ref,\n+ $path_ref,\n+ $branch_ref,\n+ $node_to_choice,\n+ $node_contains) = next_node ($node,\n+\t\t\t $choice,\n+\t\t\t $node_count,\n+\t\t\t $choice_ref,\n+\t\t\t \\@path,\n+\t\t\t \\@branches,\n+\t\t\t $tf_ref);\n+@choices = @$choice_ref;\n+@path = @$path_ref;\n+@branches = @$branch_ref;\n+$node_contains[$node] = $node_contains;\n+$node_to_choice[$node] = $node_to_choice;\n+\n+BLOCK_A:\n+\n+while (1) {\n+no strict "vars";\n+\n+\tif ( node_terminating($choice, $choice_ref) ) {\n+\t\tpush @path, $node;\n+\t\t@count = undef;\n+\t\tgrep { $count[ $node_contains[$_] ]++ } @path;\n+\t\t#print "Count is @count.\\n";\n+\t\tmy $score = grep { $count[$_] >= $required[$_] }\n+\t\t\t(0 .. $#count);\n+\t\t#print "Path is @path\\n";\n+\t\tif ($score == scalar @required) {\n+\t\t\t$success = 1;\n+\t\t\tlast BLOCK_A;\n+\t\t}\n+\t\tpop @path;\n+\t\t($node,\n+\t\t $choice,\n+\t \t $path_ref)\n+\t\t= last_unexplored_node(\\@path, $choice, $choice_ref,\n+\t\t\\@node_to_choice, \\@branches);\n+\t\tlast BLOCK_A if ($node == -1);\n+\t\t@path = @$path_ref;\n+\t}\n+\tif ( node_fully_explored($choice, $node, $choice_ref, \\@branches) ) {\n+\t\t($node,\n+\t\t $choice,\n+\t\t $path_ref)\n+\t\t= last_unexplored_node(\\@path, $choice, $choice_ref,\n+\t\t\\@node_to_choice, \\@branches);\n+\t\t@path = @$path_ref;\n+\t\tlast BLOCK_A if ($node == -1);\n+\t}\n+\t($node,\n+\t $choice,\n+\t $node_count,\n+\t $choice_ref,\n+\t $path_ref,\n+\t $branch_ref,\n+\t $node_to_choice,\n+\t $node_contains,) = next_node ($node,\n+\t \t\t\t $choice,\n+\t\t\t\t $node_count,\n+\t\t\t\t $choice_ref,\n+\t\t\t\t \\@path,\n+\t\t\t\t \\@branches,\n+\t\t\t\t $tf_ref);\n+\t@choices = @$choice_ref;\n+\t@path = @$path_ref;\n+\t@branches = @$branch_ref;\n+\t$node_contains[$node] = $node_contains;\n+\t$node_to_choice[$node] = $node_to_choice;\n+\t} \n+return $success;\n+}\n+\n+\n+sub next_node {\n+\n+\tmy ($node,\n+\tmy $choice,\n+\tmy $node_count,\n+\tmy $choice_ref,\n+\tmy $path_ref,\n+\tmy $branch_ref,\n+\tmy $tf_ref) = @_;\n+\tmy @choices = @$choice_ref;\n+\tmy @path = @$path_ref;\n+\tmy @branches = @$branch_ref;\n+\tmy @tfs = @$tf_ref;\n+\tmy $new_choice = $choices[$choice][0];\n+\tpush @{ $choices[$choice] }, shift @{ $choices[$choice] };\n+\t$choice = $new_choice;\n+\tmy $node_to_choice = $choice;\n+\tpush @path, $node if $node;\n+\t$branches[$node]++;\n+\t$node = $node_count++;\n+\tmy $node_contains = $tfs[$choice - 1] if $choice;\n+\treturn (\n+\t\t$node,\n+\t\t$choice,\n+\t\t$node_count,\n+\t\t\\@choices,\n+\t\t\\@path,\n+\t\t\\@branches,\n+\t\t$node_to_choice,\n+\t\t$node_contains);\n+}\n+\n+sub node_fully_explored {\n+no strict "vars";\n+\n+\tmy $choice = shift;\n+\tmy $node = shift;\n+\tmy $choices_ref = shift;\n+\tmy $branch_ref = shift;\n+\tmy @choices = @$choices_ref;\n+\tmy @branches = @$branch_ref;\n+\tif ($branches[$node] == (scalar @{ $choices[$choice] })) {\n+\t\treturn 1 }\n+\telse { return 0 }\n+}\n+\n+sub last_unexplored_node {\n+no strict "vars";\n+\n+\tmy $path_ref = shift;\n+\tmy $choice = shift;\n+\tmy $choice_ref = shift;\n+\tmy $node_to_choice_ref = shift;\n+\tmy $branch_ref = shift;\n+\tmy @path = @$path_ref;\n+\tmy @node_to_choice = @$node_to_choice_ref;\n+\tmy @branches = @$branch_ref;\n+\tmy $node;\n+\n+\tdo {\n+\t\t$node = pop @path;\n+\t\t$choice = $node_to_choice[$node];\n+\t\tif ( $node == 0 and node_fully_explored($choice, $node,\n+\t\t\t$choice_ref, \\@branches) ) {\n+\t\t\t$node = -1;\n+\t\t\tlast;\n+\t\t}\n+\t} while ( node_fully_explored($choice, $node, $choice_ref,\n+\t\t\\@branches) );\n+\treturn ($node, $choice, \\@path);\n+}\n+\n+sub node_terminating {\n+\n+\tmy $choice = shift;\n+\tmy $choices_ref = shift;\n+\tmy @choices = @$choices_ref;\n+\tif ($choices[$choice][0]) { return 0 }\n+\telse { return 1 }\n+\t\n+}\n+\n+\n+\n+\n+\n+\n+\n+\n+\n+\n+\n+\n+\n+\n' |