### Bookstore

 Computer Math and Games in Pascal (preview) Lazarus Handbook

### Author Topic: FreePascal: find all 3-symbol unique substring in string  (Read 8793 times)

#### nixu3

• Newbie
• Posts: 3
##### FreePascal: find all 3-symbol unique substring in string
« on: December 23, 2021, 06:45:48 am »
Program: find all 3-symbol unique substring in string.
I made program on PascalABC. Teacher want FreePascal.
This progran not work in FreePascal. Can you help me with FreePascal.

Code: Pascal  [Select][+][-]
2. type Mnoj=Set Of string[3];
3. var S: string;
4.     i: integer;
5.     Mn3: Mnoj;
6. begin
7.  write('String: ');
9.  for i:=1 to length(S)-2 do
10.   Include(Mn3,S[i]+S[i+1]+S[i+2]);
11.  i:=0;
12.  writeln('Substring: ');
13.  foreach S in Mn3 do
14.   begin
15.    Write(S,' ');
16.    i:=i+1;
17.   end;
18.  writeln;
19.  writeln('Sum=',i);
20. end.

#### dbannon

• Hero Member
• Posts: 2042
##### Re: FreePascal: find all 3-symbol unique substring in string
« Reply #1 on: December 23, 2021, 07:13:48 am »
If you compile your code using fpc, it will tell you, line by line, what it does not like with your code. Looks to me that PascalABC has added a few extras that will almost certainly not be implemented in FP.

Are you sure your code works OK under PascalABC ?  In particular, the 'unique' requirement ? Looks to me like you capture every three letter combo, even if its already in your set.  But honestly, I have never heard of PascalABC until your message ....

Davo
Lazarus 2, Linux (and reluctantly Win10, OSX)
My Project - https://github.com/tomboy-notes/tomboy-ng

#### nixu3

• Newbie
• Posts: 3
##### Re: FreePascal: find all 3-symbol unique substring in string
« Reply #2 on: December 23, 2021, 07:43:05 am »
In PascalABC.NET program correctly work - all subsring unique.
FPC-compiler writen "Illegal type declaration of set elements" in "type Mnoj=Set Of string[3]; "

#### nummer8

• Jr. Member
• Posts: 89
##### Re: FreePascal: find all 3-symbol unique substring in string
« Reply #3 on: December 23, 2021, 09:24:10 am »
type Mnoj=Set Of string[3];
type Mnoj=Array Of string[3];

You can use the PosEx  function to search for a substring in a string from a defines starting point.
Loop through the input string from begin to end.

#### nixu3

• Newbie
• Posts: 3
##### Re: FreePascal: find all 3-symbol unique substring in string
« Reply #4 on: December 23, 2021, 10:14:59 am »
using "Set Of" in this program - impossible in FCP ?

#### MarkMLl

• Hero Member
• Posts: 4482
##### Re: FreePascal: find all 3-symbol unique substring in string
« Reply #5 on: December 23, 2021, 10:26:26 am »
using "Set Of" in this program - impossible in FCP ?

Only for simple types (i.e. individual characters etc.).

Please note that if you want people to help you need to copy the /exact/ error message you're seeing, including line number etc.

Also note that your teacher is probably watching, and if anybody does the entire job for you you'll get zero marks.

Having said that, there's an elegant way of doing this job which doesn't require any fancy language facilities.

* Work through the initial string character-by-character, extracting every three-letter group (i.e. including the overlap) into an array of three-letter strings.

* Sort that array.

* Count the remaining unique strings, skipping or counting duplicates.

MarkMLl
MT+86 & Turbo Pascal v1 on CCP/M-86, multitasking with LAN & graphics in 128Kb.
Pet hate: people who boast about the size and sophistication of their computer.
GitHub repositories: https://github.com/MarkMLl?tab=repositories

#### Martin_fr

• Hero Member
• Posts: 7969
• Debugger - SynEdit - and more
##### Re: FreePascal: find all 3-symbol unique substring in string
« Reply #6 on: December 23, 2021, 10:36:31 am »
using "Set Of" in this program - impossible in FCP ?

There are various "classes" to replace it, that may reduce your work by one or maybe two lines of code.
However, unless your teacher gave you the name of them; or unless you truly found and understand them all by yourself => I would really recommend not to go for any of them (hence I do not name them here).

TStringList is a class.
- So you need to "Create" it.
- You can use:
mylist.IndexOf to check if an entry exists.

Instead of IndexOp, you can go, find the documentation, and read it yourself. TStringList, can be configured to ignore duplicates. Then for your example it does the same work, as the set does.

#### marcov

• Hero Member
• Posts: 10084
• FPC developer.
##### Re: FreePascal: find all 3-symbol unique substring in string
« Reply #7 on: December 23, 2021, 10:41:39 am »
Maybe some tcollection or tstringlist would be working? I suspect there is some hash collection under the pascalabc.net construct too.

#### dbannon

• Hero Member
• Posts: 2042
##### Re: FreePascal: find all 3-symbol unique substring in string
« Reply #8 on: December 23, 2021, 11:53:42 am »
Personally, I'd use a stringlist. Probably not the most efficient way to solve the problem but IMHO, the easiest.  But, as Mark said, you teacher will have given you some pretty clear hints on how he/she expect you to solve this, please read back over your lecture notes.

https://wiki.freepascal.org/Stringlist - in case stringlist was mentioned.

Davo
Lazarus 2, Linux (and reluctantly Win10, OSX)
My Project - https://github.com/tomboy-notes/tomboy-ng

#### Bart

• Hero Member
• Posts: 4709
##### Re: FreePascal: find all 3-symbol unique substring in string
« Reply #9 on: December 23, 2021, 06:28:55 pm »
If you do not want to use the Classes or any other unit you can use an array of string like this:
Code: Pascal  [Select][+][-]
1. {\$mode objfpc}
2. {\$h+}
3.
4. type
5.   TStringArray = array of string;
6.
7. function IsInList(const S: String; List: TStringArray): Boolean;
8. var
9.   i: Integer;
10. begin
11.   Result := False;
12.   for i := Low(List) to High(List) do
13.     if List[i] = S then Exit(True);
14. end;
15.
16. var
17.   List: TStringArray;
18.   S, Sub: String;
19.   i, Idx: Integer;
20. begin
21.   List := nil;
22.   write('Enter string: ');
24.   if Length(S) > 2 then
25.   begin
26.     SetLength(List, Length(S)-2);
27.     Idx := -1;
28.     for i := 1 to Length(S) - 2 do
29.     begin
30.       Sub :=  S[i] + S[i+1] + S[i+2];
31.       if not IsInList(Sub, List) then
32.       begin
33.         Inc(Idx);
34.         List[Idx] := Sub;
35.       end;
36.     end;
37.     SetLength(List, Idx+1);
38.   end;
39.   writeln('Number of unique substrings of 3 characters: ',Length(List));
40.   for i := Low(List) to High(List) do writeln(i:2,': ',List[i]);
41. end.

There are no comments in the code explaining anything, that's on purpose.

Bart

#### Bart

• Hero Member
• Posts: 4709
##### Re: FreePascal: find all 3-symbol unique substring in string
« Reply #10 on: December 23, 2021, 10:19:53 pm »
And for those who want a more Enterpise type of solution:
Code: Pascal  [Select][+][-]
1. {\$mode objfpc}
2. {\$h+}
3.
4. uses
5.   SysUtils, Classes;
6.
7. type
8.
9.   { TUniqueSequenceParser }
10.
11.   generic TUniqueSequenceParser<T, TAtom> = class
12.   private
13.     FSubLen: Integer;
14.     FList: Array of T;
15.     FTheThingToParse: T;
16.     function IsInList(const Sub: T): Boolean;
17.     procedure SetSubLen(AValue: Integer);
18.   protected
19.     function Equal(Item1, Item2: T): Boolean; virtual; abstract;
20.     function GetAtom(Index: Integer): TAtom; virtual; abstract;
21.     function Concat(Item1: T; Item2: TAtom): T; virtual; abstract;
22.     function ItemLength(Item: T): Integer; virtual; abstract;
23.     function GetParseCount: Integer;
24.     function GetSub(StartIndex: Integer): T;
25.     procedure InsertInList(Index: Integer; AItem: T); virtual;
26.     procedure Parse;
27.     procedure Report(Verbose: Boolean);
28.     procedure Clear;
29.   public
30.     constructor Create; virtual;
31.     property SubLen: Integer read FSubLen write SetSubLen default 3;
32.     property TheThingToParse: T read FTheThingToParse write FTheThingToParse;
33.     property ParseCount: Integer read GetParseCount;
34.   end;
35.
36. { TUniqueSequenceParser }
37.
38. function TUniqueSequenceParser.IsInList(const Sub: T): Boolean;
39. var
40.   i: Integer;
41. begin
42.   Result := False;
43.   for i := Low(FList) to High(FList) do
44.     if EQual(Sub, FList[i]) then Exit(True);
45. end;
46.
47. procedure TUniqueSequenceParser.SetSubLen(AValue: Integer);
48. begin
49.   if FSubLen = AValue then Exit;
50.   if AValue < 1 then
51.     AValue := 1;
52.   FSubLen := AValue;
53. end;
54.
55.
56. function TUniqueSequenceParser.GetParseCount: Integer;
57. begin
58.   Result := Length(FList);
59. end;
60.
61. function TUniqueSequenceParser.GetSub(StartIndex: Integer): T;
62. var
63.   LoopCount, i: Integer;
64. begin
65.   Result := Default(T);
66.   LoopCount := SubLen - 1;
67.   if LoopCount < 0 then
68.     Exit;
69.   for i := StartIndex to StartIndex + LoopCount do
70.   begin
71.     Result := Concat(Result, GetAtom(i));
72.   end;
73. end;
74.
75. procedure TUniqueSequenceParser.InsertInList(Index: Integer; AItem: T);
76. begin
77.   FList[Index] := AItem;
78. end;
79.
80. procedure TUniqueSequenceParser.Parse;
81. var
82.   Len, i, Idx: Integer;
83.   Sub: T;
84. begin
85.   Len := ItemLength(FTheThingToParse);
86.   if Len < SubLen then
87.     Exit;
88.   SetLength(FList, Len-SubLen+1);
89.   Idx := -1;
90.   for i := 1 to Len - (FSubLen-1) do
91.   begin
92.     Sub := GetSub(i);
93.     if not IsInList(Sub) then
94.     begin
95.       Inc(Idx);
96.       InsertInList(Idx, Sub);
97.     end;
98.   end;
99.   SetLength(FList, Succ(Idx));
100. end;
101.
102. procedure TUniqueSequenceParser.Report(Verbose: Boolean);
103. var
104.   i: Integer;
105. begin
106.   if Verbose then
107.     writeln(format('%d unique subitems of length %d found',[ParseCount, SubLen]));
108.   for i := 0 to ParseCount - 1 do
109.   begin
110.     if verbose then write(Succ(i):2,': ');
111.     writeln(FList[i]);
112.   end;
113. end;
114.
115. procedure TUniqueSequenceParser.Clear;
116. begin
117.   FList := nil;
118.   FTheThingToParse := default(T);
119. end;
120.
121. constructor TUniqueSequenceParser.Create;
122. begin
123.   inherited Create;
124.   FList := nil;
125.   FTheThingToParse := default(T);
126.   FSubLen := 3;
127. end;
128.
129. type
130.
131.   { TStringParser }
132.
133.   TStringParser = class (specialize TUniqueSequenceParser<String, Char>)
134.   private
135.     FCaseSensitive: Boolean;
136.   protected
137.     function Equal(Item1, Item2: String): Boolean; override;
138.     function GetAtom(Index: Integer): Char; override;
139.     function Concat(Item1: String; Item2: Char): String; override;
140.     function ItemLength(Item: String): Integer; override;
141.     procedure InsertInList(Index: Integer; AItem: String); override;
142.   public
143.     constructor Create; override;
144.     property CaseSensitive: Boolean read FCaseSensitive write FCaseSensitive default True;
145.   end;
146.
147. { TStringParser }
148.
149. function TStringParser.Equal(Item1, Item2: String): Boolean;
150. begin
151.   if FCaseSensitive then
152.     Result := (CompareStr(Item1, Item2) = 0)
153.   else
154.     Result := (CompareText(Item1, Item2) = 0);
155. end;
156.
157. function TStringParser.GetAtom(Index: Integer): Char;
158. begin
159.   Result := FTheThingToParse[Index];
160. end;
161.
162. function TStringParser.Concat(Item1: String; Item2: Char): String;
163. begin
164.   Result := Item1 + Item2;
165. end;
166.
167. function TStringParser.ItemLength(Item: String): Integer;
168. begin
169.   Result := Length(Item);
170. end;
171.
172. procedure TStringParser.InsertInList(Index: Integer; AItem: String);
173. begin
174.   if not FCaseSensitive then
175.     AItem := LowerCase(AItem);
176.   inherited InsertInList(Index, AItem);
177. end;
178.
179. constructor TStringParser.Create;
180. begin
181.   inherited Create;
182.   FCaseSensitive := True;
183. end;
184.
185.
186. var
187.   S: String;
188.   Parser: TStringParser;
189. begin
190.   repeat
191.     Parser := TStringParser.Create;
192.     try
193.       Parser.SubLen := 3;
194.       write('Enter string: ');
196.       Parser.TheThingToParse := S;
197.       write('Casesensitive [yes|no]: ');
199.       Parser.CaseSensitive := (CompareText(S, 'YES') = 0);
200.       Parser.Parse;
201.       Parser.Report(True);
202.     finally
203.       Parser.Free;
204.     end;
205.   until (S='');
206. end.

I dare you to submit that ...

Bart

#### BobDog

• Sr. Member
• Posts: 266
##### Re: FreePascal: find all 3-symbol unique substring in string
« Reply #11 on: December 29, 2021, 03:33:50 pm »

A vert fast method, but a problem, the code block won't accept the characters ' which surround a string.
You should change &#39 to '

Code: Pascal  [Select][+][-]
1. uses
2. sysutils;
3.
4.
5. Type
6.   intArray = Array of longword;
7.
8.   function tally(somestring:ansistring;partstring:ansistring;var arr:intarray ):longword;
9. var
10. i,j,ln,lnp,count,num:longword;
11. filler:boolean=false;
12. label
13. skip,start,return;
14. begin
15. ln:=length(somestring);
16. lnp:=length(partstring);
17. start:
18. count:=0;
19. i:=0;
20. repeat
21. i:=i+1;
22.    if somestring[i] <> partstring[1] then goto skip ;
23.      if somestring[i] = partstring[1] then
24.      begin
25.      for j:=0 to lnp-1 do
26.      begin
27.      if somestring[j+i]<>partstring[j+1] then goto skip;
28.      end;
29.       count:=count+1;
30.       if filler = true then arr[count]:=i ;
31.       i:=i+lnp-1;
32.      end ;
33.    skip:
34.    until i>=ln-0 ;
35.    SetLength(arr,count);
36.    arr[0]:=count;
37.   num:=count;
38.   if filler=true then goto return;
39. filler:=true;
40.   goto start;
41.    return:
42.   result:=num;
43. end; {tally}
44.
45. var
46. a:ansistring='abcabc6755abcabcyyabcabcabc';
47. i:intarray;
48. j:integer;
49.
50. begin
51. writeln('substring  ',QuotedStr('abc'));
52. writeln('main string  ',QuotedStr(a),'   length =   ',length(a));
53.
54. writeln('Number of occurrencies ',tally(a,'abc',i));
55. writeln('Positions within string:  ');
56. for j:=1 to high(i)+1 do write(i[j],' ');
57. writeln;
58. writeln('Press enter to end . . .');
60. end.
61.

• Hero Member
• Posts: 11632
##### Re: FreePascal: find all 3-symbol unique substring in string
« Reply #12 on: January 13, 2022, 11:16:47 am »
A vert fast method, but a problem, the code block won't accept the characters ' which surround a string.
This is fixed.
Black themes should be banned.

#### engkin

• Hero Member
• Posts: 3112
##### Re: FreePascal: find all 3-symbol unique substring in string
« Reply #13 on: January 13, 2022, 06:35:54 pm »
@BobDog,

Your solution does not count "unique" 3-char strings, it counts a specific substr.
« Last Edit: January 13, 2022, 06:39:25 pm by engkin »

#### BobDog

• Sr. Member
• Posts: 266
##### Re: FreePascal: find all 3-symbol unique substring in string
« Reply #14 on: January 13, 2022, 11:11:34 pm »

I see what you mean now, engkin.
try this method maybe:
Code: Pascal  [Select][+][-]
1.
2. {\$R+}
3.
4. type aos=array of ansistring;
5.
6. procedure clean(a:aos;var b:aos);
7. var
8. flag:int32=0;
9. count:int32=1;
10. n1,n2:int32;
11. begin
12. setlength(b,high(a)+1);
13. b[0]:=a[0];
14.     For n1 :=1 To high(a) do
15.     begin
16.         flag:=0;
17.         For n2 :=0 to  n1-1 do
18.         begin
19.             If (a[n1]=a[n2]) Then
20.             begin
21.             flag:=1;
22.             break;
23.             end;
24.         end;
25.         If (flag=0) Then
26.         begin
27.             b[count]:=a[n1];
28.             count:=count+1;
29.         End;
30.     end;
31.    setlength(b,count);
32. end;
33.
34. procedure parse(s:ansistring;var b:aos);
35. var
36. i:int32;
37. a:aos;
38. begin
39. if (length(s)=3) then
40. begin
41. setlength(b,1);
42. b[0]:=s;
43. exit;
44. end;
45. for i:=1 to length(s)-2 do
46. begin
47. setlength(a,i);
48. a[i-1]:=s[i..i+2];
49. end;
50. clean(a,b);
51. end;
52.
53. var
54. s:ansistring;
55. ans:aos;
56. j:int32;
57.
58. begin
59. while (s<>'q') do
60. begin
61. write('Enter string at least 3 characters (or q to quit): ');
63.  if (s='q') then exit;
64.  parse(s,ans);
65.  for j:=0 to high(ans) do writeln(j+1,'  ',ans[j]);