Проверти код! на паскале! Спасибо!

[Impulsive]

#2
Дана непустая последовательность слов из строчных русских букв; между соседними словами - запятая, за последним словом - точка. Напечатать в алфавитном порядке:
все глухие согласные буквы, которые входят в каждое нечетное слово и не входят хотябы в одно четное слово.
Примечание: гласные буквы: а,е,и,о,у,ы,э,ю,я (без ё); согласные - все остальные буквы, кроме й,ь,ъ; звонкие согласные - б,в,г,д,ж,з,л,м,н,р; глухие согласные - к,п,с,т,ф,х,ц,ч,ш,щ.

Не правильный ответ вывод, то букву содержащюю в нечетном и четном слове, то какую другую букву...

{Дана непустая последовательность слов из строчных русских букв; между соседними словами - запятая, за последним словом - точка
 Напечатать в алфавитном порядке:
все глухие согласные буквы, которые входят в каждое нечетное слово и не входят хотябы в одно четное слово.
Примечание: гласные буквы: глухие согласные - к,п,с,т,ф,х,ц,ч,ш,щ.}
Uses crt;{подключение библиотек модулей.}
const gluh=['к','п','с','т','ф','х','ц','ч','ш','щ']; {глухие звуки - (русский язык)}
      z=11;
type wrds=array[1..100] of string;
var l{в нее считываем},cs,s,s1{чистые строки, используются как черновики и буфера обмена}:string; {строи}
    ww,w2:wrds;{массивы из слов, один для слов из последовательности, другой для оставшихся от этих сло глухих букв}
    j,n,i,len,o,k,i1,n1,df,w:integer; {счетчики и переходники}
    d,b:boolean; {логич. для Да/Нет, чтобы выполнялись условия}
    ch:char;{чаровская переменная для символов}
    c:array[1..z] of char;{массив символов для чистых глухих букв, для вывода их на экран без повторения.}
begin
ClrScr;{процедура очищения экрана, из модуля Crt}
Writeln('Введите последовательность слов');
readln(l);
i:=1; {**разбиваем послед-ть на отдельные слова}
j:=1;
cs:='';
while l[i]<>'.' do begin {пока не точка}
if l[i]=',' then   {если запятая}
begin
ww[j]:=cs;        {считываем с последовательности в слова}
cs:='';
inc(j);
end else cs:=cs+l[i];
inc(i);
end;
ww[j]:=cs;{кста, LEN  это кол-во слов в последовательности}
len:=j;{/**все слова из послед-ти находяться в массиве слов WW}
{** рассматриваем каждое слово и выделяем глухие согласные, все остальное удаляем}
for i:=1 to len do begin {циклом рассматриваем каждое слово в массиве}
 s:=ww[i];n:=length(s);
 for j:=1 to n do begin
   if s[j] in gluh then inc(o)  {если элемент есть в константе, то увеличить на 1}
   else delete(s,j,1);{удалить все кроме глухих букв}
 end;
w2[i]:=s;{во второй массив присваиваем оставшиеся глухие буквы из слов}
end;
writeln;
k:=1;df:=0;cs:=''; w:=1;          {это самый тупой поиск, который я хоть раз делала в своей жизни}

For i:=1 to len do begin         {С 1го до последнего слова, с оставшимися глухими буквами}
  S:=w2[i]; N:=length(S);        {строке:= слово, N кол-во символов в строке}
   For j:=1 to n do begin        {с первото символа до последнего}
    ch:=s[j];                    {чаровской переменной присв. порядковый символ}
    while k<= len do begin       {пока К меньше либо равно кол-ву слов}
      if k=i then inc(k)         {если К равно тому слову, символы которого мы используем, то увеличить на 1}
       else  begin               {иначе}
         S1:=w2[k];N1:=length(s1);{строке := слово, не равное рассматриваему, Н1 длина слова соответственно}
          while i1<= n1 do begin   {пока счетчик не равен длине слова}
           if ch = s1[i1] then begin {проверяем равенство чаровской переменной и порядкового символа слова}
            b:=true;break; end  {если да, то b=правда , выход из цикла}
           else if k mod 2=0 then {если нет, то проверяем чет/нечет}
            begin
             b:=true; inc(df);break; end {если четное, то удовлетв условию, ставим опознавательный знак.}
                else begin b:=false; break; end;  {иначе, нам не подходит}
         end;
      inc(k); {переход к следующему слову}
      end;
    end;
  end;
  if (b=true) and (df<>0)  then begin {если правда, и опознавательный знак существует}
   while c[w]<>#0 do begin  {то, пока элемент массива символов не равен ПУСТО выполнять}
    if ch=c[w] then d:=true;  {если данный символ уже присутствует в данном массиве}
    break;                    {то логическое Да, и выход из цикла}
   end;
  if d=false then  c[w]:=ch;  {если логическое Нет не изменилось, то в массив записать этот символ}
end;w:=1;
end;{/*** поиск закончен.}
while c[w]<>#0 do begin  {пока порядковый элемент массива не пустой }
 write(c[w]:3); inc(W);  {вывод на экран символов удовлетворяющих условию задачи}
end;                     {:3 значит выводить на экран через промежуток равный трем пустым знакам}
readln;                  {выход из программы на нажатие клавиши ENTER}
end.

[alexBlack]

Ну, если вы смогли это написать, значит оно работает. Я, например, потерял
нить рассуждений где-то на третьем цикле. Попробуем сделать проще ?

Начало практически правильно. В соответствии с условиями. Только одно
замечание. Точки может не быть и цикл не закончится.

Мы немного изменим. Сами слова нам не нужны. Нам нужно множество символов
в каждом слове. Так и запишем:

type setOfChar = set of char;
var ww : array [1..100] of setOfChar;

i:=1;
j:=1;
while (i<= length(l)) and (l[i]<>'.') do begin
   if l[i]=',' then begin
      inc(j);
   end else begin
      include(ww[j], l[i]);
   end;
   inc(i);
end;
len := j;

Теперь ww содержит множества символов в каждом слове.
Подсчитаем в каких словах встречается каждый из символов.

const gluh : array [1..10] of char = ('к','п','с','т','ф','х','ц','ч','ш','щ'); // глухие звуки
var pODD : array [1..10] of byte;        // Количество нечетных слов, в которых встречается соответсвующий символ
    pEven: array [1..10] of byte;        // Количество четных слов, в которых встречается соответсвующий символ

   // Сбрасываем все признаки
   // не помню, есть ли в Pascal
   // fillChar(pOdd, sizeOf(pOdd), 0);
   // fillChar(pEven, sizeOf(pEven), 0);
   for i:=1 to 10 do begin
      pODD[i] := 0;
      pEven[i] := 0;
   end;

   // проверяем в каких словах встречаются символы
   for i:=1 to 10 do begin
      C := gluh[i];
      for j := 1 to len do begin
          if C in ww[j] then begin
             if j mod 2 = 0
             then inc(pEven[i])
             else inc(pOdd[i]);
          end;
      end;
   end;

Далее определим количество четных и нечетных слов
Например,
6 div 2 = 3, 6 div 2 + 6 mod 2 = 3
5 div 2 = 2, 5 div 2 + 5 mod 2 = 3

   CP := len div 2;              // Количество четных слов
   CO := len div 2 + len mod 2;  // Количество нечетных слов

Ну, и наконец, вывод. Символы уже в алфавитном порядке.
Осталось проверить условия:

   S := '';
   for i:=1 to 10 do begin
      if (pOdd[i] = CO) and // входит в каждое нечетное
         (pEven[i] < CP)    // не входит хотя бы в одно четное
      then S := S + gluh[i];
   end;

   WriteLn(S);

Теперь проверка:
Вводим строку L := 'тфпк,тфп,тфпк,тпк,тфпк.';
получаем 'кф'

По моему ничего не напутал.

Остальные переменные:

var C:char;
    CP, CO, i, j, len:integer;
    L, S : String;

И еще одно. Очевидные комментарии только запутают код, например:

{если логическое Нет не изменилось, то в массив записать этот символ}

лишнее.

Благодарю за внимание. Удачи.

[Impulsive]

Спасибо - воспользовался!