Platz optimal nutzen (bin packing problem)

[ThorstenHirsch]

Servus.

Ich möchte den Speicherplatz meiner DVD optimal nutzen. Daher habe ich ein Skript geschrieben, das die unterschiedlichen Möglichkeiten alle durchgehen soll und mir dann ausgibt welche Kombination der Dateien in einem Verzeichnis ($ARGV[0]) am nähesten an 4.700.000.000 Bytes rangekommen ist.

Leider funktioniert's nicht, es läuft unendlich lange (bei 21 Dateien). Außerdem bekomme ich warnings "uninitialized value in addition" und ich weiß nicht warum. Bitte schaut mal woran das liegen könnte.

#!/usr/bin/perl -w
#
# mygetbinpacked - bin packing problem
#
# (c) Thorsten Hirsch, 2005
# This Perlscript is released under the terms of GPLv2 or later.
#
# give a directory as parameter where all the
# files you want to pack are in

use strict;

my $MAXSIZE=4700000000;

my @contents=`find $ARGV[0]`;
my @files;
my %sizes=();
my @bestsolution;
my $bestsolutionsize=0;

print"Getting files and their sizes...\n";
foreach my $entry (@contents){
chomp($entry);
if (-f $entry){
push(@files,$entry);
$sizes{$entry}=`du -b \"$entry\" | awk \'{ print \$1 }\'`;
chomp($sizes{$entry});
print(" - $entry : $sizes{$entry}\n");
}
}

# some sub functions...
sub putin{
my $newitem=shift;
my @bag=@_;
push(@bag,$newitem);
my $newsize=&getsize(@bag);
if ($newsize gt $MAXSIZE){
# too full, end of recursion
print("!");
} else {
if ($newsize gt $bestsolutionsize){
@bestsolution=@bag;
$bestsolutionsize=$newsize;
print("*");
}
my %inbag;
for (@bag) {$inbag{$_}=1;}
foreach my $nextitem (@files){
next if $inbag{$nextitem};
print("+");
&putin($nextitem,@bag);
}
}
}

sub getsize{
my @bag=@_;
my $size=0;
foreach my $item (@bag){
$size+=$sizes{$item};
}
return $size;
}

# main
# for every file we start a new bag, then recursively

print("Checking the size of the different combinations...");
my @bag="";
&putin("",@bag); # start with an empty bag


print("\nThe best solution found has a size of $bestsolutionsize and consists of the following items:\n");
for(@bestsolution){print ("$_\n");}

edit: okay, das mit der uninitialized value hab ich rausbekommen

[ThorstenHirsch]

Selbst mit nur 5 Dateien klappt's nicht.
Irgendwas stimmt mit dem getsize nicht oder mit dem Vergleich zwischen newsize und bestsolutionsize. :(

edit: Warum liefert &getsize immer 0 zurück???

[ThorstenHirsch]

Na kommt schon, Jungs!









...bitte :o

[michael.sprick]

Hmmm....
ich versteh Deine Art und Weise zu optimieren noch nicht so ganz.

Also, Du hast ein Verzeichnis, dass Du als Parameter übergibst. In diesem Verzeichnis liegen jede Menge Dateien, die vermutlich in ihrer Gesamtsumme größer sind als 4.7GB.

Was hast Du jetzt _genau_ vor? Willst Du ein Array solange mit Dateieinträgen füllen, bis das Hinzufügen einer weiteren Datei die Grenze von 4.7GB überschreiten würde? Aber wozu dann die Rekursion?

Oder willst Du richtig optimieren? Das wird dann etwas komplizierter, denn Du musst ja alle möglichen Kombinationen durchprüfen - aber dann verstehe ich Deine putin() Funktion nicht...

Mein Vorschlag bis dahin:
° Verzeichnis einlesen,
° Dateieinträge der Größe nach sortieren,
° Jede Datei hinzufügen, vorausgesetzt sie sprengt nicht den Rahmen...



#!/usr/bin/perl
#
# mygetbinpacked - bin packing problem
#
# (c) Thorsten Hirsch, 2005
# This Perlscript is released under the terms of GPLv2 or later.
#
# give a directory as parameter where all the
# files you want to pack are in


#Pragmen und Module:
use strict;
use warnings;

#Konstanten:
use constant MAXSIZE => 4700000000;
use constant VERBOSE => 1;

#Prototypen:
sub GetSize(@);

#Variablen:
my $Path=$ARGV[0];
my @files;
my %sizes;
my @Bag;


#####
#
# Hash Name=>Größe erzeugen
#

print "Getting files and their sizes...\n";
opendir(DH,"$Path") or die "Could not open $Path: $!";
while( my $entry = readdir(DH))
{
if (-f "$Path/$entry")
{
$sizes{$entry}=(stat("$Path/$entry"))[7];
print("\t - $entry : $sizes{$entry}\n") if VERBOSE;
}
}

#####
#
# sortierte Liste erzeugen und Dateien hinzufügen
#
@files=sort {$sizes{$b} <=> $sizes{$a}} keys %sizes;
print "Populating DVD Image...\n";
foreach(@files)
{
if((GetSize(@Bag) + $sizes{$_}) < MAXSIZE)
{
push(@Bag,$_);
print("\t+ Added $_\n");
}
else
{
print("\t* Ommitted $_ : File too large to fit on Disc\n") if VERBOSE;
}
}




sub GetSize(@)
{
my @bag=@_;
my $size=0;
foreach my $item (@bag)
{
$size+=$sizes{$item};
}
return $size;
}



Übrigens: Um Dateien und Verzeichnisse zu öffnen, ihre Größe zu bestimmen oder sie einzulesen braucht man nicht die Shell zu bemühen ;)

perldoc -f opendir
perldoc -f open
perldoc -f stat

hth,Michael

[ThorstenHirsch]

Vielen Dank schonmal.

Also ...ja...nee, ich will alle Kombinationen durchgehen und dann die erhalten, die am nächsten an der Grenze MAXSIZE liegt. Daher Rekursion. Ich hab's bei 5 Dateien im Verzeichnis jetzt auch soweit, dass das Skript zum Ende kommt und nicht unendlich weiterläuft, aber mit der getsize-Funktion stimmt was noch nicht, die liefert immer 0 zurück. Ich schau mir mal das an, was du geändert hast.

Gruß
Thorsten

[ThorstenHirsch]

Im channel #perl im freenode-IRC-net wurde mir noch ein bisschen weitergeholfen. Mitlerweile funktioniert's irgendwie, es gibt mir ein Ergebnis aus, aber das Ergebnis stimmt noch nicht. Das hier ist die Ausgabe bei 5 Dateien:

Checking the size of the different combinations...
+*+*+!+!+!+*+!+!+!++!+!+!++!+!+!+++!+!+!++!+!+!++! +!+!++!+!+!+++!+!+!++!+!+!+*+!+!+!+*+!+!+!+++!+!+! ++!+!+!++!+!+!++!+!+!+++!+!+!++!+!+!++!+!+!++!+!+!
The best solution found has a size of 366802944 and consists of the following items:
datei1
datei2

...Problem an der Sache ist, dass alle 5 Dateien zusammen immer noch < 4,7GiB sind und somit alle 5 Dateien zusammen eigentlich die beste Lösung ist.

Hier die aktuelle Version (hab ein paar Sachen von dir übernommen, Michael, aber von meinem Programmierstil konnte ich mich nicht trennen ;) )

#!/usr/bin/perl
#
# mygetbinpacked - bin packing problem
#
# (c) Thorsten Hirsch, 2005
# This Perlscript is released under the terms of GPLv2 or later.
#
# give a directory as parameter where all the
# files you want to pack are in

use strict;
use warnings;

use constant MAXSIZE => 4700000000;

my @contents=`find $ARGV[0]`;
my @files;
my %sizes;
my @bestsolution;
my $bestsolutionsize=0;

# some sub functions...
sub getthesize{
my @bag=@_;
my $size=0;
foreach my $item (@bag){
next if $item eq "";
$size += $sizes{$item};
# print "size for $item is $size\n";
}
return $size;
}

sub putin{
my $newitem=shift || "";
my @bag=@_;
# print "new: $newitem\n";
push(@bag,"$newitem") unless $newitem eq "";
my $newsize=&getthesize(@bag);
if ($newsize gt MAXSIZE){
# too full, end of recursion
print("!");
} else {
if ($newsize gt $bestsolutionsize){
@bestsolution=@bag;
$bestsolutionsize=$newsize;
print("*");
}
my %inbag;
for (@bag) { $inbag{$_} = 1 }
foreach my $nextitem (@files){
if ($inbag{$nextitem}){
next; # don't put 1 file twice into a bag
} else {
print("+");
&putin($nextitem,@bag);
}
}
}
}

# main
# for every file we start a new bag, then recursively

print"Getting files and their sizes...\n";
foreach my $entry (@contents){
chomp($entry);
if (-f $entry){
push(@files,$entry);
$sizes{$entry}=(stat($entry))[7];
print(" - $entry : $sizes{$entry}\n");
}
}

print("Checking the size of the different combinations...\n");
&putin(); # start with an empty bag


print("\nThe best solution found has a size of $bestsolutionsize and consists of the following items:\n");
for(@bestsolution){print ("$_\n");}

exit 0;
Das mit stat war übrigens ne tolle Idee, das beschleunigt die Sache erheblich. Aber mit find werden auch Unterverzeichnisse berücksichtigt, was bei deiner Variante (mit open) nicht der Fall war ...was natürlich bestimmt auch irgendwie funktioniert, aber find find ich in diesem Fall sehr einfach und da es nur 1x aufgerufen wird auch erträglich vom Geschwindigkeitsverlust.

Gruß
Thorsten

edit: ach ja, die kryptischen Zeichen bedeuten folgendes:
* = neues Optimum gefunden
+ = neue Datei in eine bestehende Bag
! = Bag voll oder alle Dateien durch, Rekursion zu Ende

...zumindest sollte es das bedeuten. Vielleicht ist ja noch ein Denkfehler irgendwo.

[ThorstenHirsch]

Die Größenvergleiche funktionierten nicht. Aber warum?
Also: statt "gt" einfach ">" benutzen und es tut. Allerdings braucht das Skript wirklich ewig - also nee, so is das nix. Das muss noch optimiert werden. Aber wie?

[ThorstenHirsch]

So, ein bisschen optimiert. Jetzt werden wesentlich weniger Kombinationen durchgegangen, da in neue Säcke nur noch Elemente kommen, die nach dem 1. Element des Sacks im File-Array liegen.

Trotzdem: bei 24 Elementen braucht mein Athlon XP 2600+ noch 3m18s um alle Möglichkeiten durchzugehen. Aber das Ergebnis stimmt ...glaub ich. :)

So, hier also Version 1.0:

#!/usr/bin/perl
#
# mygetbinpacked - bin packing problem
#
# version 1.0 (02.03.2005)
#
# (c) Thorsten Hirsch, 2005
# This Perlscript is released under the terms of GPLv2 or later.
#
# give a directory as parameter where all the
# files you want to pack are in

use strict;
use warnings;

use constant MAXSIZE => 4700000000;
use constant DEBUG => 0;
use constant VERBOSE => 1;

my @contents=`find $ARGV[0]`;
my @files;
my %sizes;
my %number;
my @bestsolution;
my $bestsolutionsize=0;

# some sub functions...
sub getthesize{
my @bag=@_;
my $size=0;
foreach my $item (@bag){
next if $item eq "";
$size += $sizes{$item};
print "size for $item is $size\n" if DEBUG;
}
return $size;
}

sub putin{
my $newitem=shift || "";
my @bag=@_;
print "new: $newitem\n" if DEBUG;
push(@bag,"$newitem") unless $newitem eq "";
my $newsize=&getthesize(@bag);
if ($newsize > MAXSIZE){
# too full, end of recursion
print(" - $newsize is greater than MAXSIZE -") if DEBUG;
print("!") if VERBOSE;
} else {
if ($newsize > $bestsolutionsize){
@bestsolution=@bag;
$bestsolutionsize=$newsize;
print("*") if VERBOSE;
}
my %inbag;
for (@bag) { $inbag{$_} = 1; }
my $start=$number{$newitem}+1 || 0;
foreach my $nextitem (@files[$start .. $#files]){
print("+") if VERBOSE;
&putin($nextitem,@bag);
}
}
}

# main
# for every file we start a new bag, then recursively

print"Getting files and their sizes...\n";
foreach my $entry (@contents){
chomp($entry);
if (-f $entry){
push(@files,$entry);
$sizes{$entry}=(stat($entry))[7];
$number{$entry}=$#files;
print(" - $entry : $number{$entry} : $sizes{$entry}\n");
}
}

print("Checking the size of the different combinations...\n");
&putin(); # start with an empty bag


print("\nThe best solution found has a size of $bestsolutionsize and consists of the following items:\n");
for(@bestsolution){print ("$_\n");}

exit 0;

[michael.sprick]

Hmm - also so ganz hab ich´s immernoch nicht geblickt. Aberwenns funktioniert ist ja alles gut:

1. Verbesserungsvorschlag:
Überprüfe als erstes, ob die Gesamtgröße aller Dateien unterhalb 4.7GiB liegt. Wenn ja, kannst Du Dir das mixen sparen... ;)

Ich werd mir das gleich nochmal alles in Ruhe zu gemüte führen.... interessante Sache das ;)