Tài liệu chuyên đề thuật toán duyệt

Tải về: CHUYEN-DE-DUYET-CAU-HINH-TO-HOP-YEULAPTRINH.PW

Hiện nay chưa có tài liệu chính thức dành cho lớp Chuyên Tin khối THPT. Mà chỉ tồn tại ở dưới dạng tên chuyên đề của Bộ Giáo dục gửi về cho các trường. Do vậy việc dạy và học gặp nhiều khó khăn trong việc thống nhất về nội dung cũng như mức độ về kiến thức chuyên môn. Nên việc nghiên cứu và xây dựng chuyên đề này là thực sự cần thiết.

Mục đích của chuyên đề là truyền tải một cách tổng quát, chi tiết và sự thống nhất về mặt nội dung để người đọc dễ hiểu và thấy được tầm quan trọng của bài toán liệt kê tổ hợp và một số bài tập ứng dụng trong Tin học dành cho học sinh chuyên tin ở trường THPT.

Nội dung của chuyên đề đã được các tác giả chọn lọc qua chương trình đã thực dạy tại trường và tham khảo của một số đồng nghiệp khác trong nước.

Kiến thức là vô hạn, trong chuyên đề này chúng tôi đã có gắng sáng  tạo, sưu tầm và trao đổi một cách tốt nhất có thể về mặt lý thuyết, các bài tập ứng dụng và các bài tập trong các kỳ thi trong nước để tạo thành cuốn tài liệu hiệu quả dành cho giáo viên và các em học sinh đam mê tin học chính thức làm tài liệu cho mình trong quá trình học tập và nghiên cứu.

THPT Chuyên Bắc Giang.

 

V8SCORE – SPOJ

Đề bài: http://vn.spoj.com/problems/V8SCORE/

Thuật toán:

  • (đang cập nhập)

Code:

const   fi='';
        fo='';
        oo=20;
var     i,j,tmp2:longint;
        s,k,n,tong,ss,tmp:longint;
        a:array[1..oo,1..oo] of longint;
        c:array[0..200] of boolean;
        trace:array[0..oo] of longint;
        f:text;
        tim:boolean;
procedure nhap;
begin
    assign(f,fi);
    reset(f);
    readln(f,s,k,n);
    for i:=1 to n do
        for j:=1 to k do read(f,a[i,j]);
    close(f);
end;
function max2(x,y:integer):integer;
begin
    if x>y then max2:=x else max2:=y;
end;
procedure init;
begin
    for i:=1 to n do c[a[i,k]]:=true;
end;
procedure thu(x,y,tong:integer);
var     j,ss:integer;
begin
if not(tim) then
 if y<k then
 begin
   if a[x,y]>=trace[y-1] then
   begin
        tmp:=tong+(k-y+1)*a[x,y];
        if tmp<=s then
                begin
                        tong:=tong+a[x,y];
                        trace[y]:=a[x,y];
                        for j:=1 to n do thu(j,y+1,tong);
                end;
   end;
 end else
        begin
        if (c[s-tong]) and (s-tong>=trace[k-1]) then
                begin
                trace[k]:=s-tong;
                tim:=true;
                end;
        end;
end;
procedure xuly;
begin
    trace[0]:=-1;
    for i:=1 to n do
    begin
        if tim then exit else
        begin
                fillchar(trace,sizeof(trace),0);
                thu(i,1,0);
        end;
    end;
end;
procedure inkq;
begin
    assign(f,fo);
    rewrite(f);
    if tim then
    begin
        writeln(f,'YES');
        for i:=1 to k do write(f,trace[i],' ');
    end
        else writeln(f,'NO');
    close(f);
end;
begin
    nhap;
    init;
    xuly;
    inkq;
end.

NKMINES – SPOJ

Đề bài: http://vn.spoj.com/problems/NKMINES/

Thuật toán:

  • Duyệt trạng thái hàng 1 và cột 1 từ đó lần ra được các ô khác.
  • Nếu trạng thái mìn thỏa mãn thì xuất ra và dừng chương trình luôn.

Code:

const h1: array[1..8] of integer = (1, -1, 0, 0, 1, -1, 1, -1);
      h2: array[1..8] of integer = (0, 0, 1, -1, 1, -1, -1, 1);
 
var a, res: array[0..201, 0..201] of byte;
    m, n: byte;
 
procedure init;
  var i, j: integer;
  begin
       fillchar(res, sizeof(res), 0);
       readln(m, n);
       for i:= 1 to m do
          begin
               for j:= 1 to n do read(a[i, j]);
               readln;
          end;
  end;
 
function count(i, j: byte): byte;
  var tmp, k: byte;
  begin
       tmp:= 0;
       for k:= 1 to 8 do
          if res[i + h1[k], j + h2[k]] = 1 then inc(tmp);
       exit(tmp);
  end;
 
function fill(i, j: byte): boolean;
  var t1, t2: integer;
  begin
       if (i = 1) or (j = 1) then exit(true);
       if (i > m) or (j > n) then exit(true);
       res[i, j]:= 0;
 
       t1:= a[i - 1, j - 1] - count(i - 1, j - 1);
       if t1 < 0 then exit(false);
       if t1 > 1 then exit(false);
 
       {if j = n then
         begin
              t2:= a[i - 1, j] - count(i - 1, j);
              if t2 <> t1 then exit(false);
         end;
 
       if i = m then
         begin
              t2:= a[i, j - 1] - count(i, j - 1);
              if t2 <> t1 then exit(false);
         end;}
 
       res[i, j]:= t1;
       exit(true);
  end;
 
procedure printres;
  var i, j: byte;
  begin
       for i:= 1 to m do
          begin
               for j:= 1 to n do write(res[i, j],' ');
               writeln;
          end;
       halt;
  end;
 
procedure attempt(i: byte);
  var p, q, u: byte;
      ok: boolean;
  begin
       for p:= 0 to 1 do
          for q:= 0 to 1 do
             begin
                  res[i, 1]:= p;
                  res[1, i]:= q;
                  ok:= true;
                  for u:= 1 to i do
                     if (not fill(u, i)) or (not fill(i, u)) then
                       begin
                            ok:= false;
                            break;
                       end;
                  if not ok then continue;
                  if (i >= m) and (i >= n) then printres;
                  attempt(i + 1);
             end;
  end;
 
begin
     init;
     attempt(1);
end.