13
$\begingroup$

Now there is a string with digits and letters, for instance, "95uge678r3gi89hgfe30kgh063d51". And the expected output is "00uge133r3gi55hgfe66kgh788d99".

I am able to do it in this way

StringReplacePart[#, Sort@StringCases[#, _?DigitQ], 
StringPosition[#, ToString /@ Range[0, 9]]]&@"95uge678r3gi89hgfe30kgh063d51"

Is there any elegant functional solution? Algorithms that can be generalised to similar list manipulations would be nice.

|improve this question
$\endgroup$
11
$\begingroup$

StringReplacePart gets very slow when there are many replacements. A more direct approach proves to have far better complexity. My proposal:

subSort[s_String] :=
 Module[{p, ch},
  p = StringPosition[s, DigitCharacter];
  If[p === {}, Return[s], p = p[[All, 1]]];
  ch = Characters[s];
  ch[[p]] = Sort @ ch[[p]];
  StringJoin[ch]
 ]

rasher took this idea to the next level by going full numeric. The complexity remains the same but the coefficient is considerably more favorable. His code adjusted for uniformity:

strnumsrt[s_String] := 
  Module[{tc = ToCharacterCode[s], tcc, tcr},
   tcc = Unitize@Clip[tc, {48, 57}, {0, 0}];
   tcr = Pick[Range@Length@tcc, tcc, 1];
   tc[[tcr]] = Sort[tc[[tcr]]];
   FromCharacterCode[tc]];

Simon's function:

f1[s_String] := With[{p = StringPosition[s, DigitCharacter]}, 
   StringReplacePart[s, Sort@StringTake[s, p], p]]

Test:

g = "1" <> RandomChoice[
             Join @@ CharacterRange @@@ {{"1", "9"}, {"a", "z"}},
             #
           ] &;

Needs["GeneralUtilities`"]

BenchmarkPlot[{f1, subSort, strnumsrt}, g]

enter image description here

|improve this answer
$\endgroup$
  • 3
    $\begingroup$ "...Going full numeric" - I keep hearing this in the voice of Kirk Lazarus in Tropic Thunder... and +1 on you. $\endgroup$ – ciao Mar 29 '15 at 1:09
  • $\begingroup$ @rasher "just a dude pretending to be another dude"...all I can 'say' is "you people" $\endgroup$ – ubpdqn Mar 29 '15 at 3:29
12
$\begingroup$

I think you'll find this much faster than answers so far...

strnumsrt = Module[{tc = ToCharacterCode[#], tcc, tcr},
    tcc = Unitize@Clip[tc, {48, 57}, {0, 0}];
    tcr = Pick[Range@Length@tcc, tcc, 1];
    tc[[tcr]] = Sort[tc[[tcr]]];
    FromCharacterCode[tc]] &;
|improve this answer
$\endgroup$
  • $\begingroup$ Very nice. I'll add it to the timings. $\endgroup$ – Mr.Wizard♦ Mar 29 '15 at 0:26
  • $\begingroup$ I note that your Pick construct is just as fast as SparseArray in 10.0.2. That was surely not the case in v7. I'll have to make better use of it now. $\endgroup$ – Mr.Wizard♦ Mar 29 '15 at 0:43
  • $\begingroup$ @Mr.Wizard: Yes, depending on what's being done, it is comparable and sometimes faster than SA... $\endgroup$ – ciao Mar 29 '15 at 0:44
  • $\begingroup$ @rasher this is neat...+1 :) $\endgroup$ – ubpdqn Mar 29 '15 at 1:25
  • $\begingroup$ +1 for showing me that FromCharacterCode is fast after I had decided that it wasn't. $\endgroup$ – Jacob Akkerboom Apr 2 '15 at 15:55
6
$\begingroup$

This is a slight rewrite of the code in the question, rather than anything elegant or clever.

You can use the DigitCharacter pattern in StringPosition instead of ToString /@ Range[0, 9], and having found the positions you can use them in StringTake instead of searching the string again with StringCases:

With[{p = StringPosition[#, DigitCharacter]}, 
   StringReplacePart[#, Sort@StringTake[#, p], p]]&@
   "95uge678r3gi89hgfe30kgh063d51"
|improve this answer
$\endgroup$
  • $\begingroup$ FYI: this throws an error when the input string contains no digit characters. $\endgroup$ – Mr.Wizard♦ Mar 28 '15 at 23:18
4
$\begingroup$

This is known to be inefficient because using patterns like this gives a poor complexity, but it works:

str = "95uge678r3gi89hgfe30kgh063d51";
FixedPoint[StringReplace[
   #,
   a___ ~~ b : DigitCharacter ~~ c___ ~~ d : DigitCharacter ~~ e___ /;
      !OrderedQ[{b, d}] :> StringJoin[{a, d, c, b, e}]
   ] &, str]

(Thanks to Simon Woods for suggesting !OrderedQ[{b,d}], see the comments.)

|improve this answer
$\endgroup$
  • $\begingroup$ +1 You could also use !OrderedQ[{b, d}] as your condition which should be faster than converting to numbers. $\endgroup$ – Simon Woods Mar 28 '15 at 21:16
  • $\begingroup$ @SimonWoods Thanks, I included it in the post since I like it a lot better. $\endgroup$ – C. E. Mar 28 '15 at 22:05
  • $\begingroup$ excellent ! I was working on this idea of swapping DigitCharacters through the string until they are sorted.77 penguins were scratching their heads, but you was faster..hi,hi,hi .+1 for you. $\endgroup$ – penguin77 Mar 28 '15 at 22:22
3
$\begingroup$ 
strng = "95uge678r3gi89hgfe30kgh063d51";
Block[{c = Sort@StringCases[#, DigitCharacter], j = 0},
   StringReplace[#, DigitCharacter :> c[[++j]]]] &@strng
(* "00uge133r3gi55hgfe66kgh788d99" *)
|improve this answer
$\endgroup$
3
$\begingroup$

My main goal here is to provide an example for other people who want to experiment with LibraryLink and strings, as well as to test how fast all of this is (and to become the "bottom line" in the fancy plot of course >:D ).

Anyway I made the following functions in C. Note that you have to have a C-compiler set up in such a way that Mathematica knows about it, before you try to use this code.

The C code

typedef int bool;
#define true 1
#define false 0

#include "WolframLibrary.h"

char* instring;

/* Return the version of Library Link */
DLLEXPORT mint WolframLibrary_getVersion( ) {
    return WolframLibraryVersion;
}

/* Initialize Library */
DLLEXPORT int WolframLibrary_initialize( WolframLibraryData libData) {
    return LIBRARY_NO_ERROR;
}

/* Uninitialize Library */
DLLEXPORT void WolframLibrary_uninitialize( WolframLibraryData libData) {
    return;
}

DLLEXPORT int sortDigitsInString(WolframLibraryData libData,
                             mint Argc, MArgument *Args, MArgument Res)
{
    instring = MArgument_getUTF8String(Args[0]);
    int counts[10];
    for(mint j=0; j<10; j++){
        counts[j]=0;
    }

    mint slen = strlen(instring);
    mint* intPos = malloc(slen*sizeof(mint)); //cast if you are using C++

    char* charPtr = instring;
    char cChar;
    mint* intPosPtr = intPos;
    mint intPosLen = 0;

    for (mint i = 0; i < slen; i++) {
        cChar = *charPtr;
        if (48 <= cChar && cChar <= 57) {
            counts[cChar - 48]++;
            *intPosPtr = i;
            intPosPtr++;
            intPosLen++;
        }
        charPtr++;

    }

    intPosPtr = intPos;

    mint c;
    mint cCount;
    for (mint i=0; i<10; i++) {
        cCount = counts[i];
        c = i + 48;
        for(mint j=0; j < cCount; j++){
            instring[*intPosPtr] = c;
            intPosPtr++;
        }
    }

    MArgument_setUTF8String(Res, instring);
    return LIBRARY_NO_ERROR;
}

DLLEXPORT int sortDigitsInString2(WolframLibraryData libData,
                                 mint Argc, MArgument *Args, MArgument Res)
{
    instring = MArgument_getUTF8String(Args[0]);
    int counts[10];
    for(mint j=0; j<10; j++){
        counts[j]=0;
    }

    mint slen = strlen(instring);
    mint* pickAr = malloc(slen*sizeof(mint)); //cast if you are using C++


    char* charPtr = instring;
    char cChar;

    mint* pickPtr = pickAr;

    for (mint i = 0; i < slen; i++) {
        cChar = *charPtr;
        if (48 <= cChar && cChar <= 57) {
            counts[cChar - 48]++;
            *pickPtr = 1;
        }
        else{
            *pickPtr = 0;
        }
        pickPtr++;
        charPtr++;

    }

    mint c = 48;
    mint cCount = counts[0];
    mint cUsedCount = 0;
    mint k = 0;
    pickPtr = pickAr;
    charPtr = instring;
    bool zeroCountFlag = true;


    for (mint i = 0; i < slen; i++) {
        if (*pickPtr) {
            *charPtr = c;
            cUsedCount++;
        }
        charPtr++;
        pickPtr++;

        if (cUsedCount == cCount) {
            while (zeroCountFlag) {
                k++;
                c++;
                cCount = counts[k];
                zeroCountFlag = cCount == 0;
            }
            cUsedCount = 0;
            zeroCountFlag = true;
        }

    }

    MArgument_setUTF8String(Res, instring);

    return LIBRARY_NO_ERROR;
}

DLLEXPORT int digitCounts(WolframLibraryData libData,
                             mint Argc, MArgument *Args, MArgument Res)
{
    int err = 0;
    instring = MArgument_getUTF8String(Args[0]);
    int counts[10];
    for(mint j=0; j<10; j++){
        counts[j]=0;
    }

    mint* data;


    MTensor countsTensor;
    mint dims[1];
    dims[0] = 10;
    err = libData->MTensor_new(MType_Integer, 1, dims, &countsTensor);
    data = libData->MTensor_getIntegerData(countsTensor);
    mint c =0;
    mint slen = strlen(instring);
    char* charPtr = instring;
    char cChar;

    for (mint i = 0; i < slen; i++) {
        cChar = *charPtr;
        if (48 <= cChar && cChar <= 57) {
            counts[cChar - 48]++;
        }
        charPtr++;

    }

    for(mint j=0; j<10; j++){
        data[j] = counts[j];
    }

    MArgument_setMTensor(Res, countsTensor);
    return err;
}

DLLEXPORT int freeString(WolframLibraryData libData,
                   mint Argc, MArgument *Args, MArgument Res)
{
    libData->UTF8String_disown( instring);
    return LIBRARY_NO_ERROR;
}

In order to use the C code, no file has to be made. We can simply use the code as a Mathematica string. In my setup, we have to store the string in the variable cCodeString.

One way to achieve this is by pasting the contents of the code block above between quotes (cCodeStr = "<paste here>") and pressing Yes in the dialogue.

Alternatively, the following code makes a nice cell to paste the c code in.

(*NotebookDelete[Cells[CellTags -> "cCodeCell"]];*)
Cell["", "Code", CellLabel -> "Paste Here", CellTags -> "cCodeCell", 
  InitializationCell -> False, Evaluatable -> False , 
  CellAutoOverwrite -> True] // CellPrint

After pasting, we can set cCodeString to the right value as follows

(*evaluate after pasting*)
cCodeStr = First@NotebookRead@First@Cells[CellTags -> "cCodeCell"];

Setting up the functions

The following then sets up all the functions. Note that we really only care about sDSFS and sDSFS2. The function dCFS is is just an added bonus and the other functions are there just to help these functions.

<< CCompilerDriver`
CreateLibrary[cCodeStr, "libStrDigStr"]
sDS = LibraryFunctionLoad["libStrDigStr", 
   "sortDigitsInString", {"UTF8String"}, "UTF8String"];

sDS2 = LibraryFunctionLoad["libStrDigStr", 
   "sortDigitsInString2", {"UTF8String"}, "UTF8String"];

dC = LibraryFunctionLoad["libStrDigStr", 
   "digitCounts", {"UTF8String"}, {Integer, 1}];

freeString = 
  LibraryFunctionLoad["libStrDigStr", "freeString", {}, "Void"];
sDSFS =
  PreemptProtect@AbortProtect@First@{sDS@#, freeString[]} &;

sDSFS2 =
  PreemptProtect@AbortProtect@First@{sDS2@#, freeString[]} &;

dCFS =
  PreemptProtect@AbortProtect@First@{sDS@#, freeString[]} &;

Comparison

Now with the definitions in Mr.Wizards answer, we get

Needs["GeneralUtilities`"]    
BenchmarkPlot[{f1, subSort, strnumsrt, sDSFS, sDSFS2}, g]

enter image description here

Considerations

Somehow I got into my head that working with strings in LibraryLink was impossible. At the same time I thought using FromCharacterCode was inefficient somehow, but perhaps that is because I used it as FromCharacterCode/@list, rather than FromCharacterCode@list. I think if we use FromCharacterCode we can use a CompiledFunction most of the time, which is always a nice solution in between "normal MMA" solutions and LibraryLink solutions. I think that a quite straightforward translation of my LibraryLink function to a CompiledFunction will probably beat Rasher's function.

|improve this answer
$\endgroup$
2
$\begingroup$

Just because I wanted to join the party and with no redeeming features (...just like playing with Reap and Sow):

f[str_] := Module[{ss = StringSplit[str, ""], a, b, rul},
  {a, b} = Reap[MapIndexed[Sow[w[First@#2, #1], DigitQ[#1]] &, ss]];
  rul = Join[Thread[b[[1]] -> Sort[b[[1, All, 2]]]], 
    Thread[b[[2]] -> b[[2, All, 2]]]];
  StringJoin[a /. rul]]

So,

test = "95uge678r3gi89hgfe30kgh063d51"
f[test]

yields "00uge133r3gi55hgfe66kgh788d99"

Obviously need to tidy up to make wrapper unique.

|improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.