program SubstringsWithKDistinct;
const
MaxLen = 255; // maximum string length we allow
MaxSubs = 1000; // maximum number of substrings to store
type
TStringArray = array[1..MaxSubs] of string;
CharSet = set of char; // define a named set type for distinct characters
var
str: string;
substrings: TStringArray;
subCount: integer;
k: integer;
//-------------------------------------------------------------
// Function: SetCardinality
// Purpose: Count how many distinct characters are in a set
//-------------------------------------------------------------
function SetCardinality(seen: CharSet): integer;
var
c: char;
cnt: integer;
begin
cnt := 0;
// loop through all possible characters in ASCII range
for c := #0 to #255 do
if c in seen then
inc(cnt); // increment count if character is present
SetCardinality := cnt;
end;
//-------------------------------------------------------------
// Procedure: GetSubstringsWithKDistinct
// Purpose: Collect all substrings of s that contain exactly
// k distinct characters
//-------------------------------------------------------------
procedure GetSubstringsWithKDistinct(s: string; k: integer; var result: TStringArray; var count: integer);
var
i, j: integer;
sub: string;
seen: CharSet;
begin
count := 0; // initialize substring counter
// iterate over all possible starting positions
for i := 1 to length(s) do
begin
seen := []; // reset set of seen characters
// extend substring from position i to j
for j := i to length(s) do
begin
sub := copy(s, i, j - i + 1); // extract substring
seen := seen + [s[j]]; // add current char to set
// check number of distinct characters
if SetCardinality(seen) = k then
begin
inc(count); // found valid substring
result[count] := sub; // store it in result array
end
else if SetCardinality(seen) > k then
break; // stop if too many distinct chars
end;
end;
end;
//-------------------------------------------------------------
// Main program
//-------------------------------------------------------------
var
i: integer;
begin
str := 'characters';
k := 4;
// generate substrings
GetSubstringsWithKDistinct(str, k, substrings, subCount);
writeln('Number of substrings with exactly ', k, ' distinct characters = ', subCount);
writeln;
writeln('Substrings with exactly ', k, ' distinct characters in "', str, '":');
for i := 1 to subCount do
writeln(substrings[i]);
end.
(*
run:
Number of substrings with exactly 4 distinct characters = 9
Substrings with exactly 4 distinct characters in "characters":
char
chara
charac
harac
aract
ract
acte
cter
ters
*)
