FreePascal: find all 3-symbol unique substring in string

[winni]

Hi!

Keep it short and simple:

Code: Pascal  [Select][+][-]

1. program CountPattern;
2.  
3. {$mode objfpc}{$H+}
4.  
5. uses  Classes;
6.  
7. var sl: TStringList;
8.     s, pattern : string;
9.     i : integer;
10. begin
11. sl := TStringList.create;
12. sl.Sorted:= true;
13. sl.Duplicates:= dupIgnore;
14.  
15. write('String: ');
16. readln(s);
17.  for i:=1 to length(s)-2 do
18.       begin
19.       pattern:=copy (s,i,3);
20.       sl.add(pattern);
21.       end;
22.  writeln (sl.count,' unique patterns');
23.  sl.free;
24. end.          
25.  
26.  

Winni

PS.: DupIgnore does not work without Sorted.
If it is not a bug then it is strange.

Yes I know - another Delphi compatible bastard .....

[Thaddy]

Well, it would be implementable, but it would be really slow. I guess that is the reason.

[Thaddy]

Alternative that has just minor changes to your original code:
Use of THashSet - or if order is important TSortedSet - , For instead of foreach and the addition uses THashSet.add.

Code: Pascal  [Select][+][-]

1. {$mode delphi}
2. uses generics.collections;
3. type
4.   Mnoj=THashSet<string>;    // or TSortedSet
5. var S: string;
6.     i: integer;
7.     Mn3: Mnoj;
8. begin
9.  Mn3 := Mnoj.Create; // or TSortedSet.Create
10.  write('String: ');
11.  readln(S);
12.  for i:=1 to length(S)-2 do  
13.   Mn3.Add(S[i]+S[i+1]+S[i+2]);  
14.  i:=0;
15.  writeln('Substring: ');
16.  for S in Mn3 do
17.   begin
18.    Write(S,' ');
19.    i:=i+1;
20.   end;
21.  writeln;
22.  writeln('Sum=',i);
23.  Mn3.free;
24. end.

Voila. Works like a charm.

[BobDog]

This is about as short as I can do this:

Code: Pascal  [Select][+][-]

1.  
2. program threes;
3. var
4. s:ansistring;
5. i:int32;
6.  
7. begin
8. while(s<>'q') do
9.  begin
10.   write('Enter string (or q to quit): ');
11.   read(s);
12.  for i:=1 to length(s)-2 do if (pos((s[i..i+2]),s)=i) then writeln(i,'  ',s[i..i+2]);
13.   readln;
14.  end;
15. end.
16.  
17.