Perl Script Logik Fehlersuche

[VolkerGBenner]

Ich versuche den Advent of Code 2025 mit Perl zu meistern. Jetzt hänge ich bei Tag 8 Teil 2. Der Script löst Teil 1, kommt aber bei Teil 2 zu einem abweichenden Ergebnis. Erstmal mein Script:

Code Auswählen Erweitern

#!/usr/bin/perl -w

use warnings;
use strict;
use feature 'say';
print "Perl version: $]\n";
print "$^V\n";

open(my $in, '<', $ARGV[0]) or die $!;
my $topcircuits = $ARGV[1] || 0;
my $ende=1;

my %hash =();
my $hashsize = 0 ;
my $i =1;

my (@pointA ,@pointB, @pair ,@circuit ) = ();

my (%dists, %circuits, %tboxes  )= ();

my ($match,$dist ) = 0;


while($ende){
MAIN();
say "\nEnde";
}


########################## Sub MAIN ########################
sub MAIN {

READ_LINES($_);


Alle_Entfernungen();

if ( $^P ) {Show_Entfernungen();}
#<STDIN>; #say  "\n--------------------------\nRelevante mögliche Entfernungen:\n";
my $k =1;

foreach $dist (sort {$a<=>$b} keys %dists){
my @circuit  =(); #jedes mal Neudeklaration für neue Referenz
my $ist_treffer = 0;
my $treffer = 0; #say "\nK: ".$k. "\t".$dist.": ".$dists{$dist};

@circuit  = split (/:/, $dists{$dist}); if ( $^P ) {say "\n".$k." current connection: ".join(" ", @circuit )."  Abstand: ".$dist;}

if(keys %circuits){ #gibt es schon einen kreis?
#jetzt ja
foreach my $cikey (sort {$a<=>$b} keys %circuits){ #alle vorhandenen Kreise nacheinander anschauen

foreach(@circuit){ # zwei Dosen pro Verbindung
$tboxes{$_}=1;
my $node = $_;
foreach (sort {$a<=>$b} @{$circuits{$cikey}}) {
if( $_ == $node){
$ist_treffer++;

$treffer = $_;
#say $ist_treffer ." Treffer ".$treffer;
}
} #say "jeder ".$_;

}
if ($ist_treffer == 1){

my $new_node = ($circuit[0] == $treffer) ? $circuit[1] : $circuit[0];

my $overlap = IS_CIRCUIT_OVERLAP($new_node);

if ($overlap){
if ( $^P ) {say "Overlap, Kreise werden vereinigt";}
foreach(@{$circuits{$overlap}}){
push @{$circuits{$cikey}}, $_;
}
delete $circuits{$overlap};
say "Anzahl verbleibender Kreise: ".keys%circuits;
if ( keys%circuits == 1 ){
if ( $^P ) {<STDIN>;}
my @eins = split (",",$hash{$circuit[0]});
say "X-EINS von Node ".$circuit[0]." ist ".$eins[0];
my @zwei = split (",",$hash{$circuit[1]});
say "X-ZWEI von Node ".$circuit[1]." ist ".$zwei[0];
my $ix =$eins[0]*$zwei[0];
say "Produkt der letzen beiden X-Koordinaten: ". $ix;
if ( $^P ) {<STDIN>;}
}
last;
}else {
if ( $^P ) {say "Kein Overlap, Node wird angehängt ";}
push @{$circuits{$cikey}}, $new_node;
last;
}
}else{next;}
#$ist_treffer = 0;
}
if($ist_treffer == 0){
$circuits{$circuit[0]} = \@circuit;
if ( $^P ) {say "Keine Übereinstimmung, neuer Kreis wir erstellt.\nNeue Anzahl  Kreise".keys%circuits;
#<STDIN>;
}


}
#say "TopX Kreise: ".$circuit[0].": ".join(" ",@{$circuits{$circuit[0]}});
}else {$circuits{$circuit[0]} = \@circuit; # erster Kreis wird erstellt
if ( $^P ) {say "erster Kreis ";}
}
if ( $^P ) { say "- - -- - - - - - -  - - - - - - _ _ _ - - - - - - __ --_-___";
foreach(sort {$a<=>$b} keys %circuits){
printf "\nmaleben schauen - Key: %4d Kreis:\t%s \n " , $_,join (" : ", sort {$a<=>$b}@{$circuits{$_}});
}
}

if ($k == $topcircuits){

AUSGABE_TEIL1($k);
say "Teil2 -> "; <STDIN>;
#last;
}
$k++;



}



#$i=1;

close($in);

$ende=0;

return 1;
}
#################### SUB MAIN  Ende ###################################


#################################### sub READ_LINES ############################
sub READ_LINES  {
while(<$in>){
chomp ;
last if $_ eq "";

$hash{$i} = $_;
$i++;

}

if ( $^P ) {foreach my $what (sort {$a<=>$b}keys %hash){say $what ." : ".$hash{$what};}}
return 1;
}
#################### ENDE Sub READ_LINES ######################################################

#############   Start Sub Alle_Entfernungen()    ######################
sub Alle_Entfernungen{
$hashsize = keys %hash;
for(my $keyA = 1; $keyA <= $hashsize; $keyA++){
@pointA = split(/\,/ , $hash{$keyA});

for(my $keyB = $keyA+1; $keyB <= $hashsize; $keyB++){
@pointB  = split(/\,/ , $hash{$keyB});

my $aaa = $pointB[0]-$pointA[0];
my $bbb = $pointB[1]-$pointA[1];
my $ccc = $pointB[2]-$pointA[2];

$dist = (($aaa)**2)+(($bbb)**2)+(($ccc)**2) ;

if (!exists $dists{$dist}){
$dists{$dist} = $keyA.":".$keyB;
}else {
#$dists{$dist}=$dists{$dist}.",".$keyA.":".$keyB; #there are no equal distances in the input, so don't care about it
if ( $^P ) {say "\n gleiche Länge entdeckt!". $dist." ".$dists{$dist};}
if ( $^P ) {<STDIN>;}
}
}
}

}
#############   Ende Sub Alle_Entfernungen()    ######################
##############  Start sub Show_Entfernungen()    #############
sub Show_Entfernungen{
<STDIN>;

my $ka = 1;
say "";
foreach(sort {$a<=>$b} keys %dists){
say $ka." Dist: ".$_." -- ".$dists{$_};
$ka++;
}

}
##############  Ende sub Show_Entfernungen()    #############

############## Start sub IS_CIRCUIT_OVERLAP    ################

sub IS_CIRCUIT_OVERLAP {
my $node = $_[0];
say " look for overlap for node ".$node;
foreach my $cikey (sort {$a<=>$b} keys %circuits){ #alle vorhandenen Kreise nochmal nacheinander anschauen

foreach (sort {$a<=>$b} @{$circuits{$cikey}}) {
if( $_ == $node){

return $cikey;

}
}

}

return 0;
}

############## Ende sub IS_CIRCUIT_OVERLAP    ################

############## Start sub  AUSGABE_TEIL1()  ##################
sub AUSGABE_TEIL1{
my $k = $_; say "Boxen netto".keys(%tboxes);<STDIN>;
my %hboxes = ();


say "\nAnalyse";
foreach my $circ ( sort {$a<=>$b} keys %circuits){
my $ref = $circuits{$circ};
foreach(@$ref){
$hboxes{$_}=1;
}
say "Circuit ".$circ." : ".join(" ", @{$ref})
}
say "Boxen in Kreisen".keys(%hboxes);
say "\nSortiert: ";
my $solo_size = 0;
my $prod_size = 1;
$k=0;
foreach my $circ ( sort {@$b<=>@$a} values %circuits){
#my $ref = $circuits{$circ};
#say "Circuit ".$circ." : ".join(" ", @{$ref})
$solo_size = @$circ;
$prod_size *= $solo_size;

if ( $^P ) {say "Kreis Größe:".$solo_size." Produkt:  ".$prod_size." : ".join(" ", sort {$a<=>$b}@$circ);}
$k++;
if($k == 3){last;}
}

}
############## Ende sub  AUSGABE_TEIL1()  ##################
Ich rücke mit TAB ein, das macht es hier wohl etwas schlecht zu lesen

Die Test Input-Datei enthält dies:

Code Auswählen Erweitern

162,817,812
57,618,57
906,360,560
592,479,940
352,342,300
466,668,158
542,29,236
431,825,988
739,650,466
52,470,668
216,146,977
819,987,18
117,168,530
805,96,715
346,949,466
970,615,88
941,993,340
862,61,35
984,92,344
425,690,689
Bei der richtigen Datei sind es 1000 Datenzeilen.

Mein aktuelles Problem.

Die errechneten Distanzen werden der Größe nach geordnet und dann nacheinander wo möglich zu Kreisen  verbunden oder neue Kreise angelegt. Bei je einem Knoten in zwei verschiedenen Kreisen, werden die Kreise zu einem verbunden.

Im zweiten Teil geht es darum, solange zu verbinden, bis erstmalig ein einziger großer Kreis durch eine neu Verbindung gemergt wird.
Nach der Anleitung sollte nach 29 verbundenen Verbindungen die Verbindung 11:13 zwei Kreise zu einem verbinden. Bei meinem Skript habe ich aber schon nach 23 Verbindungen mit 9:17 einen einzigen Kreis erreicht.
Ich bin jetzt mittlerweile komplett ratlos und habe schon perplexity ( LOL ) und GitCopilot (ROFL) um Hilfe gebeten. Die sind auch überfordert. Alle andern Lösungen sind in Sprachen geliefert, die ich dann auch erst mal verstehen müsste.
Da hier ja viele Perl-Heroes mitlesen, habe ich etwas Hoffnung, dass mein Krüppel-Code verstanden wird und ich eien Hinweis darauf bekomme, was ich falsch denke.
Bis zum Teil1-Ergebnis passt der Code ja, also kann die Längenberechnung nicht völlig falsch sein. Aber der Erklärbär vom AdventOfCode muss irgendwie auf eine andere Sortierung in den Längen kommen.

Wer gerade Zeit und Lust auf Knobeln hat, kann sich ja mal versuchen. Oder hat hier schon jemand die/eine fertige Lösung?

Meine Logik deckt sich eigentlich mit allen andern bestehenden Lösungen anderer Teilnehmer. Es muss eine Kleinigkeit sein, die ich nicht checke.
Ich mache das um Perl meine Perl- und Logik-Kenntnisse zu verbessern, nicht weil ich denke besonders gut darin zu sein.

[Nobbynews]

Ohne jetzt den Code an sich verstanden zu haben:

Code Auswählen Erweitern

my $aaa = $pointB[0]-$pointA[0];
            my $bbb = $pointB[1]-$pointA[1];
            my $ccc = $pointB[2]-$pointA[2];
           
            $dist = (($aaa)**2)+(($bbb)**2)+(($ccc)**2) ;
Die Formel für die Entfernung ist falsch. Es fehlt die Quadratwurzel.
https://en.wikipedia.org/wiki/Euclidean_distance#Higher_dimensions
Und außerdem sind sämtliche Klammern in der Addition total überflüssig.

Oder ist gement: https://en.wikipedia.org/wiki/Euclidean_distance#Squared_Euclidean_distance

[betateilchen]

Oder ist gement: https://en.wikipedia.org/wiki/Euclidean_distance#Squared_Euclidean_distance

Jepp.