String formatting procedure

I have a string of words that I want to scramble in a unique way. I want to scramble all of the letters except for the first and last. So for instance, the string

"The quick brown fox jumped over the lazy dog"

might get turned into

"The qicuk borwn fox jmuepd oevr the lzay dog"

Ive been messing with a way to do this for a while, but havn't come up with a way to do it. Can someone please help?

fyi, the reason Im writing this is to demostrate the fact that most of the time, all you need to have is the first and last letter of the word in the right place to read the word. pretty neat huh ;-)
eyagerAsked:
Who is Participating?
 
LRHGuyConnect With a Mentor Commented:
Try this...put a list box on a form, and a button...

// Scramble a word but preserve first and last letters.
function ScrambleWord(const aWord:string):string;
var
  L,I:integer;
  Work:string;
begin
  L:=length(aWord);
  if L<4 then
    Result:=aWord
  else begin
     Work:=copy(aWord,2,L-2);
     Randomize;
     Result:=aWord[1];
     while Work<>'' do begin
       I:=Random(length(Work))+1;
       Result:=Result+Work[I];
       delete(Work,I,1);
     end;
     Result:=Result+aWord[L];
  end;
end;

// Scramble a sentence
function Scramble(const aSentence:string):string;
var
  I:integer;
  Work:string;
begin
  Result:='';
  Work:=aSentence;
  while Work<>'' do begin
    I:=pos(' ',Work);
    if I=0 then
      I:=length(Work)+1;
    Result:=Result+' '+ScrambleWord(copy(Work,1,I-1));
    delete(Work,1,I);
  end;
  Delete(Result,1,1);
end;

procedure TForm2.Button2Click(Sender: TObject);
begin
  ListBox1.Items.Add(Scramble('There is no way around selling'));
end;
0
 
Wim ten BrinkSelf-employed developerCommented:
Why so complex,  LRHGuy? :-)

program Scramble;

{$APPTYPE CONSOLE}

const
  Letters: set of char = [ 'a'..'z', 'A'..'Z' ];

var
  Line: string;
  I: Integer;
  Start: Integer;
  Len: Integer;
  C: Char;
  Rnd: Integer;
begin
  Randomize;
  Line := CmdLine;
  I := 1;
  while ( I < Length( Line ) ) do begin
    if ( Line[ I ] in Letters ) then begin
      // Go to second character.
      Inc( I );
      // Save this startpoint.
      Start := I;
      // Go to end of word or end of line.
      while ( I <= Length( Line ) ) and ( Line[ I ] in Letters ) do
        Inc( I );
      // We're past the word. Determine length of word, minus last character!
      Len := I - 1 - Start;
      // Now, start scrambling...
      while ( Len > 1 ) do begin
        Rnd := Random( Len );
        // See if we're going to swap a value.
        if ( Rnd > 0 ) then begin
          // Go swap value.
          C := Line[ Start ];
          Line[ Start ] := Line[ Start + Rnd ];
          Line[ Start + Rnd ] := C;
        end;
        // Go to next character.
        Inc( Start );
        Dec( Len );
      end;
    end
    else begin
      Inc( I );
    end;
  end;
  WriteLn( Line );
  ReadLn;
end.
0
 
Wim ten BrinkSelf-employed developerCommented:
Wow, it looks funny, doesn't it? My version of the code is actually quite simple. What I'm doing is just searching for whole words. With every whole word I find, I skip the first and last character and shuffle around the other characters inside it. Furthermore, I'm just moving characters and am not copying strings, which means that it has a higher performance than when using string manipulations.
I'm not saying the code by LRHGuy doesn't work. It just performs a bit faster. If you want it as a function then it's simple:

function Shuffle( Value: string ): string;
const
  Letters: set of char = [ 'a'..'z', 'A'..'Z' ];
var
  I, Start, Len, Rnd: Integer;
  C: Char;
begin
  Randomize;
  Result := Value;
  I := 1;
  while ( I < Length( Result ) ) do begin
    if ( Result[ I ] in Letters ) then begin
      Inc( I );
      Start := I;
      while ( I <= Length( Result ) ) and ( Result[ I ] in Letters ) do
        Inc( I );
      Len := I - 1 - Start;
      while ( Len > 1 ) do begin
        Rnd := Random( Len );
        if ( Rnd > 0 ) then begin
          C := Result[ Start ];
          Result[ Start ] := Result[ Start + Rnd ];
          Result[ Start + Rnd ] := C;
        end;
        Inc( Start );
        Dec( Len );
      end;
    end
    else begin
      Inc( I );
    end;
  end;
end;

It works. Trying to understand how could be a real nightmare for beginning programmers, though. This routine is pretty complex. :-)
And yes, I think that even more experienced programmers would have a bit of trouble coming up with such a solution. ;-)
0
Get your problem seen by more experts

Be seen. Boost your question’s priority for more expert views and faster solutions

 
LRHGuyCommented:
Not complex...modular....

ScrambleWord can be used to scramble any string, preserving first and last letter.
0
 
Wim ten BrinkConnect With a Mentor Self-employed developerCommented:
Oops. Bugfix. This version performs slighly faster. Furthermore, removed the Randomize function from it. Call Randomize somewhere else or your final result isn't really random...

function Shuffle( Value: string ): string;
const
  Letters: set of char = [ 'a'..'z', 'A'..'Z' ];
var
  I, Start, Len, Rnd: Integer;
  C: Char;
begin
  Result := Value;
  I := 1;
  while ( I < Length( Result ) ) do begin
    if ( Result[ I ] in Letters ) then begin
      Inc( I );
      Start := I;
      while ( I <= Length( Result ) ) and ( Result[ I ] in Letters ) do
        Inc( I );
      Len := I - 1 - Start;
      while ( Len > 1 ) do begin
        Rnd := Random( Len );
        if ( Rnd > 0 ) then begin
          C := Result[ Start ];
          Result[ Start ] := Result[ Start + Rnd ];
          Result[ Start + Rnd ] := C;
        end;
        Inc( Start );
        Dec( Len );
      end;
    end;
    Inc( I );
  end;
end;
0
 
Wim ten BrinkSelf-employed developerCommented:
LRHGuy, you are right about your code being modular. It's a good piece of code. However, I could have done that too, but chose to not do this to increase performance.
And besides, I think my shuffling code is a bit nicer. :-) Basically, the shuffling part is this part:

  while ( Len > 1 ) do begin
    Rnd := Random( Len );
    if ( Rnd > 0 ) then begin
      C := Result[ Start ];
      Result[ Start ] := Result[ Start + Rnd ];
      Result[ Start + Rnd ] := C;
    end;
    Inc( Start );
    Dec( Len );
  end;

This could be used to shuffle any string, of course. Set len to the length of the string and Start to 1 before you start this code. It then shuffles the whole string. If I want to do exactly the same as you, I would have to set Len to Length(Result) - 2 and start to 2 to skip the first and last character. :-)
And again, I'm not saying your code doesn't work. I'm just showing a bit more optimized code version. (Faster!)
0
 
Bart_ThomasCommented:
Allright, maybe not the quickest routine, but an excellent trail for some new thing (absolute) I found in the help file.

The quick brown fox jumps over the lazy dog

is scrambled to:

The qicuk bowrn fox jmpus oevr the lzay dog

function eyager_scramble (const AString: String): String;
var
  C: Char;
  W: ShortString;
  L: Byte absolute W;
  sl: TStringList;
  i,j: Integer;
begin
  sl := TStringList.Create;
  try
    sl.Text := StringReplace (AString, #32,#13#10, [rfReplaceAll]);
    i := 0;
    while i < sl.Count do
    begin
      W := sl[i];
      j := 2;
      while j < L-1 do
      begin
        C := W[j];
        W[j] := W[j+1];
        W[j+1] := C;
        inc (j);
      end;
      sl[i] := W;
      inc (i);
    end;
    Result := StringReplace (sl.Text, #13#10, #32, [rfReplaceAll]);
  finally
    sl.Free;
  end;
end;
0
 
Wim ten BrinkSelf-employed developerCommented:
@Bart_Thomas: You actually make the same mistake as LRHGuy, actually. Okay, it is still valid considering the answer. But you too forget that a sentence can contain more than just a space as word separator.

Nice cheat with that absolute keyword, though. :-) But of course, just using the Length function to get a string length is more common. More safe too, especially if you ever move to .NET or if Borland decides to alter the layout of the string type. Therefore, I have to advise you to NOT use this trick. It will work but it is considered a very dirty trick, almost as bad as using the Goto statement in Delphi. If you use: L := Length(W) you'd just have the same result. Besides, you'd be able to use the normal string type in that case.

And your code has another flaw. It will always generate the same output for the same string. Nothing random in it.
0
 
Bart_ThomasConnect With a Mentor Commented:
absolute rules! I recently stumbled upon it in a help file and I thought that this scramble-routine was the ideal place to use it. Usually words in a sentence are no longer than 255 characters. But you're right it is a bit dirty. Anyways, I had a go at some neater code and I did add an expandable seperator-check.

function eyager_scramble2 (const AString: String): String;

  function ScrambleWord (AWord: String): String;
  var
    i,j: Integer;
    C: Char;
  begin
    Result := AWord;
    i := 2;
    while i < length(Result)-1 do
    begin
      j := 2 + Random (length(AWord)-2);
      C := Result[i];
      Result[i] := Result[j];
      Result[j] := C;
      inc (i);
    end;
  end;

var
  i,j: Integer;
begin
  Result := '';

  Randomize;
  j := 1;
  i := 1;
  while i <= length (AString) do
  begin
    if AString[i] in [#32,',',';','.'] then
    begin
      Result := Result + ScrambleWord (Copy (AString,j,i-j));

      while (i <= length(AString)) and (AString[i] in [#32,',',';','.']) do
      begin
        Result := Result + AString[i];
        inc (i);
      end;
      j := i;
    end
    else
      inc (i);
  end;

  if i <> j then
    Result := Result + ScrambleWord (Copy (AString,j,i-j));
end;
0
 
eyagerAuthor Commented:
Wow LRHGuy, your first post works great. Thanks to all three of you for helping me out though. Im going to give most points to LRHGuy for beng the first and correct post. Workshop Alex, yours is much faster and I agree it's cleaner (took me a minute to figure it out though lol). Bart your post was interesting enough to get some points also.
0
 
eyagerAuthor Commented:
I did a little test and it looks like shuffle (from alex) can process the above sentance 5000 times in 1.27 seconds on average. Scramble (from LHRGuy) can do it 5000 times in 3.9 seconds on average. I went ahead and implemented yours alex because of the dinky speed difference (Im a perfectionist I guess...). You never know when you will encounter someone with a 486 sx running windows 98 who will actually need the extra cpu ticks, also ;-)  Wow, I have too much time on my hands...
0
 
eyagerAuthor Commented:
Bart, yours was in the middle with a 2.5... These cant be seconds though.. Im thinking milliseconds... well... heres how i got the values
  starttime := Frac(now);
  for it:=1 to 5000 do
  begin
    for i:=0 to Memo1.Lines.COunt-1 do
    begin
       eyager_scramble2(Memo1.Lines[i]);
    end;
  end;
  endtime := Frac(now);
  Label2.Caption := FloatToStr(endtime-starttime);
0
 
Wim ten BrinkSelf-employed developerCommented:
Lol, yep... My method is faster, although it is a bit difficult to follow for inexperienced programmers. Code like my scramble code is a bit rare. ;-)

Yeah, I know. It seems as if I have a big ego and yes... It really is big but it is true also. Most people tend to manipulate strings by using techniques shown by LHRGuy or Bart. Especially the use of stringlists and concatenating strings are very popular. However, you might want to run that test again, using a string of no less than 200 words. Some short, others long. Then try to run it 5000 times again and you'll notice an even bigger time difference.

The strength in my method is that I'm changing almost nothing. Each character in the string is only checked once. Even the number of swapping of characters is kept to a near-minimum. But most of the speed I get from avoiding complex string manipulations. I think the speed can be slightly increased even if you store the string length in a separate variable, then use this new variable in the While loops I use.

And you know what? It was quite fun coming up with such a solution. A real challenge. :-)
0
 
Bart_ThomasCommented:
If you ask me, the method used by Workshop Alex isn't that difficult. It is quite easy in fact. All you have to do is reformat it into readable code ;) Just kidding, but isn't a big speed gain in not using a seperate function to scramble a word?

I was playing around with "Shuffle" form Workshp Alex. And it is possible to get rid of one more variable. Not that that increases speed, but it's always nice to squeeze some air out of a nice function.

function eyager_scramble3 (const AString: String): String;
const
  Seperators: set of char = [#32,',',';','.'];
var
  i,j,r: Integer;
  C: Char;
begin
  Result := AString;

  j := 1;
  i := 1;
  while i <= length (Result) do
  begin
    if (Result[i] in Seperators) then
    begin
      inc (j);
      while j < i-1 do
      begin
        r := j + Random (i-j-1);
        C := Result[j];
        Result[j] := Result[r];
        Result[r] := C;
        inc (j);
      end;
      while (i <= length(Result)) and (Result[i] in Seperators) do
        inc (i);
      j := i;
    end
    else
      inc (i);
  end;
end;

Ow... Shuffle and eyager_scramble3 use 15 ticks to run 5000 times on my machine.

0
 
Bart_ThomasCommented:
Little bug in my last post:

function eyager_scramble3 (const AString: String): String;
const
  Seperators: set of char = [#32,',',';','.'];
var
  i,j,{s,}r: Integer;
  C: Char;
begin
  Result := AString;

  j := 1;
  i := 1;
  while i <= length (Result) do
  begin
    if (Result[i] in Seperators) or (i = length(Result)) then
    begin
      inc (j);
      //s := j;
      repeat
        //r := s + Random (i-s-1);
        r := j + Random (i-j-1);
        C := Result[j];
        Result[j] := Result[r];
        Result[r] := C;
        inc (j);
      until j = i-1;
      while (i <= length(Result)) and (Result[i] in Seperators) do
        inc (i);
      j := i;
    end;
    inc (i);
  end;
end;
0
 
Wim ten BrinkSelf-employed developerCommented:
> but isn't a big speed gain in not using a seperate function to scramble a word?
Every function call wil be slower than just calling the code. However, there will be a new feature in Delphi 9, apparantly. It also existed in Turbo Pascal, which are inline procedures and functions. The difference between normal methods and inline methods being that the code of the inline method will be put in every position there the method is called. For normal methods, a call is just created to the method address. Inline procedures do increase the amount of memory needed because there will be multiple copies of the method all over your executable. However, it does speed up things because there are no calls anymore. Calls just require data to be pushed and popped to and from the stack, then the call and finally the loss of a tick to return back to the place where the procedure was called.

Thus, for optimal performance, try to avoid calling functions from within a loop... It will probably save you about 50 processor ticks, which on a 1 GHz pentium IV would be about 0.000046 milliseconds. ;-)

About getting rid of the extra variable, fine. However, again there's a performance issue here. You have "r := j + Random (i-j-1);" while I have "r := j + Random (Len);". My version therefore performs faster since I'm not continuously calculating the length of the string. It won't change while I'm inside this loop, thus keeping an additional value here is very useful to increase speed. But okay, you could save a bit of memory here. Speed versus memory...

About your outer while loop, one flaw... You're checking one character more than I did. I looped while ( I < Length( Result ) ) and you loop while ( I <= Length( Result ) ). Not much performance gain here, though. Just one less character. Basically, the outer loop in my code serves to find the first character while you search for the first separator. But if the last character is also the first character of a new word, there's not much to shuffle anyway, is it? Therefore I could skip that last one. Actually, I could skip the last two, looping ( I < ( Length( Result ) - 1 )) but the additional math makes it complicated again. I would then have to add another variable and then say: Max := Length(Result) - 1; while ( I < Max ) do begin ...

The next problem. What if the line starts with a separator? My code is aware of lines starting with separators. Yours assumes it starts with a letter. :-) Which is why searching for separators is the wrong approach. You want to shuffle words, thus search for words!

And I preferred my set of letters. This means I can define what is a letter and what is not. There are less letters than separators anyway, unless you count those accented letters like ëùÑ as letters too. What if there are numbers in the line? Or currency signs? :-)

But okay, let's optimize my function then...

function Shuffle( Value: string ): string;
const
  Letters: set of char = [ 'a'..'z', 'A'..'Z' ];
var
  I, Start, Len, Rnd, Max: Integer;
  C: Char;
begin
  Result := Value;
  Max := Length(Result);
  I := 1;
  while ( I < Max ) do begin
    if ( Result[ I ] in Letters ) then begin
      Inc( I );
      Start := I;
      while ( I <= Max ) and ( Result[ I ] in Letters ) do
        Inc( I );
      Len := I - 1 - Start;
      while ( Len > 1 ) do begin
        Rnd := Start + Random( Len );
        if ( Rnd > Start ) then begin
          C := Result[ Start ];
          Result[ Start ] := Result[ Rnd ];
          Result[ Rnd ] := C;
        end;
        Inc( Start );
        Dec( Len );
      end;
    end;
    Inc( I );
  end;
end;

If you want it to be faster, write it in assembler. ;-)
But also remember, if you want more speed, increase the number of variables. If you need to save memory, use more methods and less variables. In general, speed and memory are always conflicting with one another. It sounds strange but a faster speed requires more memory. Consider it like a car. In general, a bigger engine helps you to get more power and more speed...
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.