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.

Peter's discussion of the '10001st Prime Number' task is not be missed IMHO. Thank you Peter for your contributions..

This review may cover either or both challenges for this week.

Try it 

#!/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];
    }
}
 
    

17 lines of code

Output from script

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