# RabbitFarm

### 2023-11-05

#### The Weekly Challenge 241 (Prolog Solutions)

The examples used here are from the weekly challenge problem statement and demonstrate the working solution.

## Part 1

You are given an array (3 or more members) of integers in increasing order and a positive integer. Write a script to find out the number of unique Arithmetic Triplets satisfying the given rules.

### Solution

``````
arithmetic_triplets(Numbers, Difference, TripletCount):-
length(Triplet, 3),
member(I, Triplet),
member(J, Triplet),
member(K, Triplet),
fd_domain(Triplet, Numbers),
fd_all_different(Triplet),
Difference #= J - I,
Difference #= K - J,
I #< J,
J #< K,
findall(Triplet, fd_labeling(Triplet), Triplets),
length(Triplets, TripletCount).
``````

### Sample Run

``````
% gprolog --consult-file prolog/ch-1.p
| ?- arithmetic_triplets([0, 1, 4, 6, 7, 10], 3, TripletCount).

TripletCount = 2 ?

yes
| ?- arithmetic_triplets([4, 5, 6, 7, 8, 9], 2, TripletCount).

TripletCount = 2 ?

yes
| ?-

``````

### Notes

The rules for arithmetic triples are a) i < j < k b) nums[j] - nums[i] == diff and c) nums[k] - nums[j] == diff, where diff is a provided parameter. The code above implements these rules directly, letting Prolog do all the work for us!

## Part 2

You are given an array of unique positive integers greater than 2. Write a script to sort them in ascending order of the count of their prime factors, tie-breaking by ascending value.

### Solution

``````
prime_factors(N, L):-
N > 0,
prime_factors(N, L, 2).
prime_factors(1, [], _):-
!.
prime_factors(N, [F|L], F):-
R is N // F,
N =:= R * F,
!,
prime_factors(R, L, F).
prime_factors(N, L, F):-
next_factor(N, F, NF),
prime_factors(N, L, NF).
next_factor(_, 2, 3):-
!.
next_factor(N, F, NF):-
F * F < N,
!,
NF is F + 2.
next_factor(N, _, N).

kvf_insert_sort(List,Sorted):-
i_sort(List,[],Sorted).

i_sort([],Acc,Acc).
i_sort([H|T],Acc,Sorted):-
kvf_insert(H,Acc,NAcc),
i_sort(T,NAcc,Sorted).

kvf_insert(K0-V0,[K1-V1|T],[K1-V1|NT]):-
V0 > V1,
kvf_insert(K0-V0,T,NT).
kvf_insert(K0-V0,[K1-V1|T],[K0-V0,K1-V1|T]):-
V0 < V1.
kvf_insert(K0-V0,[K1-V1|T],[K1-V1|NT]):-
V0 = V1,
K0 > K1,
kvf_insert(K0-V0,T,NT).
kvf_insert(K0-V0,[K1-V1|T],[K0-V0,K1-V1|T]):-
V0 = V1,
K0 < K1.
kvf_insert(K0-V0, [], [K0-V0]).

write_factor_sorted([K-_|[]]):-
write(K),
nl.
write_factor_sorted([K-_|T]):-
write(K),
write(', '),
write_factor_sorted(T).

factor_counter(Number, Number-FactorCount):-
prime_factors(Number, Factors),
length(Factors, FactorCount).

maplist(factor_counter, Numbers, Factors),
``````

### Sample Run

``````
% gprolog --consult-file prolog/ch-2.p
11, 4, 8, 27

yes
| ?-
``````

### Notes

This code is build mainly from pieces from previous challenges. The prime factorization code is something I've used several times and the modified Insertion Sort is a minor modification of code from TWC 233.

## References

Challenge 241

posted at: 23:23 by: Adam Russell | path: /prolog | permanent link to this entry

#### Recursive Loops and Code Re-Use

The examples used here are from the weekly challenge problem statement and demonstrate the working solution.

## Part 1

You are given an array (3 or more members) of integers in increasing order and a positive integer. Write a script to find out the number of unique Arithmetic Triplets satisfying the given rules.

### Solution

``````
use v5.38;
sub arithmetic_triplets{
my \$counter = 0;
my \$difference = shift;
arithmetic_triplets_r(\$difference, \\$counter, [@_[0 .. @_ -1]], [@_[1 .. @_ -1]], [@_[2 .. @_ -1]]);
return \$counter;
}

sub arithmetic_triplets_r{
my \$difference = \$_[0];
my \$counter = \$_[1];
my @i = @{\$_[2]};
my @j = @{\$_[3]};
my @k = @{\$_[4]};
if(@i > 0 && @j > 0 && @k > 0){
\$\$counter++ if \$j[0] - \$i[0] == \$difference && \$k[0] - \$j[0] == \$difference;
arithmetic_triplets_r(\$difference, \$counter, [@i], [@j], [@k[1 .. @k - 1]]);
}
elsif(@i > 0 && @k == 0 && @j > 0){
arithmetic_triplets_r(\$difference, \$counter, [@i], [@j[1 .. @j - 1]], [@j[2 .. @j - 1]]);
}
elsif(@i > 0 && @k == 0 && @j == 0){
arithmetic_triplets_r(\$difference, \$counter, [@i[1 .. @i - 1]], [@i[2 .. @i - 1]], [@i[3 .. @i - 1]]);
}
}

MAIN:{
my \$difference;
\$difference = 3;
say arithmetic_triplets \$difference, 0, 1, 4, 6, 7, 10;
\$difference = 2;
say arithmetic_triplets \$difference, 4, 5, 6, 7, 8, 9;
}

``````

### Sample Run

``````
\$ perl perl/ch-1.pl
2
2
``````

### Notes

The rules for arithmetic triples are a) i < j < k b) nums[j] - nums[i] == diff and c) nums[k] - nums[j] == diff, where diff is a provided parameter. The code above implements these rules somewhat in the obvious way, looping thricely over the list, but recursively.

## Part 2

You are given an array of unique positive integers greater than 2. Write a script to sort them in ascending order of the count of their prime factors, tie-breaking by ascending value.

### Solution

``````
use v5.38;
sub prime_factor{
my \$x = shift(@_);
my @factors;
for (my \$y = 2; \$y <= \$x; \$y++){
next if \$x % \$y;
\$x /= \$y;
push @factors, \$y;
redo;
}
return @factors;
}

sub prime_order{
my %factor_i = map{(\$_, 0 + prime_factor(\$_))} @_;
my \$factor_sorter = sub{
my \$c = \$factor_i{\$a} <=> \$factor_i{\$b};
return \$c unless !\$c;
return \$a <=> \$b;
};
return sort \$factor_sorter @_;
}

MAIN:{
say join q/, /, prime_order 11, 8, 27, 4;
}
``````

### Sample Run

``````
\$ perl perl/ch-2.pl
11, 4, 8, 27
``````

### Notes

This code borrows from two previous challenges: The prime factor code has been used several times, but in this case I referred to the Attractive Number challenge from TWC 041. The sorting is a variant of the frequency sort from TWC 233. If you write enough code you don't need GitHub Copilot, you can just re-use your own work!

## References

Challenge 241

posted at: 18:19 by: Adam Russell | path: /perl | permanent link to this entry