lm.pas

解码器是基于短语的统计机器翻译系统的核心模块

(*
* LM.PAS  -  Interfaces: Language model utilities from ICT, CAS
*
* Copyright (C) 2006 by Yidong Chen <[e-mail]>
Institute of Artificial Intelligence, Xiamen University

* Begin       : 09/18/2006
* Last Change : 09/18/2006
*
* This program is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
* version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
*)

UNIT LM;

INTERFACE

PROCEDURE Init(strLMPath, strLMFile: STRING);
FUNCTION P(strE2, strE1: STRING): Real;
FUNCTION PPhrase(strPhrase: STRING): Real;
PROCEDURE CleanUp;

IMPLEMENTATION

USES
  Windows, SysUtils, Classes, Math, COMMON;

CONST
  DLL_LMDLL='lmsridll.dll';

  FUNC_LoadLM='sriLoadLM';
  FUNC_WordProb='sriWordProb';
  FUNC_Perplexity='sriPerplexity';
  PROC_UnloadLM='sriUnloadLM';

TYPE
  //From lmsridll.dll
  TFuncLoadLM=FUNCTION(pcFilename: PChar; iArpa: Integer=0; iOrder: Integer=3; iUnk: Integer=0; iTolow: Integer=0): Pointer; CDECL;
  TFuncWordProb=FUNCTION(pLm: Pointer; pcWord: PChar; pcContext: PChar): Real; CDECL;
  TFuncPerplexity=FUNCTION(pLm: Pointer; pcSentence: PChar): Real; CDECL;
  TProcUnLoadLM=PROCEDURE(pLm: Pointer); CDECL;

  TIWrap=CLASS
  PRIVATE
    FbisInitOK: Boolean;
    bisLMInitOK: Boolean;

    hLM: Cardinal;

    pLM: Pointer;

    funcLoadLM:TFuncLoadLM;
    funcWordProb:TFuncWordProb;
    funcPerplexity:TFuncPerplexity;
    procUnLoadLM:TProcUnLoadLM;
  PUBLIC
    PROPERTY isInitOK: Boolean READ FbisInitOK;

    CONSTRUCTOR Create(strLMPath, strLMFile: STRING);
    FUNCTION P(strE2, strE1: STRING): Real;
    DESTRUCTOR Destroy; OVERRIDE;
  END;

VAR iwLM: TIWrap;
    wSaved8087CW: Word;

{$IFDEF CONSOLE}
PROCEDURE PrintErrMsg(strErrMsg: STRING);
BEGIN
  WriteLn(strErrMsg);
END;
{$ELSE}
PROCEDURE PrintErrMsg(strErrMsg: STRING);
BEGIN
  MessageBox(0,PChar(strErrMsg),'出错',MB_OK);
END;
{$ENDIF}

PROCEDURE DLLMissing(strDLLPathName: STRING; VAR bisInitOK: Boolean);
VAR strTemp: STRING;
BEGIN
  strTemp:='动态链接库'+strDLLPathName+'丢失，请与提供商联系！';
  IF bisInitOK THEN PrintErrMsg(strTemp);
  bisInitOK:=False;
END;

PROCEDURE FuncNotExported(strDLLPathName, strFuncName: STRING; VAR bisInitOK: Boolean);
VAR strTemp: STRING;
BEGIN
  strTemp:='动态链接库'+strDLLPathName+'中的'+strFuncName+'未导出，请与提供商联系！';
  IF bisInitOK THEN PrintErrMsg(strTemp);
  bisInitOK:=False;
END;

PROCEDURE InitFailed(strModule: STRING; VAR bisInitOK: Boolean);
VAR strTemp: STRING;
BEGIN
  strTemp:=strModule+'模块初始化失败，请与提供商联系！';
  IF bisInitOK THEN PrintErrMsg(strTemp);
  bisInitOK:=False;
END;

CONSTRUCTOR TIWrap.Create(strLMPath, strLMFile: STRING);
VAR strTemp: STRING;
BEGIN
  INHERITED Create;

  FbisInitOK:=True;

(* Initialize all the data member to zero. -- start *)
  hLM:=0;

  bisLMInitOK:=False;

  funcLoadLM:=NIL;
  funcWordProb:=NIL;
  funcPerplexity:=NIL;
  procUnLoadLM:=NIL;
(* Initialize all the data member to zero. -- end *)

  strTemp:=strLMPath+DLL_LMDLL;
  hLM:=LoadLibrary(PChar(strTemp));

  //...load functions.

  IF hLM<>0 THEN
    BEGIN
      funcLoadLM:=TFuncLoadLM(GetProcAddress(hLM,PChar(FUNC_LoadLM)));
      IF @funcLoadLM=NIL THEN FuncNotExported(strLMPath+DLL_LMDLL,FUNC_LoadLM, FbisInitOK);
      funcWordProb:=TFuncWordProb(GetProcAddress(hLM,PChar(FUNC_WordProb)));
      IF @funcWordProb=NIL THEN FuncNotExported(strLMPath+DLL_LMDLL,FUNC_WordProb, FbisInitOK);
      funcPerplexity:=TFuncPerplexity(GetProcAddress(hLM,PChar(FUNC_Perplexity)));
      IF @funcPerplexity=NIL THEN FuncNotExported(strLMPath+DLL_LMDLL,FUNC_Perplexity, FbisInitOK);
      procUnLoadLM:=TProcUnLoadLM(GetProcAddress(hLM,PChar(PROC_UnLoadLM)));
      IF @procUnLoadLM=NIL THEN FuncNotExported(strLMPath+DLL_LMDLL,PROC_UnLoadLM, FbisInitOK);
    END
  ELSE DLLMissing(strLMPath+DLL_LMDLL,FbisInitOK);

  //...init every modules.

  IF (@funcLoadLM<>NIL) THEN
    BEGIN
      pLM:=funcLoadLM(PChar(strLMFile), 1, 3, 1, 0);
      IF pLM=NIL THEN InitFailed('语言模型模块',FbisInitOK);
    END;
END;

FUNCTION TIWrap.P(strE2, strE1: STRING): Real;
BEGIN
  Result:=funcWordProb(pLM, PChar(strE2), PChar(strE1))/Log10(2.718);
END;

DESTRUCTOR TIWrap.Destroy;
BEGIN
  IF FbisInitOK THEN procUnLoadLM(pLM);
  IF hLM<>0 THEN FreeLibrary(hLM);
  INHERITED Destroy;
END;

PROCEDURE Init(strLMPath, strLMFile: STRING);
BEGIN
  wSaved8087CW := Default8087CW;
  Set8087CW($133f);

  iwLM:=TIWrap.Create(strLMPath, strLMFile);
END;

FUNCTION P(strE2, strE1: STRING): Real;
BEGIN
  Result:=iwLM.P(strE2, strE1);
  IF Result=0 THEN
    BEGIN
      WriteLn(strE1, strE2);
      Result:=-222222;
    END;
END;

FUNCTION PPhrase(strPhrase: STRING): Real;
VAR strlTemp: TStringList; iLooper, jLooper: Integer; iMin: Integer;
    strE1, strE2: STRING;
BEGIN
  Result:=0.0;
  strPhrase:=Trim(strPhrase);
  IF (strPhrase='') OR (Pos(' ', strPhrase)=0) THEN Exit;
  strlTemp:=TStringList.Create;
  WHILE strPhrase<>'' DO strlTemp.Add(ReadTrunc(strPhrase));
  FOR iLooper:=2 TO strlTemp.Count-1 DO
    BEGIN
      strE2:=strlTemp[iLooper];
      iMin:=Max(0, iLooper-2);
      strE1:='';
      FOR jLooper:=iMin TO iLooper-1 DO
        strE1:=strE1+strlTemp[jLooper]+' ';
      strE1:=Trim(strE1);
      Result:=Result+P(strE2, strE1);
    END;
  strlTemp.Free;
END;

PROCEDURE CleanUp;
BEGIN
  iwLM.Free;

  Set8087CW(wSaved8087CW);
END;

END.