14 files changed, 458 insertions, 0 deletions
diff --git a/challenge-097/e-choroba/perl/ch-1.pl b/challenge-097/e-choroba/perl/ch-1.pl
new file mode 100755
index 0000000000..39e7eefd4e
--- /dev/null
+++ b/challenge-097/e-choroba/perl/ch-1.pl
@@ -0,0 +1,22 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+my $ALPHABET = join "", 'A' .. 'Z';
+sub caesar_cipher {
+    my ($s, $n) = @_;
+    $n %= 26;
+    my $key = $ALPHABET;
+    substr $key, 0, 0, substr $key, -$n, $n, "";
+    eval "\$s =~ tr/$ALPHABET/$key/";
+    return $s
+}
+
+use Test::More tests => 3;
+
+is caesar_cipher('THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG', 3),
+    'QEB NRFZH YOLTK CLU GRJMP LSBO QEB IXWV ALD',
+    'Example';
+
+is caesar_cipher('ZABC', 54), 'XYZA', 'N>26';
+is caesar_cipher('YZAB', -1), 'ZABC', 'N<0';
diff --git a/challenge-097/e-choroba/perl/ch-2.pl b/challenge-097/e-choroba/perl/ch-2.pl
new file mode 100755
index 0000000000..d54fb97539
--- /dev/null
+++ b/challenge-097/e-choroba/perl/ch-2.pl
@@ -0,0 +1,64 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+use List::Util qw{ sum };
+
+sub brute_force {
+    my ($binary, $size) = @_;
+    my @strings = $binary =~ /(.{$size})/g;
+    die "Can't split evenly" unless @strings * $size == length $binary;
+
+    my $same = 0 x $size;
+    my $best = $size * @strings;
+    until ($size < length $same) {
+        my $flips = sum(map { ($_ ^ $same) =~ tr/\x01// } @strings);
+        $best = $flips if $flips < $best;
+        $same = sprintf "%0${size}b", 1 + oct "b$same";
+    }
+    return $best
+}
+
+sub by_pos {
+    my ($binary, $size) = @_;
+    my @strings = $binary =~ /(.{$size})/g;
+    die "Can't split evenly" unless @strings * $size == length $binary;
+
+    my $sum = 0;
+    for my $pos (0 .. $size - 1) {
+        my $ones += grep { substr $_, $pos, 1 } @strings;
+        $sum += $ones > @strings / 2 ? @strings - $ones : $ones;
+    }
+    return $sum
+}
+
+use Test::More;
+
+for my $example (['101100101', 3, 1],
+                 ['10110111', 4, 2],
+                 ['0000000101101011', 2, 6],
+                 ['000000101010111000110011001111110101', 6, 16],
+                 ['000111111', 3, 3],
+                 ['00000001001001001000', 4, 4],
+                 ['0000100011101010', 4, 4]
+){
+    is by_pos(@$example[0, 1]), $example->[-1];
+    is by_pos(@$example), brute_force(@$example);
+}
+
+my $long = '101010101000100010010010111100010010101010101101001010100010101';
+is brute_force($long, 3), by_pos($long, 3);
+
+done_testing();
+
+use Benchmark qw{ cmpthese };
+
+cmpthese(-3, {
+    brute_force => sub { brute_force($long, 3) },
+    by_pos      => sub { by_pos($long, 3) },
+});
+
+__END__
+               Rate brute_force      by_pos
+brute_force 24884/s          --        -69%
+by_pos      80637/s        224%          --
diff --git a/challenge-097/gustavo-chaves/perl/ch-1.pl b/challenge-097/gustavo-chaves/perl/ch-1.pl
new file mode 100755
index 0000000000..11a2d2f608
--- /dev/null
+++ b/challenge-097/gustavo-chaves/perl/ch-1.pl
@@ -0,0 +1,21 @@
+#!/usr/bin/env perl
+
+# https://perlweeklychallenge.org/blog/perl-weekly-challenge-097/
+# TASK #1 › Caesar Cipher
+
+use 5.030;
+use warnings;
+
+my ($N, $S) = @ARGV;
+
+# ($N, $S) = (3, "THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG");
+
+my $alphabet = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
+my $caesar = substr($alphabet, -$N) . substr($alphabet, 0, length($alphabet) - $N);
+
+$alphabet .= lc $alphabet;
+$caesar .= lc $caesar;
+
+for ($S) {
+    say eval "tr/$alphabet/$caesar/r";
+}
diff --git a/challenge-097/gustavo-chaves/perl/ch-2.pl b/challenge-097/gustavo-chaves/perl/ch-2.pl
new file mode 100755
index 0000000000..bad7ffa917
--- /dev/null
+++ b/challenge-097/gustavo-chaves/perl/ch-2.pl
@@ -0,0 +1,36 @@
+#!/usr/bin/env perl
+
+# https://perlweeklychallenge.org/blog/perl-weekly-challenge-097/
+# TASK #2 › Binary Substrings
+
+use 5.030;
+use warnings;
+use List::AllUtils qw(sum0 pairwise reduce);
+
+my ($B, $S) = @ARGV;
+
+# ($B, $S) = qw(101100101 3);
+# ($B, $S) = qw(10110111 4);
+
+length($B) % $S == 0
+    or die "The length of the string '$B' must be a multiple of $S\n";
+
+my @substrings = $B =~ /(.{$S})/g;
+
+my (@distance, @flips);
+
+# Calculate the distances between each pair of substrings and the total number
+# of flips to change all of them to be equal to each one.
+for my $i (0 .. $#substrings) {
+    my @from = split //, $substrings[$i];
+    for my $j (0 .. $#substrings) {
+        my @to = split //, $substrings[$j];
+        $distance[$i][$j] = sum0 pairwise {$a != $b} @from, @to;
+    }
+    $flips[$i] = sum0 @{$distance[$i]};
+}
+
+# Find the index of the substring which requires the minimum number of flips.
+my $i = reduce {$flips[$a] < $flips[$b] ? $a : $b} 0 .. $#flips;
+
+say "$flips[$i] to make all substrings equal to '$substrings[$i]' ($i)";
diff --git a/challenge-097/stuart-little/haskell/ch-1.hs b/challenge-097/stuart-little/haskell/ch-1.hs
new file mode 100755
index 0000000000..6dbe278140
--- /dev/null
+++ b/challenge-097/stuart-little/haskell/ch-1.hs
@@ -0,0 +1,18 @@
+#!/usr/bin/env runghc
+
+-- run <script> <quoted string> <number>
+
+import Data.Char (ord,chr,)
+import System.Environment (getArgs,)
+
+shiftCaps :: Int -> Char -> Char
+shiftCaps n c
+  |elem c ['A'..'Z'] = chr $ ord 'A' + mod ((ord c -ord 'A') - (mod n 26)) 26
+  |otherwise =c   
+
+rot :: Int -> String -> String
+rot n str = map (shiftCaps n) str
+
+main = do
+  (str,shift) <- getArgs >>= return.(\(x:y:_)->(x,(read::String->Int) y))
+  putStrLn $ rot shift str
diff --git a/challenge-097/stuart-little/haskell/ch-2.hs b/challenge-097/stuart-little/haskell/ch-2.hs
new file mode 100755
index 0000000000..d8b0afe2f8
--- /dev/null
+++ b/challenge-097/stuart-little/haskell/ch-2.hs
@@ -0,0 +1,22 @@
+#!/usr/bin/env runghc
+
+-- run <script> <binary string> <number>
+
+import Data.List (transpose,elemIndices)
+import Data.List.Extra (maximumOn)
+import Data.List.Split (chunksOf)
+import System.Environment (getArgs)
+
+mostOccsTgt :: Eq a => [[a]] -> [a]
+mostOccsTgt xss = map (\ys -> maximumOn (length . (flip elemIndices ys)) ys) $ transpose xss
+
+nrFlips :: Eq a => [a] -> [[a]] -> Int
+nrFlips tgt strs = sum $ map (\s -> length $ filter (\(p,q)-> p/=q) $ zip tgt s) strs
+
+main = do
+  (bin,nr) <- getArgs >>= return.(\(x:y:_)-> (x,(read::String->Int) y))
+  let bins = chunksOf nr bin
+      tgt = mostOccsTgt bins
+  putStrLn $ "Initial binary words:\n" ++ (unlines bins)
+  putStrLn $ "Target string: " ++ tgt
+  putStrLn $ "Need to flip " ++ (show $ nrFlips tgt bins) ++ " position(s)."
diff --git a/challenge-097/ulrich-rieke/cpp/ch-1.cpp b/challenge-097/ulrich-rieke/cpp/ch-1.cpp
new file mode 100644
index 0000000000..d69135b4cc
--- /dev/null
+++ b/challenge-097/ulrich-rieke/cpp/ch-1.cpp
@@ -0,0 +1,35 @@
+#include <iostream>
+#include <cstdlib>
+#include <string>
+#include <algorithm>
+#include <iterator>
+
+char findCipher( char c, int shift ) {
+  static const std::string alphabet {"ABCDEFGHIJKLMNOPQRSTUVWXYZ"} ;
+  std::string mapped { alphabet.substr(26 - shift) } ;
+  std::reverse ( mapped.begin( ) , mapped.end( ) ) ;
+  mapped.append( alphabet.substr(0 , 26 - shift ) ) ;
+  if ( c == ' ' )
+      return ' ' ;
+  else {
+      auto found = std::find( alphabet.begin( ) , alphabet.end( ) , c );
+      return mapped[ static_cast<int>(std::distance(alphabet.begin( ), found))] ;
+  }
+}
+
+int main( int i , char* argv[ ] ) {
+  if ( i != 3 ) {
+      std::cerr << "usage: challenge097 <capital letter string> <leftshift>!\n" ;
+      return 1 ;
+  }
+  int leftshift = std::atoi( argv[ 2 ] ) ;
+  int realshift = leftshift % 26 ;
+  std::string plaintext( argv[ 1 ] ) ;
+  int len = plaintext.length( ) ;
+  std::string ciphertext ;
+  for ( char letter : plaintext ) {
+      ciphertext.push_back( findCipher ( letter , realshift ) ) ;
+  }
+  std::cout << ciphertext << std::endl ;
+  return 0 ;
+}
diff --git a/challenge-097/ulrich-rieke/cpp/ch-2.cpp b/challenge-097/ulrich-rieke/cpp/ch-2.cpp
new file mode 100644
index 0000000000..7fa22ce546
--- /dev/null
+++ b/challenge-097/ulrich-rieke/cpp/ch-2.cpp
@@ -0,0 +1,64 @@
+#include <iostream>
+#include <string>
+#include <vector>
+#include <map>
+#include <cstdlib>
+#include <algorithm>
+#include <numeric>
+
+bool isInputValid( const std::string & input , int n ) {
+  return input.length( ) % n == 0 ;
+}
+
+//how many digits must be changed to make them all equal
+int countToMakeAllEqual( const std::string & input ) {
+  std::map<std::string , int> frequencies ;
+  frequencies["0"] = 0 ;
+  frequencies["1"] = 0 ;
+  int len = input.length( ) ;
+  for ( int i = 0 ; i < len ; i++ ) {
+      frequencies[ input.substr( i , 1 )]++ ;
+  }
+  if ( frequencies[ "0" ] == len || frequencies[ "1" ] == len )
+      return 0 ;
+  int bigger = std::max( frequencies["0"] , frequencies[ "1" ] ) ;
+  return len - bigger ;
+}
+
+int main( int argc, char * argv[ ] ) {
+  if ( argc != 3 ) {
+      std::cerr << "There should be 2 arguments, call <challenge097_2> <string> <number>!" ;
+      return 1 ;
+  }
+  std::string input( argv[ 1 ] ) ;
+  int blocks { std::atoi( argv[ 2 ] ) } ;
+  if ( ! isInputValid( input , blocks ) ) {
+      std::cerr << "the number of digits in the binary string should be a multiple of " ;
+      std::cerr << blocks << " !" << std::endl ;
+      return 2 ;
+  }
+  int len = input.length( ) ;
+  int chunknumber = len / blocks ;
+  int chunklength { len / chunknumber } ;
+  std::vector<std::string> words ;
+  //for all blocks to be equal we transpose the blocks, that is the first letters
+  //of every block form a word, the second letters and so on
+  //we then see how many digits have to be flipped to make all digits equal
+  std::string transposed ;
+  for ( int i = 0 ; i < chunklength ; i++ ) {
+      for ( int j = 0 ; j < chunknumber ; j++ ) {
+    transposed.append( input.substr( i + j * chunklength , 1 ) ) ;
+    if ( transposed.length( ) == chunknumber ) {
+        words.push_back( transposed ) ;
+        transposed.clear( ) ;
+    }
+      }
+  }
+  std::vector<int> alterations ;
+  for ( std::string & word : words ) {
+      alterations.push_back( countToMakeAllEqual( word ) ) ;
+  }
+  std::cout << std::accumulate( alterations.begin( ) , alterations.end( ) , 0 )
+      << std::endl ;
+  return 0 ;
+}
diff --git a/challenge-097/ulrich-rieke/haskell/ch-1.hs b/challenge-097/ulrich-rieke/haskell/ch-1.hs
new file mode 100644
index 0000000000..a47e593861
--- /dev/null
+++ b/challenge-097/ulrich-rieke/haskell/ch-1.hs
@@ -0,0 +1,17 @@
+module Challenge097
+  where
+import Data.Maybe( fromJust )
+
+caesarencode :: String -> Int -> String
+caesarencode plain leftshift = map (\c -> if c /= ' ' then fromJust $ lookup c
+mappedPairs else ' ') plain
+where
+  alfabet :: [Char]
+  alfabet = ['A' .. 'Z']
+  realshift :: Int
+  realshift = mod leftshift ( length alfabet )
+  leftRotated :: [Char]
+  leftRotated = (take realshift $ reverse alfabet) ++ take ( length alfabet -
+    realshift ) alfabet
+  mappedPairs :: [(Char , Char)]
+  mappedPairs = zip alfabet leftRotated
diff --git a/challenge-097/ulrich-rieke/haskell/ch-2.hs b/challenge-097/ulrich-rieke/haskell/ch-2.hs
new file mode 100644
index 0000000000..95adceaa76
--- /dev/null
+++ b/challenge-097/ulrich-rieke/haskell/ch-2.hs
@@ -0,0 +1,27 @@
+module Challenge097_2
+  where
+import Data.List ( transpose )
+import qualified Data.Text as T
+
+solution :: String -> Int -> Int
+solution binarystring blocks =
+  let strlen = length binarystring
+      chunknumber = div strlen blocks
+      chunksize = div strlen chunknumber
+      chunks = map T.unpack $ T.chunksOf chunksize $ T.pack binarystring
+      myWords = transpose chunks
+      toBeFlipped = map findFlips myWords
+  in sum toBeFlipped
+
+count :: Char -> String -> Int
+count c str = length $ filter ( c == ) str
+
+findFlips :: String -> Int
+findFlips  str
+  |zeroes >= ones = length str - zeroes
+  |otherwise = length str - ones
+  where
+      zeroes :: Int
+      zeroes = count '0' str
+      ones :: Int
+      ones = count '1' str
diff --git a/challenge-097/ulrich-rieke/perl/ch-1.pl b/challenge-097/ulrich-rieke/perl/ch-1.pl
new file mode 100644
index 0000000000..52cf4e6646
--- /dev/null
+++ b/challenge-097/ulrich-rieke/perl/ch-1.pl
@@ -0,0 +1,25 @@
+#!/usr/bin/perl ;
+use strict ;
+use warnings ;
+use feature 'say' ;
+
+sub findMapped {
+  my $letter = shift ;
+  my $n = shift ;
+  if ( $letter eq ' ' ) {
+      return ' ' ;
+  }
+  else {
+      my $num = ord( $letter ) - $n ;
+      if ( $num < 65 ) { #this is A, we must wrap to the end of the alphabet
+    $num = 90 - ( 65 - $num ) + 1 ;
+      }
+      return chr $num ;
+  }
+}
+
+my $S = $ARGV[ 0 ] ;
+my $N = $ARGV[ 1 ] ;
+my $num = $N % 26 ; #if a number greater than the number of letters is ent.
+die "String $S should only consist of capital letters" unless ($S =~ /^[A-Z ]+$/) ;
+say join( '' , map { findMapped( $_ , $num ) } split( // , $S ) ) ;
diff --git a/challenge-097/ulrich-rieke/perl/ch-2.pl b/challenge-097/ulrich-rieke/perl/ch-2.pl
new file mode 100644
index 0000000000..68f94621cb
--- /dev/null
+++ b/challenge-097/ulrich-rieke/perl/ch-2.pl
@@ -0,0 +1,43 @@
+#!/usr/bin/perl ;
+use strict ;
+use warnings ;
+use feature 'say' ;
+use List::Util qw( sum ) ;
+
+sub countToMakeAllEqual {
+  my $str = shift ;
+  my %frequencies ;
+  $frequencies{ '0' } = '0' ;
+  $frequencies{ '1' } = '0' ;
+  my $len = length( $str ) ;
+  for my $i ( '0' .. $len - '1' ) {
+      $frequencies{ substr( $str , $i , '1' ) }++ ;
+  }
+  if ( $frequencies{ '0' } == $len or $frequencies{ '1' } == $len ) {
+      return '0' ;
+  }
+  elsif ( $frequencies{ '0' } >= $frequencies{ '1' } ) {
+      return $len - $frequencies{ '0' } ;
+  }
+  else {
+      return $len - $frequencies{ '1' } ;
+  }
+}
+
+my $B = $ARGV[ 0 ] ;
+my $S = $ARGV[ 1 ] ;
+die "The length of $B should be a multiple of $S" unless ( (length $B) % $S == 0 ) ;
+my $len = length( $B ) ;
+my $chunknumber = $len / $S ;
+my $chunklength = $len / $chunknumber ;
+my @chunks ;
+for  my $i ( 0 .. $chunknumber - 1 ) {
+  push (@chunks , substr( $B, $i * $chunklength , $chunklength ) ) ;
+}
+my @words ;
+for my $i ( 0 .. $chunklength - 1 ) {
+  for my $j ( 0 .. $chunknumber - 1 ) {
+      $words[ $i ] .= substr( $chunks[ $j ] , $i , 1 ) ;
+  }
+}
+say sum map { countToMakeAllEqual( $_ ) } @words ;
diff --git a/challenge-097/ulrich-rieke/raku/ch-1.raku b/challenge-097/ulrich-rieke/raku/ch-1.raku
new file mode 100644
index 0000000000..b8aaaf027d
--- /dev/null
+++ b/challenge-097/ulrich-rieke/raku/ch-1.raku
@@ -0,0 +1,12 @@
+use v6 ;
+
+sub MAIN( Str $S, Int $N ) {
+  my @alphabet = ('A' .. 'Z') ;
+  my @ciphers = @alphabet.rotate( -($N mod 26)) ;
+  my %correlations ;
+  %correlations{ ' ' } = ' ' ;
+  for (0 .. 25 ) -> $i {
+      %correlations{ @alphabet[ $i ] } = @ciphers[ $i ] ;
+  }
+  say $S.comb.map( { %correlations{ $_ } } ).join ;
+}
diff --git a/challenge-097/ulrich-rieke/raku/ch-2.raku b/challenge-097/ulrich-rieke/raku/ch-2.raku
new file mode 100644
index 0000000000..3504352f18
--- /dev/null
+++ b/challenge-097/ulrich-rieke/raku/ch-2.raku
@@ -0,0 +1,52 @@
+use v6 ;
+
+sub isInputValid( Str $str , Int $n --> Bool ) {
+  return $str.chars %% $n ;
+}
+
+#how many fields must be flipped to make all digits equal ?
+#we zip the forward and reverse string and count how many pairs
+#have different digits
+sub countToMakeAllEqual( Str $str is copy --> Int ) {
+  my %frequencies ;
+  %frequencies<0> = 0 ;
+  %frequencies<1> = 0 ;
+  my $len = $str.chars ;
+  for ( 0 .. $len - 1 ) -> $i {
+      %frequencies{ $str.substr( $i , 1 ) }++ ;
+  }
+  if ( %frequencies<0> == $len or %frequencies<1> == $len ) {
+      return 0 ;
+  }
+  elsif ( %frequencies<0> >= %frequencies<1> ) {
+      return $len - %frequencies<0> ;
+  }
+  else {
+      return $len - %frequencies<1> ;
+  }
+}
+
+sub MAIN( Str $B is copy, Int $S ) {
+  die "the length of $B should be a multiple of $S!" unless
+      isInputValid( $B , $S ) ;
+  my $len = $B.chars ;
+  my $chunknumber = $len div $S ;
+  my $chunklength = $len div $chunknumber ;
+#we now transpose the chunks, that is the first letters of all chunks
+#go into one word, the second letters into another and so on
+#these transposed chunks should all consist of the same digits in the end
+#word by word we sum up the flips that are necessary to make all digits
+#equal
+#first, we transpose
+  my @chunks ;
+  for (0 .. $chunknumber - 1 ) -> $i {
+      @chunks.push( $B.substr( $i * $chunklength , $chunklength ) ) ;
+  }
+  my @words ;
+  for (0 .. $chunklength - 1 ) -> $i {
+      for (0 .. $chunknumber - 1 ) -> $j {
+    @words[ $i ] ~= @chunks[ $j ].substr( $i , 1 ) ;
+      }
+  }
+  say @words.map( { countToMakeAllEqual( $_ ) } ).sum ;
+}