#!/usr/bin/perl # solve.pl use warnings; use strict; use YAML; use File::Temp 'tempfile'; use List::Util 'sum'; my $points = YAML::Load( do { local $/; <> } ); my $triangles = compute_delaunay_triangulation( $points ); my $segs = unique_segments( $triangles ); my @seg_endpoints = map [ @{$points}[@$_] ], @$segs; my @seg_lengths = map seg_length($_), @seg_endpoints; my $count = @$segs; my $mean = sum(@seg_lengths) / $count; print "edge count = $count\n"; print "average edge length = $mean\n\n"; print "edge endpoints follow in YAML format\n\n"; print YAML::Dump( @seg_endpoints ); sub compute_delaunay_triangulation { # use Qhull's qdelaunay for this my ($points) = @_; my $fh = tempfile(); die "cannot open tempfile: $!" unless $fh; my $pid = open my $write_to_child, "|-"; die "cannot fork: $!" unless defined $pid; if ($pid) { # parent print $write_to_child "2\n", scalar @$points, "\n", map "@$_\n", @$points; close $write_to_child || warn "kid exited $?"; } else { # child open STDOUT, '>&', $fh or die "could not redirect stdout: $!"; close $fh or die "error on close of tempfile: $!"; exec qw(qdelaunay Qt i) or die "could not exec qdelaunay: $!"; } wait; seek $fh, 0, 0 or die "could not seek to start of tempfile: $!"; my $results = do { local $/; <$fh> }; close $fh; (undef, my @triangles) = split /\n/, $results; return [ map [split], @triangles ]; } sub unique_segments { my ($triangles) = @_; my %segs; for my $tri (@$triangles) { for ([0,1],[1,2],[2,0]) { my @points = sort @{$tri}[@$_]; $segs{"@points"} = \@points; } } [ values %segs ]; } sub seg_length { my ($seg) = @_; my ($x,$y,$x1,$y1) = ( $seg->[0][0], $seg->[0][1] , $seg->[1][0], $seg->[1][1] ); sqrt( ($x - $x1) ** 2 + ($y - $y1) ** 2); }