develooper Front page | perl.riscos | Postings from August 2006

Re: Out of memory!

Thread Next
From:
Philip Perry
Date:
August 20, 2006 14:47
Subject:
Re: Out of memory!
Message ID:
Marcel-1.53-0820220134-0b07Uyg@pjperry.freeuk.net
Hello All,

Is there any way around the 28640K memory limit for a TaskWindow?

Posted to both RISCOS Perl list and AoL as though the difficulty arises
from a BIG perl hash it appears to be limited by RISCOS (3 & 4). rather
than Perl itself.

A little background:

I've recently been investigating the idea of a
dynamic 'mutable base' position value number system (place notation). A
number system similar to the familiar decimal/arabic system but with
each column base determined by the number of digits in the preceding
column(s). There is no limit, theoretically, on how many digits a column
may hold. And this mutable base system has no 'zero' (which implies a
set base or pattern of bases), rather the previous history of the
number... how it built up its earlier columns, is stored in place of
zero.

A particular feature of this system is that many, indeed most, numbers
can be accessed by more than one digit sequence. Primes are the
exception, they have only one sequence. In contrast to the primes, some
numbers are fecund, relative to their size, for example 1296
(2x2x2x2x3x3x3x3) can be expressed as 70 different combinations of
columns of 2 and 3 digits... and beyond the 70 arrangements there are
all the multiplied out possibilities like 4x2x2x27x3. Other numbers have
a particularly diverse 'quality', for example 210 (2x3x5x7) with 24
different digit sequences, contrasting with 64 which has many
'multiplied out' arrangements of 2s, but a bare sameness to them all.

Another feature of this number system is that all numbers possess a
'prime state' -i.e. for the number 210, one column of 210 digits! And a
'ground state' -i.e. 7x5x3x2, a column of 7 units, followed by a column
of 5 digits, followed by a column of 3 digits followed by a column of 2
digits. It is convenient to express the column digits as decimal
numbers, eg. for the number 24... in two columns... 3~ 8 or 4~ 6. [From
the EofM articles you might recognise these two digit sequences as a
perfect cadence (chords V7 -> I) taken in isolation.]

I am not much of a programmer and use Perl in the spirit of Basic for
the ordinary user on the early Archimedes... to solve my own problems
and tasks (well sometimes). The task here (below) is to write out all
the different arrangements of columns which access a given number. The
script below has been a bit of a struggle, is probably needlessly
complex, and relies on checking new arrangements against those already
found... thus the BIG hash in the second section. There is I expect a
simple routine to do this, but I haven't been able think of it :-(  I am
still trying, however, this one does do the job. The problem with it is
that beyond mutable base numbers of eight columns the script requires
more than than 28640K of memory. The TaskWindow gives up: "Out of
memory!"

My computer has 72MB of memory, is there any way for the TaskWindow to
access this? Or some other way around it? I have RO 3 and 4 machines and
Perl 5.8.8.

Best regards, Philip.



#!perl
#digseq - finds all possible arrangements of a set of digits, that is,
# all the unique nested configurations of a mutable base number, for
# example, M60[5] nesting M6 nesting M2 - (h1,2,3,4,5,10,15,30). This
# MBN 30 can be accessed by six alternative digit sequences: 5~3~2,
# 5~2~3, 3~5~2, 3~2~5, 2~5~3 and 2~3~5; each physically distinguishable
#
# Usage: [perl] digseq -n<number>
# i.e.   perl digseq -n210
# Usage: [perl] digseq -f<factor,factor,...>
# i.e.   perl digseq -f2,3,5,7
# Usage: [perl] digseq -h
#
# First the script works out the prime factors of the given number.
# The 'factors' (@digits) are marked as 'positions' (0..n) in @array.
# The $total (max number of possible arrangements) is worked out and
# @array filled with positions 0..n. Next two randomly chosen positions
# are swapped and the new sequence of positions checked for already
# existing as a key in %digseq. Random swapping is redo-ne until an
# unknown sequence is found. Then the algorithm after the else statement
# finds a 'sector' of the total positions. The while loop continues this
# cycle until all possible positions ($total) are reached. There is some
# redundancy in these sectors, but it does eventually find everything.
# As the script relies on a random search, this can take some time for 8+
# digits, so perhaps running as a background task is a good idea. There is
# I expect a more efficient recursive algorithm, but it has eluded me :-(
# Once $total is reached, the postions are turned into the original digits
# and printed out. Where the digits or factors are not unique i.e. 2,2,3,3
# (but the positions are) the %hash keys winnow out multiple arrangements.
# The output is in the form: digit sequence => number of identical seq.
# copyright pjperry@freeuk.com 2006.

use strict;
my @digits;
{
 my $number = undef;

 if ($ARGV[0] =~ /^-n/) {                  #Get conversion option (s2e or e2s)
   $number = substr($ARGV[0], 2);           #score2event-list or vice versa.
   if ( $number < 1 || $number != int($number) ) { # Check input.
     print "digseq script accepts only positive whole numbers.";
     print;
     &help_usage();                          
     exit 0;
   }

 } elsif ($ARGV[0] =~ /^-f/) {
   my $factors = substr($ARGV[0], 2);   #score2event-list or vice versa.
   @digits = split /,/, $factors;       # Maybe check for pos whole numbers?

 } else {
   print "Usage: [perl] digseq -n<number>\n";
   print "i.e.   perl digseq -n210\n";
   print "Usage: [perl] digseq -f<factor,factor,...>\n";
   print "i.e.   perl digseq -f2,3,5,7\n";
   print "Usage: [perl] digseq -h\n";
   print "Sorry, further help text not written yet.\n";                    
   #&help_usage();                          #Print help/usage & close.
   exit 0;
 }

 #--- first section finds the prime factors of a given number ---
 if ( $number ) {
   my ($num, $j, $i, $n, $n_sqd, $s_sqd, $s, $f1, $f2, $m, $p);
   my (@pairs, @primes, @primes2);

   $num = $number;                           # Reduce to odd number
   while ($num % 2 == 0 && $num > 1) {       # placing 2 factors in
     push @digits, 2;                        # @digits.
     $num /= 2;
   }
  
   if ($num > 1) {                    # Find all factors and multiples
     $j = int( sqrt($num) ) + 1;      # of rump odd $num (>1) left
     $i = 2;                          # from divide by 2, above.
     $n = $num;
     while ( $n > $j ) {
       $n = ($num / $i) + ($i / 4);   # Resonance algorithm, whole
       if ( $n == int($n) ) {         # numbers signal factor/multiple.
         $n_sqd = $n * $n;
         $s_sqd = $n_sqd - $num;
         $s = sqrt( $s_sqd );
         $f1 = $n + $s;
         $f2 = $n - $s;
         push @pairs, $f2;            # Put results in @pairs
         push @pairs, $f1;
       }
       $i += 4;
     }
     #print "Pairs = @pairs\n";
     shift @pairs;                    # First pair 1 and $num, discard 1.
     foreach (@pairs) {               # Sieve out primes from multiples
       $m = &primeFactor($_);         # by running them through the 'res
       if ($m > 0) {                  # algorithm' again, one by one,
         push @primes, $m;            # primes will only produce a single
       }                              # pair - see sub primeFactor.
     }
     $n = $num;                       # Now we have each unique prime,
     foreach $p (@primes) {           # (above 2) but for many numbers
       my $go = 1;                    # they may be used more than once.
       while ($go == 1) {             # So divide $num by each unique $p
         push @primes2, $p;           # in turn, and check if 'mod the
         $n = $n / $p;                # result' allows another division
         if ($n % $p != 0) {          # by $p, until no more, then pass
           $go = 0;                   # on to next unique $p.
         }
       }
     }
     @primes2 = sort { $a <=> $b } @primes2;
     @digits = (@digits, @primes2);   # sort the sieved primes and store
   }                                  # in @digits after any twos.
   print "Prime factors of $number are: @digits\n";
 }
}

 #--- Second section find all unique arrangements of the digits---

{
 my ($total, $keyCount, $r, $r2, $tmp, $str, $cnt, $key);
 my (@array, @backwards, @fields, %digseq, %hash, @k);  
 my $n = $#digits;                   # How many digits?
 my $np1 = $n + 1;                   # Save a few cpu cycles.

 $total = 1;
 foreach (0..$n) {                   # Setup total posible seqences
   $total = $total * ($_ + 1);
   $array[$_] = $_;                  # Setup 'positions' of @digseq
 }                                   # values in @array.

 $keyCount = 0;
 while ($total > $keyCount) {
   $r = int(rand($np1));             # Start redo here.
   $r2 = int(rand($np1));
   $tmp = $array[$r];                # Do random swap of @array positions.
   $array[$r] = $array[$r2];
   $array[$r2] = $tmp;
   $tmp = "";
   $str = join " ", @array;          # Join poistions into digit seq str.
   $str .= " ";
   if ( exists $digseq{$str} ) {
     $str = "";                      # Is it a new sequence? Or redo.
     redo;
   } else {
     $str = "";
     foreach (0..$n - 1) {           # Find a 'sector' of arrangements.
       my ($a, $b);                  # Avoid conflict with sort
       foreach (0..$n) {             
         foreach (@array) { $str .= "$_ " }
         $digseq{$str} += 1;         # BIG hash
         $str = "";
         @backwards = reverse @array;
         foreach (@backwards) { $str .= "$_ " }
         $digseq{$str} += 1;         # Nominal '1', key holds the positions.
         $str = "";
         $a = shift @array;
         push @array, $a;            
       }                             # Value $a carried over from rotation.
       pop @array;                   # Pops $a back out, Here the first
       $b = shift @array;            # & second values are rotated.
       unshift @array, $a;
       unshift @array, $b;
     }
   }
   $keyCount = keys %digseq;
   print "digit sequences found: $keyCount, out of total possible: $total\n";
 }

 @k = keys %digseq;                  # Turn positions held in keys into 
 foreach (@k) {                      # their values (factors) plus ~
   @fields = split /\s+/, $_;
   foreach (@fields) {
     $str .= "$digits[$_]~ ";        
   }
   $str = substr($str, 0, (length($str) - 2)); # Clip final '~ '
   $hash{$str} += 1;                 # Sieve out duplicte arrangements
   $str = "";                        # and record how many.
 }

 foreach $key (sort {$a <=> $b} keys %hash) {
   $cnt++;                           # Sort by first digit and count.
   print "$key => $hash{$key}\n";    # Turn off warnings: str not numeric.
 }
 print "total number of possible configurations: $total\n";
 print "total number of different configurations: $cnt\n";
}
exit 0;

 #---- This subroutine is used by the first section of the script ----
 sub primeFactor {                  # Sub is handed one factor/multiple.
   my ($num, $j, $i, $n, $n_sqd, $s_sqd, $s, $f1, $f2, $tot, $z, @pairs );
   $num = $_[0];
   $j = int( sqrt($num) ) + 1;      # Sub splits $num into all possible
   $i = 2;                          # whole factor/multiples. Primes get
   $n = $num;                       # only 1 and $num, none primes have
   while ( $n > $j ) {              # more than one pair.
     $n = ($num / $i) + ($i / 4);   # Resonance algorithm, whole
     if ( $n == int($n) ) {         # numbers signal factor/multiple.
       $n_sqd = $n * $n;
       $s_sqd = $n_sqd - $num;
       $s = sqrt( $s_sqd );
       $f1 = $n + $s;
       $f2 = $n - $s;
       push @pairs, $f2;
       push @pairs, $f1;
     }
     $i += 4;
   }
   $tot = @pairs;                   # If only one pair, the arg/$num is
   if ($tot == 2) {                 # prime and is returned, otherwise
     $z = $_[0];                    # zero.
   } else {
     $z = 0;
   }
 } 



-- 
Philip Perry, pjperry@freeuk.com
http://www.pjperry.freeuk.com/


Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About