[MacPerl] prograMing: CompleteIndexSet

[Xah Lee <xah@best.com>]

I wrote:
>I have a every interesting
>academic-type programing problem involving array generation, and am
>interested to see creative results. 

Doesn't looks like there's whole lot of interest in this problem. Anyway, here's some codes to satisfy those perl-holic.

The algorithm used for CompleteIndexSet is from Rick Delaney <rick.delaney@shaw.wave.ca>.

#------------------------
#!perl -w

use strict;
#_____ MinimumIndexSet _____ _____

=pod

B<MinimumIndexSet>

MinimumIndexSet([index1,index2,...]) returns a modified version of input in which indexes that can be inferred from other indexes are deleted. Indexes are of the form [n1,n2,n3,...] where the n are non-negative integers.

Related: CompleteIndexSet, FullArrayIndexSet.


Example:

 MinimumIndexSet([[1], [2], [3], [2, 3], [2, 2], [2, 3, 7], [3, 1]])
 #returns [[2, 3, 7], [3, 1]].

=cut

# implementation note:
# definition: Suppose {a,b,c,d} is one index. It is redundant if MemberQ[givenIndexes,{a,b,c,x$_/;x$ > d}|{a,b,c,x$_/;x$ >= d,__}], and if the index is {}, then it is redundant if MemberQ[givenIndexes,{__}].
# algorithm used: exactly same as LeafIndexSet except _leafIndexQ is replaced by _inferableIndexQ.

# Dependent functions: _inferableIndexQ.

# misc notes: this function needs heavy testing. xxxxx

sub MinimumIndexSet ($) {
my @indexList = @{$_[0]};

my $count = 1;
my $ref_currentIndex;
my $ref_currentElement;
OUTER: while ($count < scalar @indexList) {
$ref_currentIndex = $indexList[-$count];
	INNER: for (my $i = scalar(@indexList) -$count -1; $i >= 0; $i--) {
	$ref_currentElement = $indexList[$i];
	
	if (_inferableIndexQ($ref_currentElement,$ref_currentIndex))
	{splice(@indexList,$i,1); next INNER;}
	elsif (_inferableIndexQ($ref_currentIndex,$ref_currentElement))
	{splice(@indexList,-$count,1); next OUTER;};
	};
$count++;
};

return \@indexList;
};

#_____ CompleteIndexSet _____ _____

=pod

B<CompleteIndexSet>

CompleteIndexSet([index1,index2,...]) returns a modified version of argument in which indexes that are implied by givens are inserted. The elements in the result list is arbitrary ordered, and without duplicates.

Related: MinimumIndexSet, FullArrayIndexSet, IndexSetSort.

Example:

The empty array [] in the result represents the index for the root node.

 IndexSetSort( CompleteIndexSet( [[2, 1]] ) );
 #returns [[],[0],[1],[2],[2,0],[2,1]].

 IndexSetSort( CompleteIndexSet( [[2, 1], [3]] ) );
 #returns [[],[0],[1],[2],[3],[2,0],[2,1]].

 IndexSetSort( CompleteIndexSet( [[2, 1], [3], [3]] ) );
 #returns [[],[0],[1],[2],[3],[2,0],[2,1]].

 IndexSetSort( CompleteIndexSet( [[3, 3], [4]] ) );
 #returns [[],[0],[1],[2],[3],[4],[3,0],[3,1],[3,2],[3,3]].

 IndexSetSort( CompleteIndexSet( [[3, 3], [1, 1], [4]] ) );
 #returns [[],[0],[1],[2],[3],[4],[1,0],[1,1],[3,0],[3,1],[3,2],[3,3]].

=cut

# implementation note:
# some description:
# Suppose one of the given index is {a,b,c,d}. If the last digit is not 0, then generate {a,b,c,d-1}. If the last digit is 0, then generate {a,b,c}. Add the new element into a result list. Now take new element as input and repeat the process until it becomes {}. Now do the above with every given index. Now eliminate duplicates and {} in the result list. The result is as desired.

# Dependent functions: (none)

# misc notes: this function needs heavy testing. This function's time complexity can also be improved by first generate a minimum index set, and use a smart algorithm to avoid generating repeatitions (without even checking for existance). xxxxx


sub CompleteIndexSet ($) {
	my @indexList = @{$_[0]};

	my %indexListHash;
	foreach my $elem (@indexList) {$indexListHash{"@{$elem}"} = $elem;};

    foreach my $ref_index (@indexList) {
        my @index = @{$ref_index};
	LOOP1: while (@index) {
			if ($index[-1]-- == 0) {pop(@index);};
			if (exists $indexListHash{"@index"}) {last LOOP1;};
			$indexListHash{"@index"} = [@index];
		};
	};
	return [values %indexListHash];
};


# _inferableIndexQ($indexA,$indexB) returns 1 if $indexB implies $indexA. Suppose indexA = {a,b,c,d}. Then it is inferable if MatchQ[indexB, {a,b,c,x$_/;x$ > d}|{a,b,c,x$_/;x$ >= d,__}]. If indexA == indexB, we also say it's inferable.
# $indexA and B must have the form [n1,n2,...], where n_i is non-negative integer.
# Examples: the following are all true:
# _inferableIndexQ([3,2],[3,2]);
# _inferableIndexQ([3,2],[3,3]);
# _inferableIndexQ([3,2],[3,2,0]);
# _inferableIndexQ([3,2],[3,2,2,4]);
# the following are false:
# _inferableIndexQ([3,2],[4]);
# _inferableIndexQ([3,2],[3,1]);
# _inferableIndexQ([3,2],[3,1,5]);

sub _inferableIndexQ ($$) {
my @indexA = @{$_[0]};
my @indexB = @{$_[1]};

# if length of indexA is greater then indexB, then indexA is not inferable.
if (scalar @indexA > scalar @indexB) {return 0};

# if the first few of indexA are not the same as indexB, then indexA is not inferable.
foreach my $i (0 .. $#indexA -1) {if ($indexA[$i] != $indexB[$i]) {return 0;};};

if ($indexA[-1] <= $indexB[$#indexA]) {return 1;};

return 0;
};

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

 Xah, xah@best.com
 http://www.best.com/~xah/PageTwo_dir/more.html
 "YOU! stop bad cencorship NOW: http://www.cdt.org/ "



***** Want to unsubscribe from this list?
***** Send mail with body "unsubscribe" to mac-perl-request@iis.ee.ethz.ch