Rosetta Code Challenge & Wolfram Language

Ideas
,
1

Following the very nice blogpost on the: Wolfram Blog about Rosetta code, it would be very nice if we could expand—as a community—the number of solved tasks on the Rosetta code website for the Mathematica Language.

The unsolved tasks for Mathematica can be found here. The number of tasks remaining is:

  • 145 (june 4th)
  • 141 (june 5th)
  • 133 (june 6th)
  • 130 (june 7th)
  • 128 (june 14th)
  • 125 (june 17th)
  • 120 (june 21st)
  • 119 (july 4th)

Some of the tasks are very easy to implement; others are tricky and very hard (if not impossible).

Just now, I solved a couple of problems:

I hope that we can solve some more problems and quickly reduce this number. Furthermore, I hope to start a lively discussion of problem solving and algorithm implementation. As you know, the Wolfram language is very broad and supports many paradigms, so many tasks can be implemented in multiple ways. You should strive to find the most elegant solution (short code, fast run-time).

Some problems that should not be too hard to solve are:

The tasks that are not implemented can be found using:

url="http://rosettacode.org/wiki/Reports:Tasks_not_implemented_in_Mathematica";
html=Import[url,"XMLObject"];
pos=Position[html,XMLElement["div",{"class"->"mw-content-ltr","dir"->"ltr","lang"->"en"},___]];
pos=First[pos];
data=Extract[html,pos];
pos=Position[data,XMLElement["li",{},{XMLElement["a",{"shape"->"rect","href"->_,"title"->x_},{x_}]}]];
data=Extract[data,pos];
data=data[[All,-1,-1,2]];
data={"title","href"}/.#&/@%;
data[[All,2]]="http://rosettacode.org"<>#&/@data[[All,2]];
data=Hyperlink@@@data;
data//Length
data//Column

Happy solving!

P.S. If you solved a problem after reading this thread, please leave a comment :slight_smile:

8 Likes
Rosetta code + Wolfram language [Episodes 1–5]
Idea for improving Mathematica's Language Rating
Improve cryptanalysis by beginner
2

Here is a start for the Parse an IP Address task, feel free to add/modify:

testcases={"127.0.0.1","127.0.0.1:80","::1","[::1]:80","2605:2700:0:3::4713:93e3","[2605:2700:0:3::4713:93e3]:80"};
ClearAll[ParseIP]
ParseIP[str_String]:=Module[{},
 Which[
  Count[Characters[str],"."]==3,
  Print["IPV4"];
  ,
  Count[Characters[str],":"]>=2,
  Print["IPV6"];
  ,
  True,
  Print["Not sure what this is!"]
 ]
]
ParseIP/@testcases
4 Likes
3

Here is a start for the Fibonacci word/fractal task:

ClearAll[FibonacciWord]
FibonacciWord[1]="1";
FibonacciWord[2]="0";
FibonacciWord[n_Integer?(#>2&)]:=FibonacciWord[n]=FibonacciWord[n-1]<>FibonacciWord[n-2]

FibonacciWord/@Range[7]//Column

giving:

1
0
01
010
01001
01001010
0100101001001

Now one should develop the ‘drawing’ code…

4 Likes
4

Going by this video I added one for Huffman Coding, done in my usual potentially-too-fancy-for-its-own-good style:

huffman[s_String] := huffman[Characters[s]];
huffman[l_List] := Module[{merge, structure, rules},
 
   (*merge front two branches. list is assumed to be sorted*)
   merge[k_] := Replace[k, {{a_, aC_}, {b_, bC_}, rest___} :> {{{a, b}, aC + bC}, rest}];
 
   structure = FixedPoint[
      Composition[merge, SortBy[#, Last] &],
      Tally[l]][[1, 1]];
 
   rules = (# -> Flatten[Position[structure, #] - 1]) & /@ DeleteDuplicates[l];
 
   {Flatten[l /. rules], rules}];

It seems to be correct.

An addendum to Sander’s FibonacciWord code above:

step["0", {_?EvenQ}] = RotationTransform[Pi/2];
step["0", {_?OddQ}] = RotationTransform[-Pi/2];
step[___] = Identity;

steps = MapIndexed[step, Characters[FibonacciWord[10]]];
dirs = ComposeList[steps, {0, 1}];
Graphics[Line[FoldList[Plus, {0, 0}, dirs]]]

Also in a playful programming style. I’m not certain about the correctness of this one, though.

6 Likes
5

Hi Antonio,

Great! The total code for the FibonacciWord would now be:

ClearAll[FibonacciWord]
FibonacciWord[1] = "1";
FibonacciWord[2] = "0";
FibonacciWord[n_Integer?(# > 2 &)] := FibonacciWord[n] = FibonacciWord[n - 1] <> FibonacciWord[n - 2]

step["0", {_?EvenQ}] = RotationTransform[Pi/2];
step["0", {_?OddQ}] = RotationTransform[-Pi/2];
step[___] = Identity;

steps = MapIndexed[step, Characters[FibonacciWord[23]]];
dirs = ComposeList[steps, {0, 1}];
Graphics[Line[FoldList[Plus, {0, 0}, dirs]]]

Giving:

ScreenShot2014-06-05at00.44.05.png
ScreenShot2014-06-05at00.44.05.png1614×1144 111 KB

which looks exactly like the one shown in figure 1 of this article.

Antonio; as you did the ‘crucial’ part of the implementation, I suggest you add it to Rosettacode.

4 Likes
6

I added the code for the Combinations and permutation task.

2 Likes
7

Here is my very crude and probably extremely inefficient suggestion for a word-wrap.

string = "In olden times when wishing still helped one, there lived a \
king whose daughters were all beautiful, but the youngest was so \
beautiful that the sun itself, which has seen so much, was astonished \
whenever it shone in her face.  Close by the king's castle lay a \
great dark forest, and under an old lime-tree in the forest was a \
well, and when the day was very warm, the king's child went out into \
the forest and sat down by the side of the cool fountain, and when \
she was bored she took a golden ball, and threw it up on high and \
caught it, and this ball was her favorite plaything.";

wordWrap[textWidth_, spaceWidth_, string_] :=
  
  Module[{start, spaceLeft, masterString},
   spaceLeft = textWidth;
   start = 1;
   masterString = {};
   Do[
    If[i + 1 > Length@StringSplit@string,
     p = StringSplit[string][[start ;; i]]; 
     AppendTo[
      masterString, {StringJoin @@ 
        Riffle[p, StringJoin@ConstantArray[" ", spaceWidth]]}],
     If[StringLength[StringSplit@string][[i + 1]] + spaceWidth > 
       spaceLeft,
      spaceLeft = textWidth - StringLength[StringSplit@string][[i]]; 
      start = i; 
      AppendTo[
       masterString, {StringJoin @@ 
         Riffle[p, StringJoin@ConstantArray[" ", spaceWidth]]}],
      spaceLeft -= StringLength[StringSplit@string][[i]]; 
      spaceLeft -= spaceWidth; 
      p = StringSplit[string][[start ;; i]]]], {i, 1, 
     Length@StringSplit@string}];
   StringJoin @@ Riffle[masterString, "\n"]
   ];

wordWrap[72, 1, string]

I’ve hidden the output, looks like crap in the coding preview.

Edit: Added actual dependence on the space width in the code.
Edit 2: Changed output style from n discrete lines to one single string output. Edit 3: Removed a lazy “Break[]” and “Clear[p]” left behind from building the code.

1 Like
8

Looks great! It works pretty neatly I think. Works good, but it might be nicer if it would return a string rather than print it.

Did you add it to the Rosetta website? If you want me to do it (because you e.g. don’t have an account), let me know.

1 Like
9

I added the code for the Chinese remainder theorem task, which was very easy as it is a built-in function…

2 Likes
10

hi Sander, looking at the page of the Rosetta Code I found the stable marriage problem and I remember that Stan Wagon proposes a solution to this problem in his book "Mathematica in action " third edition, but not if we have problems with Stan to post your code

2 Likes
11

Please submit it in my place, I do not have an account and it seems you are already familiar with the submission process with regards to formatting and whatnot. I have now updated the code with your suggestion of outputting a single string, thank you for your input!

1 Like
12

Trabb Pardo-Knuth algorithm;

numbers = RandomReal[{-2, 6}, 11]

tpk[numbers_, overflowVal_] :=
 Module[{revNumbers},
  revNumbers = Reverse[numbers];
  f[x_] := Abs[x]^0.5 + 5 x^3;
  Do[If[f[i] > overflowVal,
    Print@StringJoin[{"f[", ToString[i], "]= Overflow"}],
    Print@StringJoin[{"f[", ToString[i], "]= ", ToString[f[i]]}]], {i,revNumbers}]]

tpk[numbers, 400]

Had to resort to discrete printings of strings, not sure how to do it otherwise. Feel free to make improvement suggestions. If you would please submit this one as well, Sander, I would appreciate that.

1 Like
13

Hi Marcus, looks great!

I think:

Print@StringJoin[{"f[", ToString[i], "]= Overflow"}]

will be (nearly) identical to:

Print["f[",i, "]= Overflow"];

It will output it using row, and you don’t have to think about ToString et cetera. Of course it is not the same, but as you ‘print’ it anyhow, it doesn’t really matter. I will add it later.

1 Like
14

You are right, the output is virtually the same. I think your version is better as it carries only one third of the commands for printing the values and hence is more elegant.

I actually tried with a similar construction before resorting to printing strings, but it somehow displayed the value before the text strings somehow. I don’t remember exactly how I formulated the command though.

Edit: I think I omitted the commas within the Print command. That doesn’t work out so well apparently.

1 Like
15

I just added it to the website! Thanks!

1 Like
16

I replaced the Prints, and uploaded it to the website; thanks! If you forget the commas it will see it as multiplication, multiplications of a string and an number will (generally) be displayed as “numberstring”. Thanks!

1 Like
17

I implemented Rep-string, which was quite easy in Mathematica with smart usage of the pattern-matching abilities of Mathematica.

1 Like
18

I implemented IBAN, quite easy to implement.

1 Like
19

I implemented Vampire number.

1 Like
20

Sorry I also don’t have access to this book. If no-one has access to it, we have to implement ourselves… Thanks for the hint! Hopefully someone has this book.