Recent

Author Topic: FreePascal: find all 3-symbol unique substring in string  (Read 10397 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][+][-]
  1. Program Zadanie2;
  2. type Mnoj=Set Of string[3];    
  3. var S: string;
  4.     i: integer;
  5.     Mn3: Mnoj;
  6. begin
  7.  write('String: ');
  8.  readln(S);
  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: 2778
    • tomboy-ng, a rewrite of the classic Tomboy
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 and my github - https://github.com/davidbannon

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

  • Full Member
  • ***
  • Posts: 106
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: 6646
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

  • Administrator
  • Hero Member
  • *
  • Posts: 9754
  • Debugger - SynEdit - and more
    • wiki
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 ?

For your purpose: Yes, impossible.

There is "TStringList" that can help you.

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.Add()  to add new entries
  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

  • Administrator
  • Hero Member
  • *
  • Posts: 11351
  • 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: 2778
    • tomboy-ng, a rewrite of the classic Tomboy
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 and my github - https://github.com/davidbannon

Bart

  • Hero Member
  • *****
  • Posts: 5265
    • Bart en Mariska's Webstek
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: ');
  23.   readln(S);
  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: 5265
    • Bart en Mariska's Webstek
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: ');
  195.       readln(S);
  196.       Parser.TheThingToParse := S;
  197.       write('Casesensitive [yes|no]: ');
  198.       readln(S);
  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: 394
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 . . .');
  59. readln;
  60. end.
  61.  

Thaddy

  • Hero Member
  • *****
  • Posts: 14157
  • Probably until I exterminate Putin.
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.
Specialize a type, not a var.

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: 394
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): ');
  62.  read(s);
  63.  if (s='q') then exit;
  64.  parse(s,ans);
  65.  for j:=0 to high(ans) do writeln(j+1,'  ',ans[j]);
  66.  readln;
  67.  end;
  68. end.
  69.  
  70.  
  71.  
Tested 64 bits, windows.
Thanks Thaddy.


 

TinyPortal © 2005-2018