Skip to content

Commit 2cf72a1

Browse files
drgrice1drgrice1
committed
Objectifying.
1 parent 45855e1 commit 2cf72a1

File tree

1 file changed

+349
-0
lines changed

1 file changed

+349
-0
lines changed

‎macros/math/GraphTheory.pl‎

Lines changed: 349 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,5 @@
1+
## no critic (TestingAndDebugging::RequireUseStrict, TestingAndDebugging::RequireUseWarnings)
2+
## no critic (Modules::RequireExplicitPackage)
13
BEGIN { strict->import; }
24

35
sub _GraphTheory_init { }
@@ -1281,4 +1283,351 @@ sub GRvertices_labels_labels {
12811283
return map { GRvertex_label_labels(substr($labels, $_, 1), $orig_labels) } 0 .. length($labels) - 1;
12821284
}
12831285

1286+
sub simpleGraph { GraphTheory::Graph->new(@_) } ## no critic (Subroutines::RequireArgUnpacking)
1287+
1288+
package GraphTheory::Graph;
1289+
1290+
sub new {
1291+
my ($class, $representation, %options) = @_;
1292+
my $self = bless {}, ref($class) || $class;
1293+
1294+
if (eval { $representation->isa('GraphTheory::Graph') }) {
1295+
$self->{adjacencyMatrix} = [ map { [@$_] } @{ $representation->adjacencyMatrix } ];
1296+
$self->{labels} = [ @{ $representation->{labels} } ];
1297+
} elsif (ref $representation eq 'ARRAY') {
1298+
if ($options{adjacencyMatrixDefinition}) {
1299+
$self->{adjacencyMatrix} = [];
1300+
for my $i (0 .. $#$representation) {
1301+
die 'Invalid adjacency matrix format.' unless ref $representation->[$i] eq 'ARRAY';
1302+
die 'The adjacency matrix for a graph must be a square matrix.'
1303+
unless @{ $representation->[$i] } == @$representation;
1304+
for my $j (0 .. $#{ $representation->[$i] }) {
1305+
die 'The adjacency matrix for a graph must be symmetric.'
1306+
unless $representation->[$i][$j] == $representation->[$j][$i];
1307+
}
1308+
push(@{ $self->{adjacencyMatrix} }, [ @{ $representation->[$i] } ]);
1309+
}
1310+
} else {
1311+
die 'Labels must be provided when using an edgeset definition.' unless ref $options{labels} eq 'ARRAY';
1312+
1313+
$self->{labels} = [ @{ $options{labels} } ];
1314+
$self->{adjacencyMatrix} = [ map { [ (0) x @{ $self->{labels} } ] } @{ $self->{labels} } ];
1315+
1316+
my %labelIndices = map { $self->{labels}[$_] => $_ } 0 .. $#{ $self->{labels} };
1317+
1318+
for my $i (0 .. $#$representation) {
1319+
die 'Invalid edge set format.' unless ref $representation->[$i] eq 'ARRAY';
1320+
my @edge = @{ $representation->[$i] };
1321+
die 'Invalid edge format.' unless @edge >= 2;
1322+
die "Invalid vertex $edge[0] in edge set." unless defined $labelIndices{ $edge[0] };
1323+
die "Invalid vertex $edge[1] in edge set." unless defined $labelIndices{ $edge[1] };
1324+
$self->{adjacencyMatrix}[ $labelIndices{ $edge[0] } ][ $labelIndices{ $edge[1] } ] = $edge[2] // 1;
1325+
$self->{adjacencyMatrix}[ $labelIndices{ $edge[1] } ][ $labelIndices{ $edge[0] } ] = $edge[2] // 1;
1326+
}
1327+
}
1328+
} else {
1329+
my $edgeProbability = $options{edgeProbability} // 0.5;
1330+
my $edgeCount = 0;
1331+
for my $i (0 .. $representation - 1) {
1332+
$self->{adjacencyMatrix}[$i][$i] = 0;
1333+
for my $j (0 .. $i - 1) {
1334+
if (main::random(0, 100) <= 100 * $edgeProbability) {
1335+
my $weight =
1336+
ref $options{randomEdgeWeights} eq 'ARRAY' && @{ $options{randomEdgeWeights} } == 2
1337+
? main::random($options{randomEdgeWeights}[0], $options{randomEdgeWeights}[1])
1338+
: 1;
1339+
$self->{adjacencyMatrix}[$i][$j] = $weight;
1340+
$self->{adjacencyMatrix}[$j][$i] = $weight;
1341+
++$edgeCount;
1342+
} else {
1343+
$self->{adjacencyMatrix}[$i][$j] = 0;
1344+
$self->{adjacencyMatrix}[$j][$i] = 0;
1345+
}
1346+
}
1347+
}
1348+
1349+
if (($options{startEdgeWeight} // 0) > 0 && ($options{edgeWeightIncrement} // 0) > 0) {
1350+
my @weights =
1351+
map { $options{startEdgeWeight} + $_ * $options{edgeWeightIncrement} } 0 .. $edgeCount - 1;
1352+
@weights = @weights[ main::random_subset($edgeCount, 0 .. $edgeCount - 1) ];
1353+
for my $i (0 .. $#{ $self->{adjacencyMatrix} }) {
1354+
for my $j (0 .. $i - 1) {
1355+
next unless $self->{adjacencyMatrix}[$i][$j];
1356+
$self->edgeWeight($i, $j, shift @weights);
1357+
}
1358+
}
1359+
}
1360+
}
1361+
1362+
if (ref $options{labels} eq 'ARRAY') {
1363+
die 'Not enough vertex labels provided.' if @{ $options{labels} } < $self->numVertices;
1364+
$self->{labels} = [ @{ $options{labels} }[ 0 .. $#{ $self->{adjacencyMatrix} } ] ];
1365+
}
1366+
1367+
unless (defined $self->{labels}) {
1368+
my $alphaOffset = main::random(0, 26 - $#{ $self->{adjacencyMatrix} });
1369+
$self->{labels} = [ ('A' .. 'Z')[ $alphaOffset .. $alphaOffset + $#{ $self->{adjacencyMatrix} } ] ];
1370+
}
1371+
1372+
return $self;
1373+
}
1374+
1375+
sub adjacencyMatrix {
1376+
my $self = shift;
1377+
return $self->{adjacencyMatrix};
1378+
}
1379+
1380+
sub edgeSet {
1381+
my $self = shift;
1382+
my @edgeSet;
1383+
for my $i (0 .. $#{ $self->{adjacencyMatrix} }) {
1384+
for my $j (0 .. $i - 1) {
1385+
next unless $self->{adjacencyMatrix}[$i][$j];
1386+
push(@edgeSet, [ $self->vertexLabel($i), $self->vertexLabel($j) ]);
1387+
}
1388+
}
1389+
return \@edgeSet;
1390+
}
1391+
1392+
sub numVertices {
1393+
my $self = shift;
1394+
return scalar @{ $self->{adjacencyMatrix} };
1395+
}
1396+
1397+
sub labels {
1398+
my ($self, $labels) = @_;
1399+
if (ref $labels eq 'ARRAY') {
1400+
die 'Not enough vertex labels provided.' if @$labels < $self->numVertices;
1401+
$self->{labels} = [ @$labels[ 0 .. $self->numVertices ] ];
1402+
}
1403+
return $self->{labels};
1404+
}
1405+
1406+
sub vertexLabel {
1407+
my ($self, $vertexIndex) = @_;
1408+
return $self->{labels}[$vertexIndex];
1409+
}
1410+
1411+
sub vertexIndex {
1412+
my ($self, $vertexLabel) = @_;
1413+
for (0 .. $#{ $self->{labels} }) {
1414+
return $_ if $vertexLabel eq $_;
1415+
}
1416+
return -1;
1417+
}
1418+
1419+
sub vertexDegree {
1420+
my ($self, $vertex) = @_;
1421+
my $degree = 0;
1422+
for my $j (0 .. $#{ $self->{adjacencyMatrix} }) {
1423+
++$degree if $self->{adjacencyMatrix}[$vertex][$j];
1424+
}
1425+
return $degree;
1426+
}
1427+
1428+
sub degrees {
1429+
my $self = shift;
1430+
return map { $self->vertexDegree($_) } 0 .. $#{ $self->{adjacencyMatrix} };
1431+
}
1432+
1433+
sub numComponents {
1434+
my $self = shift;
1435+
1436+
my @adjacencyMatrix = map { [@$_] } @{ $self->{adjacencyMatrix} };
1437+
1438+
my $result = @adjacencyMatrix;
1439+
for my $i (0 .. $#adjacencyMatrix) {
1440+
my $connected = 0;
1441+
for my $j ($i + 1 .. $#adjacencyMatrix) {
1442+
if ($adjacencyMatrix[$i][$j] != 0) {
1443+
++$connected;
1444+
for my $k (0 .. $#adjacencyMatrix) {
1445+
$adjacencyMatrix[$j][$k] += $adjacencyMatrix[$i][$k];
1446+
$adjacencyMatrix[$k][$j] += $adjacencyMatrix[$k][$i];
1447+
}
1448+
}
1449+
}
1450+
--$result if $connected > 0;
1451+
}
1452+
return $result;
1453+
}
1454+
1455+
sub edgeWeight {
1456+
my ($self, $i, $j, $weight) = @_;
1457+
if (defined $weight) {
1458+
$self->{adjacencyMatrix}[$i][$j] = $weight;
1459+
$self->{adjacencyMatrix}[$j][$i] = $weight;
1460+
}
1461+
return $self->{adjacencyMatrix}[$i][$j];
1462+
}
1463+
1464+
sub isEqual {
1465+
my ($self, $other) = @_;
1466+
return 0 if eval { $other->isa('GraphTheory::Graph') };
1467+
return 0 if @{ $self->{adjacencyMatrix} } != @{ $other->{adjacencyMatrix} };
1468+
for my $i (0 .. $#{ $self->{adjacencyMatrix} }) {
1469+
return 0 if @{ $self->{adjacencyMatrix}[$i] } != @{ $other->{adjacencyMatrix}[$i] };
1470+
for my $j (0 .. $#{ $self->{adjacencyMatrix}[$i] }) {
1471+
return 0 if $self->{adjacencyMatrix}[$i][$j] != $other->{adjacencyMatrix}[$i][$j];
1472+
}
1473+
}
1474+
return 1;
1475+
}
1476+
1477+
sub image {
1478+
my ($self, %options) = @_;
1479+
1480+
$options{width} //= 220;
1481+
$options{height} //= $options{width};
1482+
$options{showLabels} //= 1;
1483+
1484+
my $plot = main::Plot(
1485+
xmin => -1.5,
1486+
xmax => 1.5,
1487+
ymin => -1.5,
1488+
ymax => 1.5,
1489+
width => $options{width},
1490+
height => $options{height},
1491+
xlabel => '',
1492+
ylabel => ''
1493+
);
1494+
$plot->axes->xaxis(visible => 0);
1495+
$plot->axes->yaxis(visible => 0);
1496+
1497+
my $gap = 2 * $main::PI / @{ $self->{adjacencyMatrix} };
1498+
1499+
for my $i (0 .. $#{ $self->{adjacencyMatrix} }) {
1500+
$plot->add_stamp(cos($i * $gap), sin($i * $gap), color => 'blue');
1501+
1502+
$plot->add_label(
1503+
1.25 * cos($i * $gap), 1.25 * sin($i * $gap),
1504+
label => "\\\\($self->{labels}[$i]\\\\)",
1505+
color => 'blue',
1506+
h_align => 'center',
1507+
v_align => 'middle'
1508+
) if $options{showLabels};
1509+
1510+
for my $j ($i + 1 .. $#{ $self->{adjacencyMatrix} }) {
1511+
if ($self->{adjacencyMatrix}->[$i][$j] != 0) {
1512+
my $vertex1 = [ cos($i * $gap), sin($i * $gap) ];
1513+
my $vertex2 = [ cos($j * $gap), sin($j * $gap) ];
1514+
$plot->add_dataset($vertex1, $vertex2, color => 'black');
1515+
1516+
my ($a, $b) = ($vertex2->[0] - $vertex1->[0], $vertex2->[1] - $vertex1->[1]);
1517+
my $norm = sqrt($a**2 + $b**2);
1518+
1519+
$plot->add_label(
1520+
0.5 * $vertex1->[0] + 0.5 * $vertex2->[0] + $b / $norm * 0.1,
1521+
0.5 * $vertex1->[1] + 0.5 * $vertex2->[1] - $a / $norm * 0.1,
1522+
label => "\\\\($self->{adjacencyMatrix}->[$i][$j]\\\\)",
1523+
color => 'red',
1524+
jsx_options => { fillColor => 'white' }
1525+
) if $options{showWeights};
1526+
}
1527+
}
1528+
}
1529+
1530+
return $plot;
1531+
}
1532+
1533+
sub copy {
1534+
my $self = shift;
1535+
return $self->new($self);
1536+
}
1537+
1538+
sub shuffle {
1539+
my ($self, $permuteLabels) = @_;
1540+
my @shuffledGraph;
1541+
my @vertexPermutation = main::random_subset($self->numVertices, 0 .. $#{ $self->{adjacencyMatrix} });
1542+
for my $i (0 .. $#{ $self->{adjacencyMatrix} }) {
1543+
for my $j (0 .. $#{ $self->{adjacencyMatrix} }) {
1544+
$shuffledGraph[ $vertexPermutation[$i] ][ $vertexPermutation[$j] ] = $self->{adjacencyMatrix}->[$i][$j];
1545+
}
1546+
}
1547+
return $self->new(
1548+
\@shuffledGraph,
1549+
adjacencyMatrixDefinition => 1,
1550+
labels => $permuteLabels ? \(@{ $self->{labels} }[@vertexPermutation]) : $self->{labels}
1551+
);
1552+
}
1553+
1554+
sub nearestNeighborGraph {
1555+
my ($self, $vertex) = @_;
1556+
1557+
my @used;
1558+
$used[$vertex] = 1;
1559+
1560+
my @path = ($vertex);
1561+
my $weight = 0;
1562+
my $currentVertex = $vertex;
1563+
1564+
while (@path < @{ $self->{adjacencyMatrix} }) {
1565+
my $nearest;
1566+
my $min = 0;
1567+
for my $i (0 .. $#{ $self->{adjacencyMatrix} }) {
1568+
next if $i == $currentVertex || defined $used[$i] || $self->{adjacencyMatrix}[$currentVertex][$i] == 0;
1569+
if ($min == 0 || $self->{adjacencyMatrix}[$currentVertex][$i] < $min) {
1570+
$min = $self->{adjacencyMatrix}[$currentVertex][$i];
1571+
$nearest = $i;
1572+
}
1573+
}
1574+
last unless defined $nearest;
1575+
push @path, $nearest;
1576+
$used[$nearest] = 1;
1577+
$weight += $self->{adjacencyMatrix}[$currentVertex][$nearest];
1578+
$currentVertex = $nearest;
1579+
}
1580+
1581+
if ($self->{adjacencyMatrix}[$currentVertex][$vertex]) {
1582+
push @path, $vertex;
1583+
$weight += $self->{adjacencyMatrix}[$currentVertex][$vertex];
1584+
}
1585+
1586+
return (\@path, $weight);
1587+
}
1588+
1589+
sub kruskalGraph {
1590+
my $self = shift;
1591+
1592+
my $graph = $self->copy;
1593+
my $tree = GraphTheory::Graph->new($graph->numVertices, edgeProbability => -1);
1594+
my $numTreeComponents = $tree->numComponents;
1595+
1596+
my $treeWeight = 0;
1597+
1598+
my $weight = 0;
1599+
my @treeweights;
1600+
1601+
my @weights;
1602+
for my $i (0 .. $#{ $graph->{adjacencyMatrix} }) {
1603+
for my $j ($i + 1 .. $#{ $graph->{adjacencyMatrix} }) {
1604+
push(@weights, $graph->{adjacencyMatrix}[$i][$j]) if $graph->{adjacencyMatrix}[$i][$j];
1605+
}
1606+
}
1607+
@weights = main::num_sort(@weights);
1608+
1609+
while (@weights > 0) {
1610+
$weight = shift @weights;
1611+
for my $i (0 .. $#{ $graph->{adjacencyMatrix} }) {
1612+
for my $j ($i + 1 .. $#{ $graph->{adjacencyMatrix} }) {
1613+
if ($graph->{adjacencyMatrix}[$i][$j] == $weight) {
1614+
$graph->edgeWeight($i, $j, 0);
1615+
$tree->edgeWeight($i, $j, $weight);
1616+
my $currentTreeNumComponents = $tree->numComponents;
1617+
if ($currentTreeNumComponents < $numTreeComponents) {
1618+
$numTreeComponents = $currentTreeNumComponents;
1619+
$treeWeight += $weight;
1620+
push @treeweights, $weight;
1621+
} else {
1622+
$tree->edgeWeight($i, $j, 0);
1623+
}
1624+
last;
1625+
}
1626+
}
1627+
}
1628+
}
1629+
1630+
return ($tree, $treeWeight, @treeweights);
1631+
}
1632+
12841633
1;

0 commit comments

Comments
 (0)