Forum > Beginners

FreePascal: find all 3-symbol unique substring in string

<< < (3/4) > >>

Bart:
And for those who want a more Enterpise type of solution:

--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---{$mode objfpc}{$h+} uses  SysUtils, Classes; type   { TUniqueSequenceParser }   generic TUniqueSequenceParser<T, TAtom> = class  private    FSubLen: Integer;    FList: Array of T;    FTheThingToParse: T;    function IsInList(const Sub: T): Boolean;    procedure SetSubLen(AValue: Integer);  protected    function Equal(Item1, Item2: T): Boolean; virtual; abstract;    function GetAtom(Index: Integer): TAtom; virtual; abstract;    function Concat(Item1: T; Item2: TAtom): T; virtual; abstract;    function ItemLength(Item: T): Integer; virtual; abstract;    function GetParseCount: Integer;    function GetSub(StartIndex: Integer): T;    procedure InsertInList(Index: Integer; AItem: T); virtual;    procedure Parse;    procedure Report(Verbose: Boolean);    procedure Clear;  public    constructor Create; virtual;    property SubLen: Integer read FSubLen write SetSubLen default 3;    property TheThingToParse: T read FTheThingToParse write FTheThingToParse;    property ParseCount: Integer read GetParseCount;  end; { TUniqueSequenceParser } function TUniqueSequenceParser.IsInList(const Sub: T): Boolean;var  i: Integer;begin  Result := False;  for i := Low(FList) to High(FList) do    if EQual(Sub, FList[i]) then Exit(True);end; procedure TUniqueSequenceParser.SetSubLen(AValue: Integer);begin  if FSubLen = AValue then Exit;  if AValue < 1 then    AValue := 1;  FSubLen := AValue;end;  function TUniqueSequenceParser.GetParseCount: Integer;begin  Result := Length(FList);end; function TUniqueSequenceParser.GetSub(StartIndex: Integer): T;var  LoopCount, i: Integer;begin  Result := Default(T);  LoopCount := SubLen - 1;  if LoopCount < 0 then    Exit;  for i := StartIndex to StartIndex + LoopCount do  begin    Result := Concat(Result, GetAtom(i));  end;end; procedure TUniqueSequenceParser.InsertInList(Index: Integer; AItem: T);begin  FList[Index] := AItem;end; procedure TUniqueSequenceParser.Parse;var  Len, i, Idx: Integer;  Sub: T;begin  Len := ItemLength(FTheThingToParse);  if Len < SubLen then    Exit;  SetLength(FList, Len-SubLen+1);  Idx := -1;  for i := 1 to Len - (FSubLen-1) do  begin    Sub := GetSub(i);    if not IsInList(Sub) then    begin      Inc(Idx);      InsertInList(Idx, Sub);    end;  end;  SetLength(FList, Succ(Idx));end; procedure TUniqueSequenceParser.Report(Verbose: Boolean);var  i: Integer;begin  if Verbose then    writeln(format('%d unique subitems of length %d found',[ParseCount, SubLen]));  for i := 0 to ParseCount - 1 do  begin    if verbose then write(Succ(i):2,': ');    writeln(FList[i]);  end;end; procedure TUniqueSequenceParser.Clear;begin  FList := nil;  FTheThingToParse := default(T);end; constructor TUniqueSequenceParser.Create;begin  inherited Create;  FList := nil;  FTheThingToParse := default(T);  FSubLen := 3;end; type   { TStringParser }   TStringParser = class (specialize TUniqueSequenceParser<String, Char>)  private    FCaseSensitive: Boolean;  protected    function Equal(Item1, Item2: String): Boolean; override;    function GetAtom(Index: Integer): Char; override;    function Concat(Item1: String; Item2: Char): String; override;    function ItemLength(Item: String): Integer; override;    procedure InsertInList(Index: Integer; AItem: String); override;  public    constructor Create; override;    property CaseSensitive: Boolean read FCaseSensitive write FCaseSensitive default True;  end; { TStringParser } function TStringParser.Equal(Item1, Item2: String): Boolean;begin  if FCaseSensitive then    Result := (CompareStr(Item1, Item2) = 0)  else    Result := (CompareText(Item1, Item2) = 0);end; function TStringParser.GetAtom(Index: Integer): Char;begin  Result := FTheThingToParse[Index];end; function TStringParser.Concat(Item1: String; Item2: Char): String;begin  Result := Item1 + Item2;end; function TStringParser.ItemLength(Item: String): Integer;begin  Result := Length(Item);end; procedure TStringParser.InsertInList(Index: Integer; AItem: String);begin  if not FCaseSensitive then    AItem := LowerCase(AItem);  inherited InsertInList(Index, AItem);end; constructor TStringParser.Create;begin  inherited Create;  FCaseSensitive := True;end;  var  S: String;  Parser: TStringParser;begin  repeat    Parser := TStringParser.Create;    try      Parser.SubLen := 3;      write('Enter string: ');      readln(S);      Parser.TheThingToParse := S;      write('Casesensitive [yes|no]: ');      readln(S);      Parser.CaseSensitive := (CompareText(S, 'YES') = 0);      Parser.Parse;      Parser.Report(True);    finally      Parser.Free;    end;  until (S='');end.
I dare you to submit that ...

Bart

BobDog:

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  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---usessysutils;  Type    intArray = Array of longword;    function tally(somestring:ansistring;partstring:ansistring;var arr:intarray ):longword;vari,j,ln,lnp,count,num:longword;filler:boolean=false;labelskip,start,return;beginln:=length(somestring);lnp:=length(partstring);start:count:=0;i:=0;repeati:=i+1;   if somestring[i] <> partstring[1] then goto skip ;     if somestring[i] = partstring[1] then     begin     for j:=0 to lnp-1 do     begin     if somestring[j+i]<>partstring[j+1] then goto skip;     end;      count:=count+1;      if filler = true then arr[count]:=i ;      i:=i+lnp-1;     end ;   skip:   until i>=ln-0 ;   SetLength(arr,count);   arr[0]:=count;   num:=count;  if filler=true then goto return;filler:=true;  goto start;   return:  result:=num;end; {tally} vara:ansistring='abcabc6755abcabcyyabcabcabc';i:intarray;j:integer; beginwriteln('substring  ',QuotedStr('abc'));writeln('main string  ',QuotedStr(a),'   length =   ',length(a)); writeln('Number of occurrencies ',tally(a,'abc',i));writeln('Positions within string:  ');for j:=1 to high(i)+1 do write(i[j],' ');writeln;writeln('Press enter to end . . .');readln;end. 

Thaddy:

--- Quote from: BobDog 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.

--- End quote ---
This is fixed.

engkin:
@BobDog,

Your solution does not count "unique" 3-char strings, it counts a specific substr.

BobDog:

I see what you mean now, engkin.
try this method maybe:

--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} --- {$R+} type aos=array of ansistring; procedure clean(a:aos;var b:aos);varflag:int32=0;count:int32=1;n1,n2:int32;beginsetlength(b,high(a)+1);b[0]:=a[0];    For n1 :=1 To high(a) do    begin        flag:=0;        For n2 :=0 to  n1-1 do        begin                   If (a[n1]=a[n2]) Then             begin            flag:=1;            break;            end;         end;        If (flag=0) Then        begin            b[count]:=a[n1];            count:=count+1;        End;    end;    setlength(b,count);end; procedure parse(s:ansistring;var b:aos);vari:int32;a:aos;beginif (length(s)=3) thenbeginsetlength(b,1);b[0]:=s;exit;end;for i:=1 to length(s)-2 do beginsetlength(a,i);a[i-1]:=s[i..i+2];end;clean(a,b);end; vars:ansistring;ans:aos;j:int32; beginwhile (s<>'q') dobeginwrite('Enter string at least 3 characters (or q to quit): '); read(s); if (s='q') then exit; parse(s,ans); for j:=0 to high(ans) do writeln(j+1,'  ',ans[j]); readln; end;end.   Tested 64 bits, windows.
Thanks Thaddy.

Navigation

[0] Message Index

[#] Next page

[*] Previous page

Go to full version