Помогите или подскажите как решить!!!!

[andryuha]

блин все никак не могу понять как одну задачку решить вот она:
Написать программу на обработку одномерного массива. Дана непустая последовательность слов из строчных букв (количество слов > 3): между соседними словами - запятая, за последним словом - точка. Вывести все буквы, которые входят не менее чем в три слова последовательно-сти.
как только я ее не пытался решить! ну ни как не получаеться.на слова делил а да дальше что как поиск осуществить!
вот что у меня получилось:

program lab_5.1;
{$APPTYPE CONSOLE}
uses
SysUtils;
var
str:string[255];
s1,s2,s3:string[40];
i,j,p:integer;

begin
str:='Omnia mea mecum.';
j:=0;
for i:=1 to length(str) do
begin
if (j=0) then
begin
j:=j+1;
p:=pos(' ',str);
s1:=Copy(str,i,p);
delete (str,i,p);
Write(s1);
end;
readln;
if (j=1) then
begin
j:=j+1;
p:=pos(' ',str);
s2:=Copy(str,i,p);
delete (str,i,p);
Write(s2);
end;
readln;
if (j=2) then
begin
j:=j+1;
p:=pos('.',str);
s3:=Copy(str,i,p);
delete (str,i,p);
Write(s3);
end;
end;

for i:=1 to 10 do
begin
if s1=s2 then write (Copy(s1,i,1);
readln;
end;
end.

помогите или хотябы подскажите как решить

[andryuha]

забыл сказать задачка в паскале

[drummer]

ты написал что между словами запятая, а у самого в сырцах пробел!?

Приведи пример!

[andryuha]

да не обрашай внимания это я запарился!там же не принципиально это я исправлю! А пример у меня вот: str:='Omnia mea mecum.'; видишь запятых нет!

[drummer]

Код: Выделить всё

program resh;

{$APPTYPE CONSOLE}

uses
  SysUtils;

var i,j,k,l,n,m:longint;
     s,s1:string;
     ars:array[1..100] of string;

 procedure razb;
  var i:longint;
  begin
     n:=1;//кол-во слов;
     for i:=1 to length(s) do
     begin
       if s[i]='.' then exit;
       if s[i]=' ' then inc(n)
                   else ars[n]:=ars[n]+s[i];
     end;
  end;

function ne_nashli_ranshe(x:char):boolean;
var i:longint;
begin
  ne_nashli_ranshe:=false;
  for i:=1 to length(s1) do
    if s1[i]=x then exit;
  ne_nashli_ranshe:=true;
end;

begin
  s:='Omnia mea mecum.';

  //разбиваем на слова;
  razb;

  for i:=1 to n-1 do
    begin

     for k:=1 to length(ars[i][k]) do
      if ne_nashli_ranshe(ars[i][k])
        then
          begin
            l:=1;//кол-во слов в которые входит
            for j:=i+1 to n do
              begin
                for m:=1 to length(ars[j]) do
                  if ars[i][k]=ars[j][m]
                    then begin inc(l);length(ars[j]);end;
              end;
            if l>=3 then s1:=s1+ars[i,k];
          end;
    end;
  writeln(s1);
end.

Если что не понятно - спрашивай.

[andryuha]

ок большое спасибо!

[andryuha]

проверил!у меня что то не работает!показывает только m! и я не все понял ars[k]!вот эта часть понятна ars а остальная нет !из за этого не все понял!

[drummer]

Пример строки где не работает

[andryuha]

программа ошибок не показывает а вот в поиске одинаковых букв что то не так

[drummer]

ну приведи пример, где она неправильно выводит