Спам строка

[darts116]

Здравствуйте! Решил написать программу для переименовывания песен. В этой программе мне понадобилась функция которая проверяла бы является ли строка спамом, наверняка каждому попадались на глаза песни с названиями что то вроде "b3vg3vv34c2hxyduvcJA". Написал кое что но мне кажется что это нечто не эффективно примерно 50-60% проходит. помогите усовершенствовать илибо в корни изменить мой код. исходник программы для тестирования прилагается.

Function SoglasnSimbol(c:Char):ShortInt;
const
EngSog: set of Char =['B','C','D','F','G','H','J','K','L','M','N',
'P','Q','R','S','T','V','W','X','Z'];
EngGla: set of Char =['A','E','I','O','U','Y'];
RusSog: set of Char =['Б','В','Г','Д','Ж','З','К','Л','М','Н','П','Р','С','Т','Ф','Х','Ц','Ч','Ш','Щ','Ы','Э'];
RusGla: set of Char =['A','Е','Ё','И','Й','О','У','Ы','Ю','Я'];
var
s:Char;
begin
result:=0;
s:=c;
s:=UpCase(s);
if (s in EngSog) or (s in RusSog ) then result:=1 else
if (s in EngGla) or (s in RusGla ) then result:=2;
end;


Function Spam(const s:string):boolean;
var
i,sg,nsg:integer;
begin
 result:=False;
 sg:=0;
 nsg:=0;
 if s='' then  exit;

 for i := 0 to Length(s) do
  begin
  if (SoglasnSimbol(s[i])=1)  or (s[i] in ['0'..'9']) then  inc(sg);
  if (SoglasnSimbol(s[i])=2) then  inc(nsg);
  if sg >nsg*3 then Result:=True else Result:=False;

  end;
end;

[darts116]

Русские вообще пропускает.

[bag]

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

uses crt;
const
  gl_eng:array [1..6] of char=('a','e','i','o','u','y');
  sogl_eng:array [1..20] of char=(
    'b','c','d','f','g','h','j','k','l','m','n','p',
    'q','r','s','t','v','w','x','z');
  num:array [1..10] of char=('0','1','2','3','4','5','6','7','8','9');

procedure dwn(var s:string);
var
  i:integer;
begin
  for i:=1 to length(s) do
end;

function ident(c:char):integer;
var
 i:integer;
begin
  if c=' ' then
  begin
    ident:=1;
    exit;
  end;
  if (c>='A')and(c<='Z') then
    c:=chr(ord(c)-ord('A')+ord('a'));
  for i:=1 to 10 do
    if c=num[i] then
    begin
      ident:=2;
      exit;
    end;
  for i:=1 to 6 do
    if c=gl_eng[i] then
    begin
      ident:=3;
      exit;
    end;
  for i:=1 to 20 do
    if c=sogl_eng[i] then
    begin
      ident:=4;
      exit;
    end;
  ident:=0;
end;

var
  s:string[255];
  nsogl,ngl,nw,i:integer;
begin
  clrscr;
  write('vvedite stroku: ');
  readln(s);
  i:=1;
  ngl:=0;
  nsogl:=0;
  nw:=0;
  repeat
    nw:=nw+1;
    case ident(s[i]) of
      1: begin
           ngl:=0;
           nsogl:=0;
           nw:=0;
         end;
      2: begin
           if i<length(s) then
             if (s[i+1]<>' ')and(ident(s[i+1])<>2) then
               break;
         end;
      3: begin
           ngl:=ngl+1;
           nsogl:=0;
         end;
      4: begin
           nsogl:=nsogl+1;
           ngl:=0;
         end;
    end;
    if (ngl>2)or(nsogl>3)or(nw>20) then
      break;
    i:=i+1;
  until i>length(s);

  if i>length(s) then
    writeln('Not spam')
  else
    writeln('Spam');
  readkey;
end.

[darts116]

Спасибо bag . Буду собирать статистику по словам(максимальное кол-во гласных и согласных и тп) и экспериментировать.

[bag]

Можно еще добавить проверку на одинаковые соседние гласные, например 'aa','uu' и т.д. Исключением являются комбинации 'oo' и 'ee', которые могут встречаться в английских словах.

uses crt;
const
  gl_eng:array [1..6] of char=('a','e','i','o','u','y');
  sogl_eng:array [1..20] of char=('b','c','d','f','g','h','j','k','l','m','n','p','q','r','s','t','v','w','x','z');
  num:array [1..10] of char=('0','1','2','3','4','5','6','7','8','9');

function caps(c:char):char;
begin
  if (c>='A')and(c<='Z') then
    caps:=chr(ord(c)-ord('A')+ord('a'))
  else
    caps:=c;
end;

function ident(c:char):integer;
var
 i:integer;
begin
  if c=' ' then
  begin
    ident:=1;
    exit;
  end;
  c:=caps(c);
  for i:=1 to 10 do
    if c=num[i] then
    begin
      ident:=2;
      exit;
    end;
  for i:=1 to 6 do
    if c=gl_eng[i] then
    begin
      ident:=3;
      exit;
    end;
  for i:=1 to 20 do
    if c=sogl_eng[i] then
    begin
      ident:=4;
      exit;
    end;
  ident:=0;
end;

var
  s:string[255];
  nsogl,ngl,nw,nogl,i:integer;
begin
  clrscr;
  write('vvedite stroku: ');
  readln(s);
  i:=1;
  ngl:=0;
  nsogl:=0;
  nw:=0;
  repeat
    nw:=nw+1;
    case ident(s[i]) of
      1: begin
           ngl:=0;
           nsogl:=0;
           nw:=0;
         end;
      2: begin
           if i<length(s) then
             if (s[i+1]<>' ')and(ident(s[i+1])<>2) then
               break;
         end;
      3: begin
           ngl:=ngl+1;
           nsogl:=0;
           if (i>1)and(caps(s[i])<>'o')and(caps(s[i])<>'e') then
             if s[i-1]=s[i] then
               break;
         end;
      4: begin
           nsogl:=nsogl+1;
           ngl:=0;
         end;
    end;
    if (ngl>2)or(nsogl>3)or(nw>20) then
      break;
    i:=i+1;
  until i>length(s);

  if i>length(s) then
    writeln('Not spam')
  else
    writeln('Spam');
  readkey;
end.

[darts116]

Хорошая идея.