respect cycle IDs when parsing cycle refs and building graphs

3 files changed, 70 insertions, 44 deletions

diff --git a/bin/db-zugbildung-to-json b/bin/db-zugbildung-to-json
index d6bd897..b1f804d 100755
--- a/bin/db-zugbildung-to-json
+++ b/bin/db-zugbildung-to-json
@@ -527,32 +527,36 @@ for my $train ( values %map ) {
 	if ( not $from_offset ) {
 		next;
 	}
+	my $cycle_id = "unknown";
 	for my $i_line ( @{ $train->{wagonorder_notes} } ) {
 
        # $i_line is an lvalue, so changes in $i_line end up in wagonorder_notes.
        # We don't want that.
 		my $line = substr( $i_line, 0 );
 
-		# Some cycles do not have a "from" entry, but they do have an odd
-		# F-identifier, which confuses the cycle detection code. remove it.
-		$line =~ s{F[0-9] [0-9]{3}}{.. ...};
+		# Fx abc appears to identify cycle groups.
+		# It also confuses the cycle detection code for cycles which do not have
+		# a "from" entry.
+		if ( $line =~ s{(F[0-9] [0-9]{3})}{.. ...} ) {
+			$cycle_id = $1;
+		}
 		if ( length($line) <= $from_offset ) {
 			next;
 		}
 		my $umlauf = substr( $line, $from_offset );
 		if ( $umlauf =~ m{ ^ (\d+) }x ) {
-			push( @{ $train->{cycle}{from} }, $1 );
+			push( @{ $train->{cycle}{$cycle_id}{from} }, $1 );
 		}
 		if ( length($line) > $to_offset ) {
 			$umlauf = substr( $line, $to_offset );
 			if ( $umlauf =~ m{ ^ (\d+) }x ) {
-				push( @{ $train->{cycle}{to} }, $1 );
+				push( @{ $train->{cycle}{$cycle_id}{to} }, $1 );
 			}
 		}
 	}
-	if ( exists $train->{cycle} ) {
-		@{ $train->{cycle}{from} } = uniq @{ $train->{cycle}{from} // [] };
-		@{ $train->{cycle}{to} }   = uniq @{ $train->{cycle}{to}   // [] };
+	for my $cycle ( values %{ $train->{cycle} // {} } ) {
+		@{ $cycle->{from} } = uniq @{ $cycle->{from} // [] };
+		@{ $cycle->{to} }   = uniq @{ $cycle->{to}   // [] };
 	}
 }
 
diff --git a/bin/umlauf-to-dot b/bin/umlauf-to-dot
index 69472d8..1ac2c2e 100755
--- a/bin/umlauf-to-dot
+++ b/bin/umlauf-to-dot
@@ -52,9 +52,10 @@ my $json         = JSON->new->utf8->decode($file_content);
 
 my $map = $json->{train};
 
-my @train_numbers;
-if ($line) {
+sub build_cycle {
+	my ( $line, $cycle_id ) = @_;
 	my @queue = ( [ $line, 0 ] );
+	my @train_numbers;
 
 	while (@queue) {
 		my ( $train_number, $distance ) = @{ pop @queue };
@@ -65,8 +66,11 @@ if ($line) {
 		}
 
 		my @candidates;
-		push( @candidates, @{ $map->{$train_number}{cycle}{from} // [] } );
-		push( @candidates, @{ $map->{$train_number}{cycle}{to}   // [] } );
+
+		if ( my $c = $map->{$train_number}{cycle}{$cycle_id} ) {
+			push( @candidates, @{ $c->{from} // [] } );
+			push( @candidates, @{ $c->{to}   // [] } );
+		}
 
 		@candidates = uniq @candidates;
 		@candidates
@@ -79,32 +83,48 @@ if ($line) {
 
 		push( @queue, map { [ $_, $distance + 1 ] } @candidates );
 	}
-}
-else {
-	@train_numbers = keys %{$map};
-}
 
-my @output;
-
-for my $train_number (@train_numbers) {
-	for my $from ( @{ $map->{$train_number}{cycle}{from} } ) {
-		push(
-			@output,
-			sprintf( "%s -> %s;",
-				format_train( $from,         $map->{$from} ),
-				format_train( $train_number, $map->{$train_number} ) )
-		);
-	}
-	for my $to ( @{ $map->{$train_number}{cycle}{to} } ) {
-		push(
-			@output,
-			sprintf( "%s -> %s;",
-				format_train( $train_number, $map->{$train_number} ),
-				format_train( $to,           $map->{$to} ) )
-		);
+	my @output;
+
+	for my $train_number (@train_numbers) {
+		if ( my $c = $map->{$train_number}{cycle}{$cycle_id} ) {
+			for my $from ( @{ $c->{from} // [] } ) {
+				push(
+					@output,
+					sprintf( "%s -> %s;",
+						format_train( $from,         $map->{$from} ),
+						format_train( $train_number, $map->{$train_number} ) )
+				);
+			}
+			for my $to ( @{ $c->{to} // [] } ) {
+				push(
+					@output,
+					sprintf( "%s -> %s;",
+						format_train( $train_number, $map->{$train_number} ),
+						format_train( $to,           $map->{$to} ) )
+				);
+			}
+		}
+		if ( $train_number != $line ) {
+			push(
+				@output,
+				sprintf( "%s [shape=box];",
+					format_train( $train_number, $map->{$train_number} ) )
+			);
+		}
 	}
+
+	return @output;
 }
 
+my @cycle_ids = keys %{ $map->{$line}{cycle} // {} };
+
 say "digraph Umlauf {";
-say join( "\n", uniq @output );
+
+for my $cycle_id (@cycle_ids) {
+	say join( "\n", uniq build_cycle( $line, $cycle_id ) );
+}
+
+printf( "%s [style=bold];\n", format_train( $line, $map->{$line} ) );
+
 say "}"
diff --git a/schema.yml b/schema.yml
index 44869d1..60f5b15 100644
--- a/schema.yml
+++ b/schema.yml
@@ -128,15 +128,17 @@ components:
           description: rated maximum speed in km/h
     cycle:
       type: object
-      properties:
-        from:
-          type: array
-          items:
-            type: string
-        to:
-          type: array
-          items:
-            type: string
+      additionalProperties:
+        type: object
+        properties:
+          from:
+            type: array
+            items:
+              type: string
+          to:
+            type: array
+            items:
+              type: string
     hasWagon:
       type: object
       additionalProperties: