Solved

String formatting procedure

Posted on 2004-09-22
16
299 Views
Last Modified: 2010-04-05
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 ;-)
0
Comment
Question by:eyager
  • 7
  • 4
  • 3
  • +1
16 Comments
 
LVL 7

Accepted Solution

by:
LRHGuy earned 100 total points
ID: 12129066
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
 
LVL 17

Expert Comment

by:Wim ten Brink
ID: 12132889
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
 
LVL 17

Expert Comment

by:Wim ten Brink
ID: 12132979
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
 
LVL 7

Expert Comment

by:LRHGuy
ID: 12132980
Not complex...modular....

ScrambleWord can be used to scramble any string, preserving first and last letter.
0
 
LVL 17

Assisted Solution

by:Wim ten Brink
Wim ten Brink earned 75 total points
ID: 12133014
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
 
LVL 17

Expert Comment

by:Wim ten Brink
ID: 12133083
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
 
LVL 1

Expert Comment

by:Bart_Thomas
ID: 12135353
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
 
LVL 17

Expert Comment

by:Wim ten Brink
ID: 12135441
@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
How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

 
LVL 1

Assisted Solution

by:Bart_Thomas
Bart_Thomas earned 75 total points
ID: 12136341
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
 

Author Comment

by:eyager
ID: 12136629
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
 

Author Comment

by:eyager
ID: 12136893
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
 

Author Comment

by:eyager
ID: 12136938
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
 
LVL 17

Expert Comment

by:Wim ten Brink
ID: 12137086
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
 
LVL 1

Expert Comment

by:Bart_Thomas
ID: 12137679
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
 
LVL 1

Expert Comment

by:Bart_Thomas
ID: 12138026
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
 
LVL 17

Expert Comment

by:Wim ten Brink
ID: 12138706
> 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

Featured Post

Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

Join & Write a Comment

Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
Sending a Secure fax is easy with eFax Corporate (http://www.enterprise.efax.com). First, Just open a new email message.  In the To field, type your recipient's fax number @efaxsend.com. You can even send a secure international fax — just include t…
This video demonstrates how to create an example email signature rule for a department in a company using CodeTwo Exchange Rules. The signature will be inserted beneath users' latest emails in conversations and will be displayed in users' Sent Items…

707 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now