hamster.p

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

{-----------------------------------------------------------------------
  File    : hamster.p
  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
-----------------------------------------------------------------------}
MODULE hamster;
EXPORT hamster = (HAMSTER,
                  HC_MAXXEXT, HC_MAXYEXT, HC_MAXLOAD, HC_MAXCORN,
                  HC_EAST,    HC_NORTH,   HC_WEST,    HC_SOUTH,
                  HC_EMPTY,   HC_CORN,    HC_WALL,
                  HC_POS,     HC_NEG,     HC_LEFT,    HC_RIGHT,
                  hms_pos, hms_dir, hms_look, hms_corn, hms_load,
                  hms_move, hms_turn, hms_take, hms_drop,
                  hms_create, hms_delete, random);
IMPORT StandardInput; StandardOutput;

{-----------------------------------------------------------------------
  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);

{ --- auxiliary functions --- }
FUNCTION  random     (range : INTEGER) : INTEGER;

END;
{-----------------------------------------------------------------------
  Constants
-----------------------------------------------------------------------}
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 }

{-----------------------------------------------------------------------
  Type Definitions
-----------------------------------------------------------------------}
TYPE PCHAR = ^CHAR;           { dummy type for time declaration }

{-----------------------------------------------------------------------
  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;                      { terminate the output line, }
  HALT;                         { and abort the program }
END;  { error() }

{-----------------------------------------------------------------------
  Auxiliary Functions
-----------------------------------------------------------------------}

FUNCTION  time  (p : PCHAR) : INTEGER; C;
PROCEDURE srand (seed : INTEGER); C;
FUNCTION  rand : INTEGER; C;

FUNCTION  random;
BEGIN                           { --- generate a random number }
   random := rand MOD range;    {     in the range [0..(range-1)] }
END;  { random }

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

FUNCTION hms_create;
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 }
  REPEAT Read(cmd); UNTIL (cmd <> ' ') AND (cmd <> '\n');
  IF (cmd <> 'c') THEN error(E_PREAD);  { read and check the reply and }
  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;
VAR cmd : CHAR;                 { echoed command }
    id  : INTEGER;              { hamster identifier }
BEGIN                           { --- delete a hamster 'd' }
  Write('d '); Write(hms^.id);  { send a delete message }
  WriteLn;
  REPEAT Read(cmd); UNTIL (cmd <> ' ') AND (cmd <> '\n');
  IF (cmd <> 'd') THEN error(E_PREAD);  { read and check the reply and }
  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;
BEGIN                           { --- get hamster position }
  x := hms^.x; y := hms^.y;     { return relative coordinates }
END;  { hms_pos() }

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

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

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

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

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

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

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

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

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

FUNCTION hms_move;
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 }
  WriteLn;
  REPEAT Read(cmd); UNTIL (cmd <> ' ') AND (cmd <> '\n');
  IF (cmd <> 'm') THEN error(E_PREAD);  { read and check the reply and }
  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;
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;
  REPEAT Read(cmd); UNTIL (cmd <> ' ') AND (cmd <> '\n');
  IF (cmd <> 't') THEN error(E_PREAD);  { read and check the reply and }
  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;
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;
  REPEAT Read(cmd); UNTIL (cmd <> ' ') AND (cmd <> '\n');
  IF (cmd <> 'l') THEN error(E_PREAD);  { read and check the reply and }
  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;
BEGIN                           { --- drop/take some corn }
  hms_drop := hms_take(hms, -amount);
END;  { hms_drop() }

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

TO BEGIN DO BEGIN
  srand(time(NIL));             { init. the random number generator }
END;
END.  { hamster }