Task — Curious fraction tree

Consider the following Curious Fraction Tree:

           1
           -
           1
        /     \
    1           2
    -           -
    2           1
   / \         / \
 1     3     2     3
 -     -     -     -
 3     2     3     1
 /\    /\    /\    /\ 
1  4  3  5  2  5  3  4
-  -  -  -  -  -  -  -
4  3  5  2  5  3  4  1

Examples

Example 1:
    Input: $member = '3/5';
    Output: parent = '3/2' and grandparent = '1/2'

Example 2:
    Input: $member = '4/3';
    Output: parent = '1/3' and grandparent = '1/2'

Analysis

By inspection, the relationship between parent and children is as follows:

• The left child of parent a/b is a/(a+b)
• The right child is (a+b)/b.

It follows that if a member is < 1 then it is a left child and if > 1 then a right child. From that, the solution is fairly trivial and no doubt someone will come up with a one-liner.

But do all values for (positive integer) a and b occur in the tree? The answer is no: although it may be possible to calculate parent and grandparents for a given a/b, it does not follow that there is a path back to the root 1/1. In fact, I think that a and b have to be mutually prime - ie share no prime factor - for a/b to appear in the tree.

Try it 

Script

#!/usr/bin/perl

# Peter Campbell Smith - 2022-01-04
# PWC 146 task 2

use v5.28;
use warnings;
use strict;

my (@given, $given, $a, $b, $pa, $pb, $ga, $gb);

@given = ('3/5', '4/3', '13/20', '1/2', '456/777', '777/456', '144/781', '14/14');

# loop over given children
for $given (@given) {
    ($a, $b) = split /\//, $given;
     
    # find the parents and grandparents
    ($pa, $pb) = parents($a, $b);
    ($ga, $gb) = parents($pa, $pb);
    
    # show result
    speak("$a/$b", '     parent', $pa, $pb);
    speak("$a/$b", 'grandparent', $ga, $gb);
    say '';
}
 
sub parents {
 
    my ($a, $b, $pa, $pb);
 
    # as described above
    ($a, $b) = @_;
    if ($a / $b < 1) {   # a left child
        $pa = $a;
        $pb = $b - $a;
    } else {             # a right child
        $pa = $a - $b;
        $pb = $b;
    }
    
    # not a member if pa or pb calculates as 0 or if a == b and a != 1
    return (-1, -1) if ($pa == 0 or $pb == 0 or ($pa == $pb and $pa != 1));
    return ($pa, $pb);
}

sub speak {
    
    my ($child, $relation, $a, $b) = @_;
    if ($a > 0) {
        say qq[The $relation of $child is $a/$b];
    } else {
        say qq[The $relation of $child does not exist];
    }
}
 
    

Output

The      parent of 3/5 is 3/2
The grandparent of 3/5 is 1/2

The      parent of 4/3 is 1/3
The grandparent of 4/3 is 1/2

The      parent of 13/20 is 13/7
The grandparent of 13/20 is 6/7

The      parent of 1/2 is 1/1
The grandparent of 1/2 does not exist

The      parent of 456/777 is 456/321
The grandparent of 456/777 is 135/321

The      parent of 777/456 is 321/456
The grandparent of 777/456 is 321/135

The      parent of 144/781 is 144/637
The grandparent of 144/781 is 144/493

The      parent of 14/14 does not exist
The grandparent of 14/14 does not exist