fork(1) download
copy 
  1. {*************************************************************************}
  2. {*                                                                       *}
  3. {*                   VI Olimpiada Informatyczna                          *}
  4. {*                                                                       *}
  5. {*   RozwiĄzanie zadania: WODA                                           *}
  6. {*   Plik:                WOD.PAS                                        *}
  7. {*   Autor:               Marcin Mucha                                   *}
  8. {*************************************************************************}
  9.  
  10. const
  11.    N_MAX = 100;
  12.    M_MAX = 100;
  13.    NM_MAX = N_MAX * M_MAX;
  14.  
  15.    H_MAX = 10000;
  16.  
  17. type
  18.    t_coords = record
  19.       x, y : byte
  20.    end;
  21.  
  22.    t_heap = record
  23.       data : array[1..NM_MAX] of t_coords;
  24.       size : word;
  25.    end;
  26.  
  27.    t_square = record
  28.       h : word;
  29.       lpath : word { Wysoko˜† najniľszej scieľki do brzegu lub INFTY. }
  30.    end;
  31.  
  32.    p_queue_elem = ^t_queue_elem;
  33.    t_queue_elem = record
  34.       coords : t_coords;
  35.       next : p_queue_elem
  36.    end;
  37.  
  38.    t_queue = record
  39.       first, last : p_queue_elem;
  40.    end;
  41.  
  42. const
  43.    file_in_name = 'wod.in';
  44.    file_out_name = 'wod.out';
  45.    INFTY = 65535;
  46.  
  47. var
  48.    file_in, file_out : text;
  49.    board : array[0..N_MAX + 1, 0..M_MAX + 1] of t_square;
  50.    n, m  : word;
  51.    queue : t_queue;
  52.    heap : t_heap;
  53.  
  54. procedure queue_init( var q : t_queue);
  55. begin
  56.    q.first := nil; q.last := nil
  57. end;
  58.  
  59. procedure queue_put( var q : t_queue; x, y : byte);
  60. var
  61.    p : p_queue_elem;
  62. begin
  63.    new( p);
  64.    p^.coords.x := x;
  65.    p^.coords.y := y;
  66.    p^.next := nil;
  67.  
  68.    if q.first = nil then
  69.       q.first := p
  70.    else
  71.       q.last^.next := p;
  72.  
  73.    q.last := p
  74. end;
  75.  
  76. procedure queue_get( var q : t_queue; var x : byte; var y : byte);
  77. var
  78.    p : p_queue_elem;
  79. begin
  80.    x := q.first^.coords.x;
  81.    y := q.first^.coords.y;
  82.  
  83.    p := q.first;
  84.    q.first := q.first^.next;
  85.    if q.first = nil then
  86.       q.last := nil;
  87.    dispose( p);
  88. end;
  89.  
  90. function queue_empty( var q : t_queue) : boolean;
  91. begin
  92.    queue_empty := ( q.first = nil)
  93. end;
  94.  
  95. function height( var c : t_coords) : word;
  96. begin
  97.    height := board[c.x][c.y].h
  98. end;
  99.  
  100. procedure heap_init( var h : t_heap);
  101. begin
  102.    h.size := 0
  103. end;
  104.  
  105. procedure heap_swap( var h : t_heap; i, j : word);
  106. var
  107.    c : t_coords;
  108. begin
  109.    c := h.data[i];
  110.    h.data[i] := h.data[j];
  111.    h.data[j] := c
  112. end;
  113.  
  114. procedure heap_go_down( var h : t_heap);
  115. var
  116.    i, smallest : word;
  117. begin
  118.    i :=  1;
  119.    while 2 * i <= h.size do
  120.       begin
  121.          if ( 2 * i <= h.size) and
  122.             ( height( h.data[2 * i]) < height( h.data[i])) then
  123.             smallest := 2 * i
  124.          else
  125.             smallest := i;
  126.          if ( 2 * i + 1 <=  h.size) and
  127.             ( height( h.data[2 * i + 1]) < height( h.data[smallest])) then
  128.             smallest := 2 * i + 1;
  129.          if smallest <> i then
  130.             begin
  131.                heap_swap( h, smallest, i);
  132.                i := smallest
  133.             end
  134.          else
  135.             exit
  136.       end
  137. end;
  138.  
  139. procedure heap_add( var h : t_heap; x, y : byte);
  140. var
  141.    i : word;
  142. begin
  143.    inc( h.size);
  144.    i := h.size;
  145.    while ( i > 1) and ( board[x][y].h < height( h.data[i div 2])) do
  146.       begin
  147.          h.data[i] := h.data[i div 2];
  148.          i := i div 2
  149.       end;
  150.    h.data[i].x  := x; h.data[i].y := y
  151. end;
  152.  
  153. procedure heap_remove( var h : t_heap; var x : byte; var y : byte);
  154. begin
  155.    x := h.data[1].x; y := h.data[1].y;
  156.    h.data[1] := h.data[h.size];
  157.    dec( h.size);
  158.    heap_go_down( h);
  159. end;
  160.  
  161. function heap_empty( var h : t_heap) : boolean;
  162. begin
  163.    heap_empty := ( h.size = 0)
  164. end;
  165.  
  166. procedure read_data;
  167. var
  168.    i, j : byte;
  169. begin
  170.    heap_init( heap);
  171.    readln( file_in, n, m);
  172.  
  173.    for i := 0 to n + 1 do
  174.       begin
  175.          board[i][0].h := INFTY; board[i][0].lpath := INFTY;
  176.          board[i][m + 1].h := INFTY; board[i][m + 1].lpath := INFTY
  177.       end;
  178.  
  179.    for j := 0 to m + 1 do
  180.       begin
  181.          board[0][j].h := INFTY; board[0][j].lpath := INFTY;
  182.          board[n + 1][j].h := INFTY; board[n + 1][j].lpath := INFTY
  183.       end;
  184.  
  185.    for i := 1 to n do
  186.       for j := 1 to m do
  187.          begin
  188.             board[i][j].lpath := INFTY;
  189.             read( file_in, board[i][j].h);
  190.             heap_add( heap, i, j)
  191.          end
  192. end;
  193.  
  194. procedure find_paths;
  195. var
  196.    x, y : byte;
  197.    p : p_queue_elem;
  198.  
  199. procedure adjust_lpath( x, y : byte; value : word);
  200. begin
  201.    if ( board[x][y].h <= value) and ( board[x][y].lpath = INFTY) then
  202.       begin
  203.          board[x][y].lpath := value;
  204.          queue_put( queue, x, y)
  205.       end
  206. end;
  207.  
  208. begin
  209.    queue_init( queue);
  210.    repeat
  211.       heap_remove( heap, x, y);
  212. (* Je˜li to jest pole brzegowe, *)
  213. (* albo istnieje ˜cieľka do brzegu po polach o maˆych wysoko˜ciach. *)
  214.       if ( x = 1) or ( x = n) or ( y = 1) or ( y = m)
  215.                   or ( board[x - 1][y].lpath < INFTY)
  216.                   or ( board[x + 1][y].lpath < INFTY)
  217.                   or ( board[x][y - 1].lpath < INFTY)
  218.                   or ( board[x][y + 1].lpath < INFTY) then
  219.          adjust_lpath( x, y, board[x][y].h);
  220.  
  221.       while not queue_empty( queue) do
  222.          begin
  223.             queue_get( queue, x, y);
  224.             adjust_lpath( x - 1, y, board[x][y].lpath);
  225.             adjust_lpath( x + 1, y, board[x][y].lpath);
  226.             adjust_lpath( x, y - 1, board[x][y].lpath);
  227.             adjust_lpath( x, y + 1, board[x][y].lpath);
  228.          end
  229.    until heap_empty( heap);
  230. end;
  231.  
  232. function sum_up : longint;
  233. var
  234.    i, j : byte;
  235.    sum : longint;
  236. begin
  237.    sum := 0;
  238.    for i := 1 to n do
  239.       for j := 1 to m do
  240.          inc( sum, board[i][j].lpath - board[i][j].h);
  241.    sum_up := sum;
  242. end;
  243.  
  244. begin
  245.    assign( file_in, file_in_name);
  246.    reset( file_in);
  247.    read_data;
  248.    close( file_in);
  249.  
  250.    find_paths;
  251.  
  252.    assign( file_out, file_out_name);
  253.    rewrite( file_out);
  254.    write( file_out, sum_up);
  255.    close( file_out)
  256. end.
Runtime error #stdin #stdout 0s 340KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Runtime error 2 at $080489D6
  $080489D6
  $08064023
https://ideone.com/Rc9ECd
language:
Pascal (fpc 3.0.4)
created:
11 years ago
visibility:
secret

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!