Jak zrobić syntezator mowy polskiej wykorzystując Microsoft Sam’a

Artykuł poświęcony jest syntezie mowy polskiej za pomocą syntezy mowy angielskiej z wykorzystaniem Microsoft Sam.

Fonemy

Fonemy to podstawowe składniki mowy. Każdy język ma swój zestaw fonemów. Chciałem, aby Microsoft Sam, który używa fonemów angielskich, mówił po polsku. Choć będę używał słowa fonem, tak naprawdę chodzi również o różne wyjątki, które składają się z kilku liter polskich, zamienianych na kilka innych liter angielskich dla poprawienia jakości wymowy. W tym artykule ograniczyłem się do minimum. Wcześniej potrzebowałem około 500-set – nazwijmy to – fonemów, aby jakość wymowy polskiej Sam’a, była naprawdę dobrej jakości na zupełnie nieznanym mu tekście. Może nie tyle jakość, co zrozumiałość dla Polaka.

Czego nie da się obejść?

Na pewno litery r. Generalnie, Sam będzie mówił, jak Polak, który przez wiele lat mieszkał w USA, a czasem zabrzmi jak – jeśli pamiętacie z telewizji – Zulu-Gula kreowany przez polskiego satyryka. Akcentowanie przedostatniej sylaby słowa, typowe dla języka polskiego, raz będzie działać, innym razem nie i wtedy, zwykle zaakcentowana zostanie ostatnia sylaba słowa. Nie da się też obejść poprawnej intonacji całych zdań. Tu pominąłem czytanie całych zdań, ale próbowałem tego i przy rozszerzonej ilości fonemów oraz niepomijaniu znaków interpunkcyjnych, wychodzi to całkiem nieźle, chociaż trzeba się trochę oswoić z wymową Sam’a i ustawić odpowiednią szybkość czytania w Panelu Sterowania (Mowa). Dodatkowo może być konieczne wydłużenie niektórych fonemów jak np. mih na mih-yy, ee na ee-ee.

Jak oszukać Sam’a?

Potrzebna jest podstawowa znajomość wymowy angielskiej, a także znajomość specyfiki wykorzystywanego syntezatora mowy. W moim kodzie znajdziesz podstawy do własnych eksperymentów i udoskonaleń w tablicy Fonemy1. Fragmenty słów polskich, są zamieniane na fragmenty oszukujących Sam’a pseudosłów angielskich.

Uproszczenia

W funkcji KonwertujPolski umieściłem nieco uproszczeń, które wynikały statystycznie z moich eksperymentów. W większości uproszczenia te nie pogarszają znacząco zrozumiałości wyrazów, choć jest to efekt uśrednienia z definicji niedoskonały. Tablica fonemów miała być niewielka na potrzeby tego artykułu. Dodatkowo zastępowane jest ę na końcu słowa na e (co jest zgodne z poprawną wymową polską), a ą na końcu słowa na om. (Taki prezydencki akcent, ale poprawia zrozumiałość.)

Jak działa funkcja KonwertujAngielski?

Po pierwsze fonemy polskie muszą być uporządkowane w tablicy Fonemy1 według ilości znaków – najdłuższe na końcu. Potem funkcja wyszukuje w polskim słowie możliwie najdłuższe podciągi, które można zastąpić. Po zastąpieniu usuwa ze słowa to, co zostało już zastąpione i powtarza zamiany, aż dojdzie do pojedynczych liter i zastąpi wszystko. Uwaga: jeśli chcesz zrezygnować z uproszczeń w funkcji KonwertujPolski, nie zapomnij, żeby w tablicy Fonemy1 występował cały alfabet i polskie znaki diakrytyczne (ą, ę itd.). W przypadku czytania całych zdań lepiej oddzielać fonemy spacjami a nie myślnikami. Na końcu słowa dla Sam’a umieszczam zawsze znak zapytania. Można spróbować z wykrzyknikiem i z kropką. Wrażenie subiektywne. Jeżeli chcesz, aby wypowiadane były całe zdania, zrezygnuj ze znaku zapytania na końcu słów i zastąp wszystkie znaki interpunkcyjne kropką i spacją. Myślniki zastąp spacją.

Nie ma liczebników

Ponieważ polskie liczebniki są odmieniane w zależności od kontekstu, zrezygnowałem z nich, ale jeśli napiszesz liczebnik jako słowo, a nie ciąg cyfr, będzie działało.

Inne syntezatory mowy

Testowałem Microsoft Mike i Microsoft Mary. Być może korzystniejsze okaże się zastąpienie np. fonemu angielskiego bih na byh itp. Ale Sam jest w każdym Windowsie za darmo.

Czas na zabawę

Na formę połóż memo, stringgrida i 3 buttony. Wklej poniższy kod i powiąż buttony ze zdarzeniami OnClick, a formę ze zdarzeniem OnCreate. Potem możesz wklejać lub wpisywać dowolne teksty do Memo1. Trzeba też trochę pozmieniać rozmiary kontrolek. A oto kod programu.

Uzupełnienie

W uzupełnieniu dodałem kod pozwalający na czytanie całych zdań oraz otwieranie tekstów z plików. Umieściłem ten kod osobno, żeby nie zaciemniać obrazu tego, co jest podstawowym elementem programu.
Jeśli chcesz skorzystać z uzupełnienia, połóż dodatkowo na formie OpenDialog i 3 buttony. Po wklejeniu pozostałej części programu dodaj nazwy procedur w sekcji public deklaracji TForm1 i powiąż nowe 3 buttony ze zdarzeniami OnClick.
W OnCreate pojawiło się dodatkowo:

  Button4.Caption := 'Otwórz';
  Button5.Caption := 'Przygotuj zdania';
  Button6.Caption := 'Czytaj zdania';

Dodałem kilka słów przed którymi stawia się przecinki – na wypadek, gdyby autor tekstu o nich zapomniał. Przecinek przed 'i' ma sens, bo zwykle, choć się go nie stawia, 'i' oddziela gramatyczne części zdania.
I jeszcze jedna uwaga: Sam jest w stanie powiedzieć tylko zdanie o określonej maksymalnej długości (nie sprawdzałem jej), dlatego lepiej zadawać mu krótkie zdania. Poradzi sobie i z dłuższymi, ale będzie się nieco zacinać.

Kod podstawowy

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    StringGrid1: TStringGrid;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  public
    Mowa: OLEVariant;
    Stop: boolean;
    procedure PrzygotujWyrazy;
    function  KonwertujPolski(s: string): string;
    function  KonwertujAngielski(s: string): string;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  ComObj;

type
  TJezyk = (Polski, Angielski);

const
  Fonemy1: array [0..34, TJezyk] of string
  =
  (
    ('a'  ,'ah'      ),
    ('ą'  ,'ohn'     ),
    ('b'  ,'bih'     ),
    ('c'  ,'tsih'    ),
    ('ć'  ,'tche'    ),
    ('d'  ,'dih'     ),
    ('e'  ,'eh'      ),
    ('ę'  ,'en'      ),
    ('f'  ,'fih'     ),
    ('g'  ,'gih'     ),
    ('h'  ,'hih'     ),
    ('i'  ,'ee'      ),
    ('k'  ,'kih'     ),
    ('l'  ,'lih'     ),
    ('m'  ,'mih'     ),
    ('n'  ,'nih'     ),
    ('ń'  ,'neeh'    ),
    ('o'  ,'oh'      ),
    ('p'  ,'pih'     ),
    ('q'  ,'kih'     ),
    ('r'  ,'rih'     ),
    ('s'  ,'sih'     ),
    ('ś'  ,'shi'     ),
    ('t'  ,'tih'     ),
    ('u'  ,'oo'      ),
    ('x'  ,'kihs'    ),
    ('y'  ,'yh'      ),
    ('z'  ,'zih'     ),
    ('ź'  ,'jih'     ),
    ('cz' ,'tchih'   ),
    ('dz' ,'dze-yh'  ),
    ('dź' ,'djih'    ),
    ('sz' ,'shih'    ),
    ('ść' ,'shtche'  ),
    ('dzi','dchee-ee')
  );

procedure TForm1.FormCreate(Sender: TObject);
begin
  Memo1.Text := '';
  StringGrid1.ColCount := 4;
  StringGrid1.Options := StringGrid1.Options + [goEditing];
  Mowa := CreateOLEObject('SAPI.SpVoice');
  Button1.Caption := 'Przygotuj';
  Button2.Caption := 'Czytaj';
  Button3.Caption := 'Przerwij';
end;

function TForm1.KonwertujPolski(s: string): string;
var
  p: integer;
begin
  while Pos('w', s) > 0 do
    s[Pos('w', s)] := 'f';
  while Pos('ó', s) > 0 do
    s[Pos('ó', s)] := 'u';
  while Pos('ł', s) > 0 do
    s[Pos('ł', s)] := 'u';
  while Pos('j', s) > 0 do
    s[Pos('j', s)] := 'i';
  while Pos('v', s) > 0 do
    s[Pos('v', s)] := 'f';
  while Pos('ch', s) > 0 do
    Delete(s, Pos('ch', s), 1);
  while Pos('rz', s) > 0 do
  begin
    p := Pos('rz', s);
    Delete(s, p, 2);
    Insert('sz', s, p);
  end;
  while Pos('ż', s) > 0 do
  begin
    p := Pos('ż', s);
    Delete(s, p, 1);
    Insert('sz', s, p);
  end;
  if s[Length(s)] = 'ę' then
    s[Length(s)] := 'e';
  if s[Length(s)] = 'ą' then 
  begin
    s[Length(s)] := 'o';
    s := s + 'm';
  end;
  Result := s;
end;

function TForm1.KonwertujAngielski(s: string): string;
  function NieMaLiter(s: string): boolean;
  var
    i: integer;
  begin
    Result := true;
    for i := 1 to Length(s) do
      if not (s[i] in [' ', '-', '.']) then
      begin
        Result := false;
        Break;
      end;
  end;
var
  Fonemy2: array of record
                      Zamieniono: boolean;
                      Fonem: string;
                    end;
  i, j, p: integer;
begin
  SetLength(Fonemy2, Length(s));
  for i := 0 to High(Fonemy2) do
  begin
    Fonemy2[i].Zamieniono := false;
    Fonemy2[i].Fonem := '';
  end;
  while (Trim(s) <> '') and not NieMaLiter(s) do
  begin
    for i := High(Fonemy1) downto 0 do
    begin
      p := Pos(Fonemy1[i, Polski], s);
      if p > 0 then
      begin
        Fonemy2[p - 1].Fonem := Fonemy1[i, Angielski];
        Fonemy2[p - 1].Zamieniono := true;
        for j := p to p + Length(Fonemy1[i, Polski]) - 1 do
          s[j] := ' ';
        Break;
      end;
    end;
  end;
  s := '';
  for i := 0 to High(Fonemy2) do
    if Fonemy2[i].Zamieniono then
      s := s + '-' + Fonemy2[i].Fonem;
  Delete(s, 1, 1);
  s := s + '?';
  Result := s;
end;

procedure TForm1.PrzygotujWyrazy;
var
  s1, s2: string;
  i: integer;
begin
  s1 := Form1.Memo1.Text;
  s1 := AnsiLowerCase(s1);
  s2 := '';
  for i := 1 to Length(s1) do
    if s1[i] in ['a'..'z', 'ż','ó','ł','ć','ę','ś','ą','ź','ń',' '] then
      s2 := s2 + s1[i]
    else
      s2 := s2 + ' ';
  while Pos('  ', s2) > 0 do
    Delete(s2, Pos('  ', s2), 1);
  s2 := s2 + ' ';
  StringGrid1.RowCount := 2;
  i := 1;
  while Pos(' ', s2) > 0 do
  begin
    if StringGrid1.RowCount - 1 < i then
      StringGrid1.RowCount := i;
    StringGrid1.Cells[1, i] := Copy(s2, 1, Pos(' ', s2) - 1);
    s2 := Copy(s2, Pos(' ', s2) + 1, Length(s2));
    Inc(i);
  end;
  for i := 1 to StringGrid1.RowCount - 1 do
    StringGrid1.Cells[2, i] := KonwertujPolski(StringGrid1.Cells[1, i]);
  for i := 1 to StringGrid1.RowCount - 1 do
    StringGrid1.Cells[3, i] := KonwertujAngielski(StringGrid1.Cells[2, i]);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  PrzygotujWyrazy;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  i: integer;
begin
  Stop := false;
  StringGrid1.Col := 1;
  for i := 1 to StringGrid1.RowCount - 1 do
    if not Stop then
    begin
      StringGrid1.Row := i;
      StringGrid1.SetFocus;
      Application.ProcessMessages;
      Mowa.Speak(StringGrid1.Cells[3, i]);
    end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  Stop := true;
end;

end.

Uzupełnienie - kod

procedure TForm1.PrzygotujZdania;
var
  s1, s2: string;
  i: integer;
begin
  s1 := Form1.Memo1.Text;
  s1 := AnsiLowerCase(s1);
  i := 1;
  repeat
    if Copy(s1, i, 5) = ' ale ' then
    begin
      Insert(',', s1, i);
      Inc(i, 2);
    end
    else
    if Copy(s1, i, 4) = ' że ' then
    begin
      Insert(',', s1, i);
      Inc(i, 2);
    end
    else
    if Copy(s1, i, 3) = ' i ' then
    begin
      Insert(',', s1, i);
      Inc(i, 2);
    end
    else
    if Copy(s1, i, 3) = ' a ' then
    begin
      Insert(',', s1, i);
      Inc(i, 2);
    end;
    Inc(i);
    if i > Length(s1) then
      Break;
  until false;
  s2 := '';
  for i := 1 to Length(s1) do
    if s1[i] in ['a'..'z', 'ż','ó','ł','ć','ę','ś','ą','ź','ń',' '] then
      s2 := s2 + s1[i]
    else
      if s1[i] in ['.',',',';','?','!'] then
        s2 := s2 + '.'
      else
        s2 := s2 + ' ';
  while Pos('..', s2) > 0 do Delete(s2, Pos('..', s2), 1);
  s1 := '';
  for i := 1 to Length(s2) do
    if s2[i] = '.' then
      s1 := s1 + s2[i] + ' '
    else
      s1 := s1 + s2[i];
  s2 := Trim(s1);
  while Pos('  ', s2) > 0 do Delete(s2, Pos('  ', s2), 1);
  s2 := s2 + ' ';
  StringGrid1.RowCount := 2;
  i := 1;
  while Pos(' ', s2) > 0 do
  begin
    if StringGrid1.RowCount - 1 < i then
      StringGrid1.RowCount := i + 1;
    StringGrid1.Cells[1, i] := Copy(s2, 1, Pos(' ', s2) - 1);
    s2 := Copy(s2, Pos(' ', s2) + 1, Length(s2));
    Inc(i);
  end;
  for i := 1 to StringGrid1.RowCount - 1 do
  begin
    s1 := StringGrid1.Cells[1, i];
    if s1[Length(s1)] = '.' then
      s1 := Copy(s1, 1, Length(s1) - 1);
    try
      StringGrid1.Cells[2, i] := KonwertujPolski(s1);
    except
      StringGrid1.Cells[2, i] := '';
    end;
  end;
  for i := 1 to StringGrid1.RowCount - 1 do
  begin
    s1 := KonwertujAngielski(StringGrid1.Cells[2, i]);
    s1 := Copy(s1, 1, Length(s1) - 1);
    while Pos('-', s1) > 0 do
      s1[Pos('-', s1)] := ' ';
    StringGrid1.Cells[3, i] := s1;
  end;
  if not (Pos('.', StringGrid1.Cells[1, StringGrid1.RowCount - 1]) > 0) then
    StringGrid1.Cells[1, StringGrid1.RowCount - 1] :=
      StringGrid1.Cells[1, StringGrid1.RowCount - 1] + '.';
end;

procedure TForm1.CzytajZdania;
var
  i: integer;
  s1, s2: string;
  Memo: string;
begin
  Memo := Memo1.Text;
  Stop := false;
  i := 1;
  repeat
    s1 := '';
    s2 := '';
    repeat
      s1 := s1 + StringGrid1.Cells[3, i] + ' ';
      s2 := s2 + StringGrid1.Cells[1, i] + ' ';
      Inc(i);
    until Pos('.', StringGrid1.Cells[1, i - 1]) > 0;
    Memo1.Text := s2;
    Application.ProcessMessages;
    if Stop then
      Break;
    Mowa.Speak(s1);
  until i > StringGrid1.RowCount - 1;
  Memo1.Text := Memo;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
  begin
    Memo1.Lines.LoadFromFile(OpenDialog1.FileName);
  end;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  PrzygotujZdania;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
  CzytajZdania;
end;