diff options
| author | Mohammad Sajid Anwar <Mohammad.Anwar@yahoo.com> | 2023-11-06 00:03:27 +0000 |
|---|---|---|
| committer | GitHub <noreply@github.com> | 2023-11-06 00:03:27 +0000 |
| commit | 18c9c1bc16236fcdfd36b40e8e9a56ea4c97007b (patch) | |
| tree | d94a6a06b32a52a121a041e2600df9952693f515 | |
| parent | a0fa2d12a08b37c28550d4b672b7da6bf73de5f3 (diff) | |
| parent | 85c8d7ba78838ff3e8705c9f647d194891ed05ae (diff) | |
| download | perlweeklychallenge-club-18c9c1bc16236fcdfd36b40e8e9a56ea4c97007b.tar.gz perlweeklychallenge-club-18c9c1bc16236fcdfd36b40e8e9a56ea4c97007b.tar.bz2 perlweeklychallenge-club-18c9c1bc16236fcdfd36b40e8e9a56ea4c97007b.zip | |
Merge pull request #9005 from adamcrussell/challenge-241
Challenge 241
| -rw-r--r-- | challenge-241/adam-russell/blog.txt | 1 | ||||
| -rw-r--r-- | challenge-241/adam-russell/blog1.txt | 1 | ||||
| -rw-r--r-- | challenge-241/adam-russell/perl/ch-1.pl | 41 | ||||
| -rw-r--r-- | challenge-241/adam-russell/perl/ch-2.pl | 31 | ||||
| -rw-r--r-- | challenge-241/adam-russell/prolog/ch-1.p | 21 | ||||
| -rw-r--r-- | challenge-241/adam-russell/prolog/ch-2.p | 58 |
6 files changed, 153 insertions, 0 deletions
diff --git a/challenge-241/adam-russell/blog.txt b/challenge-241/adam-russell/blog.txt new file mode 100644 index 0000000000..1fe8815a02 --- /dev/null +++ b/challenge-241/adam-russell/blog.txt @@ -0,0 +1 @@ +http://rabbitfarm.com/cgi-bin/blosxom/perl/2023/11/05
\ No newline at end of file diff --git a/challenge-241/adam-russell/blog1.txt b/challenge-241/adam-russell/blog1.txt new file mode 100644 index 0000000000..8c8d81b849 --- /dev/null +++ b/challenge-241/adam-russell/blog1.txt @@ -0,0 +1 @@ +http://rabbitfarm.com/cgi-bin/blosxom/prolog/2023/11/05
\ No newline at end of file diff --git a/challenge-241/adam-russell/perl/ch-1.pl b/challenge-241/adam-russell/perl/ch-1.pl new file mode 100644 index 0000000000..25b5b7d4bb --- /dev/null +++ b/challenge-241/adam-russell/perl/ch-1.pl @@ -0,0 +1,41 @@ +use v5.38; +## +# 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 following rules: +# a) i < j < k +# b) nums[j] - nums[i] == diff +# c) nums[k] - nums[j] == diff +## +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; +} diff --git a/challenge-241/adam-russell/perl/ch-2.pl b/challenge-241/adam-russell/perl/ch-2.pl new file mode 100644 index 0000000000..386ad810a5 --- /dev/null +++ b/challenge-241/adam-russell/perl/ch-2.pl @@ -0,0 +1,31 @@ +use v5.38; +## +# 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. +## +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; +} diff --git a/challenge-241/adam-russell/prolog/ch-1.p b/challenge-241/adam-russell/prolog/ch-1.p new file mode 100644 index 0000000000..3a415a2fb0 --- /dev/null +++ b/challenge-241/adam-russell/prolog/ch-1.p @@ -0,0 +1,21 @@ +arithmetic_triplets(Numbers, Difference, TripletCount):- + [X, Y, Z|T] = Numbers, + arithmetic_triplets([X, Y, Z|T], [Y, Z|T], [Z|T], Difference, TripletCount). +arithmetic_triplets([], [], [], _, 0). +arithmetic_triplets(I, [_|J], [], Difference, TripletCount):- + [_|K] = J, + arithmetic_triplets(I, J, K, Difference, TripletCount). +arithmetic_triplets([_|I], [], [], Difference, TripletCount):- + [_|J] = I, + [_|K] = J, + arithmetic_triplets(I, J, K, Difference, TripletCount). +arithmetic_triplets([IH|I], [JH|J], [KH|K], Difference, TripletCount):- + Difference #= JH - IH, + Difference #= KH - JH, + arithmetic_triplets([IH|I], [JH|J], K, Difference, TripletCountNext), + succ(TripletCountNext, TripletCount). +arithmetic_triplets([IH|I], [JH|J], [KH|K], Difference, TripletCount):- + (Difference #\= JH - IH; Difference #\= KH - JH), + arithmetic_triplets([IH|I], [JH|J], K, Difference, TripletCountNext), + TripletCount is TripletCountNext + 0. + diff --git a/challenge-241/adam-russell/prolog/ch-2.p b/challenge-241/adam-russell/prolog/ch-2.p new file mode 100644 index 0000000000..1b267a5ccc --- /dev/null +++ b/challenge-241/adam-russell/prolog/ch-2.p @@ -0,0 +1,58 @@ +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). + +factor_sorter(Numbers, FactorsSorted):- + maplist(factor_counter, Numbers, Factors), + kvf_insert_sort(Factors, FactorsSorted).
\ No newline at end of file |
