phamster.pas

数据挖掘中de一个算法 hamster的实例

{-----------------------------------------------------------------------
  File    : phamster.pas   (Turbo-/Borland-Pascal version)
  Contents: hamster control functions, client side
            sends commands to stdout, receives from stdin
  Author  : Christian Borgelt
  History : 24.03.1999 file created from file client.c
            14.04.1999 adapted to Turbo-/Borland-Pascal
-----------------------------------------------------------------------}
UNIT phamster;
INTERFACE

{-----------------------------------------------------------------------
  Constants
-----------------------------------------------------------------------}
CONST
HC_MAXXEXT =  64;             { maximal x-extension of maze }
HC_MAXYEXT =  64;             { maximal y-extension of maze }
HC_MAXLOAD =  12;             { maximal load of corn in cheeks }
HC_MAXCORN = 255;             { maximal size of corn heap }

{ --- results of hms_dir() --- }
HC_EAST    =   0;             { hamster is looking east }
HC_NORTH   =   1;             { hamster is looking north }
HC_WEST    =   2;             { hamster is looking west }
HC_SOUTH   =   3;             { hamster is looking south }

{ --- results of hms_look() --- }
HC_EMPTY   =   0;             { there is an empty field ahead }
HC_CORN    =   1;             { there is a field with corn ahead }
HC_WALL    =   2;             { there is a wall ahead }

{ --- parameters of hms_turn() --- }
HC_POS     =   1;             { positive turn (counterclockwise) }
HC_NEG     =  -1;             { negative turn (clockwise) }
HC_LEFT    =   1;             { left     turn (counterclockwise) }
HC_RIGHT   =  -1;             { right    turn (clockwise) }

{-----------------------------------------------------------------------
  Type Definitions
-----------------------------------------------------------------------}
TYPE
HMSREC = RECORD               { --- a hamster --- }
  id   : INTEGER;             { hamster identifier }
  x, y : INTEGER;             { relative position in maze }
  dir  : INTEGER;             { direction (line of sight) }
  look : INTEGER;             { outlook in current direction }
  corn : INTEGER;             { amount of corn on current field }
  load : INTEGER;             { amount of corn in cheeks }
END;
HAMSTER = ^HMSREC;            { a pointer to the above structure }

{-----------------------------------------------------------------------
  Function Prototypes
-----------------------------------------------------------------------}
{ --- enquiries --- }
PROCEDURE hms_pos    (hms : HAMSTER; VAR x, y : INTEGER);
FUNCTION  hms_dir    (hms : HAMSTER) : INTEGER;
FUNCTION  hms_look   (hms : HAMSTER) : INTEGER;
FUNCTION  hms_corn   (hms : HAMSTER) : INTEGER;
FUNCTION  hms_load   (hms : HAMSTER) : INTEGER;

{ --- actions --- }
FUNCTION  hms_move   (hms : HAMSTER) : INTEGER;
PROCEDURE hms_turn   (hms : HAMSTER; turn : INTEGER);
FUNCTION  hms_take   (hms : HAMSTER; amount : INTEGER) : INTEGER;
FUNCTION  hms_drop   (hms : HAMSTER; amount : INTEGER) : INTEGER;

{ --- administration functions --- }
FUNCTION  hms_create : HAMSTER;
PROCEDURE hms_delete (hms : HAMSTER);

{-----------------------------------------------------------------------
  Constants
-----------------------------------------------------------------------}
IMPLEMENTATION
CONST                         { --- error codes --- }
E_NONE	  =  0;               { no error }
E_NOMEM	  = -1;               { not enough memory }
E_PREAD   = -2;               { read error on pipe }
E_UNKNOWN = -3;               { unknown error }

{-----------------------------------------------------------------------
  Error Function
-----------------------------------------------------------------------}

PROCEDURE error (code : INTEGER);
BEGIN                           { --- error function }
  IF (code > 0) OR (code < E_UNKNOWN)
  THEN code := E_UNKNOWN;       { check the error code }
  CASE code OF                  { evaluate the error code }
    E_NONE   : Write('no error');
    E_NOMEM  : Write('not enough memory');
    E_PREAD  : Write('read error on pipe');
    E_UNKNOWN: Write('unknown error');
  END;                          { print an error message, }
  WriteLn; Flush(Output);       { terminate the output line, }
  HALT;                         { and abort the program }
END;  { error() }

{-----------------------------------------------------------------------
  (Internal) Hamster Functions
-----------------------------------------------------------------------}

FUNCTION hms_create : HAMSTER;
VAR cmd : CHAR;                 { echoed command }
    id	: INTEGER;              { hamster identifier }
    hms	: HAMSTER;              { created hamster }
BEGIN                           { --- create a hamster 'c' }
  Write('c'); WriteLn;          { send a create message and }
  Flush(Output);                { flush the buffer (force writing) }
  REPEAT Read(cmd);             { read and check the reply }
  UNTIL (cmd <> ' ') AND (cmd <> #9) AND (cmd <> #10) AND (cmd <> #13);
  IF (cmd <> 'c') THEN error(E_PREAD);
  Read(id);                     { get and check the hamster identifier }
  IF (id < 0) THEN error(E_UNKNOWN);
  New(hms);                     { allocate memory for a hamster }
  IF (hms = NIL) THEN error(E_NOMEM);
  Read(hms^.x);    Read(hms^.y);    Read(hms^.dir);
  Read(hms^.look); Read(hms^.corn); Read(hms^.load);
  hms^.id    := id;             { receive hamster data, set identifier }
  hms_create := hms;            { and return the created hamster }
END;  { hms_create() }

{----------------------------------------------------------------------}

PROCEDURE hms_delete (hms : HAMSTER);
VAR cmd : CHAR;                 { echoed command }
    id  : INTEGER;              { hamster identifier }
BEGIN                           { --- delete a hamster 'd' }
  Write('d '); Write(hms^.id);  { send a delete message and }
  WriteLn; Flush(Output);       { flush the buffer (force writing) }
  REPEAT Read(cmd);             { read and check the reply }
  UNTIL (cmd <> ' ') AND (cmd <> #9) AND (cmd <> #10) AND (cmd <> #13);
  IF (cmd <> 'd') THEN error(E_PREAD);
  Read(id);                     { get and check the hamster identifier }
  IF (id <> hms^.id) THEN error(E_PREAD);
  Dispose(hms);                 { deallocate the memory }
END;  { hms_delete() }

{-----------------------------------------------------------------------
  External Hamster Functions
-----------------------------------------------------------------------}

PROCEDURE hms_pos  (hms : HAMSTER; VAR x, y : INTEGER);
BEGIN                           { --- get hamster position }
  x := hms^.x; y := hms^.y;     { return relative coordinates }
END;  { hms_pos() }

{----------------------------------------------------------------------}

FUNCTION hms_dir  (hms : HAMSTER) : INTEGER;
BEGIN                           { --- get hamster direction }
  hms_dir := hms^.dir;          { return current direction }
END;  { hms_dir() }

{----------------------------------------------------------------------}

FUNCTION hms_look (hms : HAMSTER) : INTEGER;
BEGIN                           { --- take a look ahead }
  hms_look := hms^.look;        { return outlook in current direction }
END;  { hms_look() }

{----------------------------------------------------------------------}

FUNCTION hms_corn (hms : HAMSTER) : INTEGER;
BEGIN                           { --- check for corn }
  hms_corn := hms^.corn;        { return amount of corn on field }
END;  { hms_corn() }

{----------------------------------------------------------------------}

FUNCTION hms_load (hms : HAMSTER) : INTEGER;
BEGIN                           { --- get hamster load }
  hms_load := hms^.load;        { return amount of corn in cheeks }
END;  { hms_load() }

{----------------------------------------------------------------------}

FUNCTION hms_move (hms : HAMSTER) : INTEGER;
VAR cmd  : CHAR;                { echoed command }
    id	 : INTEGER;             { hamster identifier }
    x, y : INTEGER;             { old hamster position }
BEGIN                           { --- move hamster one field ('m') }
  x := hms^.x; y := hms^.y;     { note current hamster position }
  Write('m '); Write(hms^.id);  { send a move message and }
  WriteLn; Flush(Output);       { flush the buffer (force writing) }
  REPEAT Read(cmd);             { read and check the reply }
  UNTIL (cmd <> ' ') AND (cmd <> #9) AND (cmd <> #10) AND (cmd <> #13);
  IF (cmd <> 'm') THEN error(E_PREAD);
  Read(id);                     { get and check the hamster identifier }
  IF (id <> hms^.id) THEN error(E_PREAD);
  Read(hms^.x); Read(hms^.y);   { get the new hamster data }
  Read(hms^.look); Read(hms^.corn);
  IF  (hms^.x = x)              { if the hamster is still }
  AND (hms^.y = y)              { on the same field, }
  THEN hms_move := -1           { return an error code, }
  ELSE hms_move := 0;           { otherwise return 'ok' }
END;  { hms_move() }

{----------------------------------------------------------------------}

PROCEDURE hms_turn (hms : HAMSTER; turn : INTEGER);
VAR cmd : CHAR;                 { echoed command }
    id	: INTEGER;              { hamster identifier }
BEGIN                           { --- turn hamster 90 degrees ('t') }
  Write('t '); Write(hms^.id);  { send a turn message }
  Write(' ');  Write(turn); WriteLn;
  Flush(Output);                { flush the buffer (force writing) }
  REPEAT Read(cmd);             { read and check the reply }
  UNTIL (cmd <> ' ') AND (cmd <> #9) AND (cmd <> #10) AND (cmd <> #13);
  IF (cmd <> 't') THEN error(E_PREAD);
  Read(id);                     { get and check the hamster identifier }
  IF (id <> hms^.id) THEN error(E_PREAD);
  Read(hms^.dir);               { get the new hamster data }
  Read(hms^.look);              { (direction and outlook) }
END;  { hms_turn() }

{----------------------------------------------------------------------}

FUNCTION hms_take (hms : HAMSTER; amount : INTEGER) : INTEGER;
VAR cmd  : CHAR;                { echoed command }
    id   : INTEGER;             { hamster identifier }
    load : INTEGER;             { buffer for corn load }
BEGIN                           { --- take/drop some corn ('l') }
  load := hms^.load;            { note current load }
  Write('l '); Write(hms^.id);  { send a load message }
  Write(' ');  Write(amount); WriteLn;
  Flush(Output);                { flush the buffer (force writing) }
  REPEAT Read(cmd);             { read and check the reply }
  UNTIL (cmd <> ' ') AND (cmd <> #9) AND (cmd <> #10) AND (cmd <> #13);
  IF (cmd <> 'l') THEN error(E_PREAD);
  Read(id);                     { get and check the hamster identifier }
  IF (id <> hms^.id) THEN error(E_PREAD);
  Read(hms^.corn);              { get the new hamster data }
  Read(hms^.load);              { (corn heap size and load) }
  hms_take := hms^.load -load;  { return amount taken/dropped }
END;  { hms_take() }

{----------------------------------------------------------------------}

FUNCTION hms_drop (hms : HAMSTER; amount : INTEGER) : INTEGER;
BEGIN                           { --- drop/take some corn }
  hms_drop := hms_take(hms, -amount);
END;  { hms_drop() }

{----------------------------------------------------------------------}

BEGIN
END.  { hamster }