- Added solutions by Ulrich Rieke.

4 files changed, 210 insertions, 0 deletions

diff --git a/challenge-107/ulrich-rieke/haskell/ch-1.hs b/challenge-107/ulrich-rieke/haskell/ch-1.hs
new file mode 100644
index 0000000000..5785f6cb97
--- /dev/null
+++ b/challenge-107/ulrich-rieke/haskell/ch-1.hs
@@ -0,0 +1,39 @@
+module Challenge107
+  where
+import Data.Char ( intToDigit , digitToInt )
+import Data.List ( ( !! ) )
+
+theDigits ::[Char]
+theDigits = map intToDigit [0..9]
+
+isSelfDescriptive :: String -> Bool
+isSelfDescriptive number = (all firstCondition number) && ( all secondCondition $
+zip [0 .. length number - 1 ] number )
+  where
+  firstCondition :: Char -> Bool
+  firstCondition c = elem c theDigits
+  secondCondition :: (Int, Char) -> Bool
+  secondCondition ( i , c ) = count (intToDigit i ) number == digitToInt ( number !! i )
+
+count :: Ord a => a -> [a] -> Int
+count d [] = 0 ;
+count d (x:xs)
+  |d == x = 1 + count d xs
+  |otherwise = count d xs
+
+isValidNumber :: String -> Int -> Bool
+isValidNumber n base = (all (\i -> i < base ) $ map digitToInt n ) && ( length n
+== base )
+
+findValidNumbers :: Int -> [String]
+findValidNumbers base = filter (\i -> isValidNumber i base) numberlist
+where
+  start :: Int
+  start = read ( "1" ++ (take ( base - 1 ) $ repeat '0' ))
+  end :: Int
+  end = read ( map intToDigit $ take base  $ repeat (base - 1) )
+  numberlist :: [String]
+  numberlist = map show [start .. end]
+
+solution :: [Int] -> [String]
+solution bases = filter isSelfDescriptive $ concat $ map(\b -> findValidNumbers b) bases
diff --git a/challenge-107/ulrich-rieke/perl/ch-1.pl b/challenge-107/ulrich-rieke/perl/ch-1.pl
new file mode 100644
index 0000000000..ba72ded613
--- /dev/null
+++ b/challenge-107/ulrich-rieke/perl/ch-1.pl
@@ -0,0 +1,81 @@
+#!/usr/bin/perl ;
+use strict ;
+use warnings ;
+use feature 'say' ;
+
+sub isSelfDescriptive {
+  my $number = shift ;
+  my $len = length $number ;
+  for my $pos (0 .. $len - 1 ) {
+      if ( substr( $number, $pos , 1 ) != myCount( $pos , $number ) ) {
+    return 0 ;
+      }
+  }
+  return 1 ;
+}
+
+sub myCount {
+  my $num = shift ;
+  my $numberstring = shift ;
+  my $count = 0 ;
+  my $len = length $numberstring ;
+  my $found = index( $numberstring , $num , 0 ) ;
+  while ( $found != -1 ) {
+      $count++ ;
+      if ( $found + 1 < $len ) {
+    $found = index( $numberstring , $num , $found + 1 ) ;
+      }
+      else {
+    last ;
+      }
+  }
+  return $count ;
+}
+
+#function addOne adds 1 to a number in a given base. We have to consider that
+#the maximum digit in the number string must be b - 1 if b is the base
+#due to a lack of formal conversion functions in Perl I allow myself to limit
+#the search up to and including base 10
+sub addOne {
+  my $base = shift ;
+  my $number = shift ;
+  my $reversed = reverse $number ;
+  my $i = 0 ;
+  while ( (substr( $reversed , $i , 1 ) + 0) == $base - 1 ) {
+      $i++ ;
+      if ( $i == $base ) {
+    $number = '0' x $base  ;
+    return $number ;
+      }
+  }
+  substr( $reversed , $i , 1 ) = (substr( $reversed , $i , 1 ) + 1) . '' ;
+#set any previous positions to 0
+  if ( $i > 0 ) {
+      for my $j ( 0 .. $i - 1 ) {
+    substr( $reversed , $j , 1 ) = '0' ;
+      }
+  }
+  return reverse $reversed ;
+}
+
+say "Enter a base ( 4 is minimum!) " ;
+my $base = <STDIN> ;
+chomp $base ;
+while ( $base < 4 ) {
+  say "The base must be greater than or equal to 4! Re-enter base!" ;
+  $base = <STDIN> ;
+  chomp $base ;
+}
+my $current = '1' . ('0' x ( $base - 1 ) ) ;
+my @selfDescriptives ;
+while ( scalar @selfDescriptives < 3 ) {
+  $current = addOne( $base, $current ) ;
+  if ( $current eq ('0' x $base ) ) {
+      $base++ ;
+      $current = '1' . ( '0' x ( $base - 1 ) ) ;
+  }
+  if ( isSelfDescriptive( $current )) {
+      push @selfDescriptives, $current ;
+  }
+}
+say join( ", " , @selfDescriptives) ;
diff --git a/challenge-107/ulrich-rieke/raku/ch-1.raku b/challenge-107/ulrich-rieke/raku/ch-1.raku
new file mode 100644
index 0000000000..d8aa7dfec5
--- /dev/null
+++ b/challenge-107/ulrich-rieke/raku/ch-1.raku
@@ -0,0 +1,61 @@
+use v6 ;
+
+sub isSelfDescriptive( Str $number --> Bool ) {
+  my $len = $number.chars ;
+  for (0 .. $len - 1 ) -> $pos {
+      if ( $number.substr( $pos, 1 ).Int != myCount( $pos , $number ) ) {
+    return False ;
+      }
+  }
+  return True ;
+}
+
+sub myCount( Int $num, Str $numberstring --> Int ) {
+  my $str = $num.Str ;
+  my $len = $numberstring.chars ;
+  my $count = 0 ;
+  my $found = $numberstring.index( $str , 0 ) ;
+  while ( defined $found ) {
+      $count++ ;
+      if ( $found + 1 < $len ) {
+    $found = $numberstring.index( $str , $found + 1 ) ;
+      }
+      else {
+    last ;
+      }
+  }
+  return $count ;
+}
+
+sub addOne( Int $base , Str $number --> Str ) {
+  if ( $base != 10 ) {
+      my $num = $number.parse-base( $base );
+      return (++$num).base( $base ) ;
+  }
+  else {
+      my $num = +$number ;
+      return (++$num).Str ;
+  }
+}
+
+say "For which base do you want to generate the first self-descriptive numbers ?" ;
+say "It should be a number greater than or equal 4!" ;
+my $base = $*IN.get.Int ;
+while ( $base < 4 ) {
+  say "The base should at least be 4! Re-enter base!" ;
+  $base = $*IN.get.Int ;
+}
+my @selfDescriptives ;
+my $current = "1" ~ ('0' x ( $base - 1 ) ) ;
+repeat {
+  $current = addOne( $base , $current ) ;
+  if ( isSelfDescriptive( $current )) {
+      @selfDescriptives.push( $current ) ;
+  }
+  if ( $current.chars > $base ) { #there may not be 3 self descriptive numbers in a
+#given base
+    $base++ ;
+    $current = "1" ~ ('0' x ( $base - 1 ) ) ;
+  }
+} until ( @selfDescriptives.elems == 3 ) ;
+say @selfDescriptives ;
diff --git a/challenge-107/ulrich-rieke/raku/ch-2.raku b/challenge-107/ulrich-rieke/raku/ch-2.raku
new file mode 100644
index 0000000000..6c907d97f6
--- /dev/null
+++ b/challenge-107/ulrich-rieke/raku/ch-2.raku
@@ -0,0 +1,29 @@
+use v6 ;
+
+class Stack {
+  has Mu @!elements ;
+
+  method top(--> Mu ) {
+      return @!elements[0] ;
+  }
+
+  method pop(--> Mu ) {
+      return @!elements.shift ;
+  }
+
+  method push( Mu $data ) {
+      @!elements.unshift( $data ) ;
+  }
+
+  method min(--> Mu ) {
+      return @!elements.min ;
+  }
+
+  method isEmpty(--> Bool ) {
+      return @!elements.elems == 0 ;
+  }
+}
+
+my Stack $st .= new ;
+say "The methods of class Stack are " ~ $st.^methods.map( {.gist}).join(", ")
+~ " !";