Вопрос Напишите пожалуйста код в pascal

[cfi]

Дана последовательность, содержащая от 1 до 30 слов, в каждом из которых от 1до 5 строчных латинских букв; между соседними словами – запятая, за последнимсловом – точка. Вывести все слова, которые встречаются по одному разу.

 

[ДИМАСТЫЙ]

Код

 

[dfzxfzd]

program UniqueWords;
uses sysutils;

const
MAXWORDS = 30; // maximum number of words in the sequence
MAXLENGTH = 5; // maximum length of a word

type
TStringArray = array[1..MAXWORDS] of string; // array of strings

var
Sequence: TStringArray; // input sequence
Count: array[1..MAXWORDS] of integer; // count of each word in the sequence
NumWords, i, j: integer; // number of words in the sequence, loop variables

begin
// Read the input sequence
write('Enter the sequence: '
NumWords := 0;
repeat
Inc(NumWords);
read(Sequence[NumWords]);
until Sequence[NumWords][Length(Sequence[NumWords])] = '.';

// Count the occurrences of each word
for i := 1 to NumWords do begin
Count := 1;
for j := i + 1 to NumWords do begin
if Sequence = Sequence[j] then begin
Inc(Count);
Sequence[j] := ''; // mark the repeated word as empty
end;
end;
end;

// Print the words that occur once
writeln('Words that occur once: '
for i := 1 to NumWords do begin
if (Sequence <> '&#39 and (Count = 1) then begin
writeln(Sequence);
end;
end;
end.

 

[вере]

код в pascal

 

[Ghost]

var
str: string;
words: array[1..30] of string;
count: array[1..30] of integer;
i, j, k, n: integer;
uniqueWords: array[1..30] of string;
begin
readln(str);

n := 0;
i := 1;
while i = 1) and (str[j] ',') do dec(j);
words[n] := copy(str, j+1, i-j-1);
end
else if str = '.' then
begin
inc;
j := i - 1;
while (j >= 1) and (str[j] ',') do dec(j);
words[n] := copy(str, j+1, i-j-1);
end;
inc(i);
end;

for i := 1 to n do
count := 0;

for i := 1 to n do
begin
for j := 1 to n do
begin
if (i j) and (words = words[j]) then
begin
inc(count);
inc(count[j]);
end;
end;
end;

k := 0;
for i := 1 to n do
begin
if count = 0 then
begin
inc(k);
uniqueWords[k] := words;
end;
end;

for i := 1 to k-1 do
write(uniqueWords, ', ');

writeln(uniqueWords[k], '.');
end.