THUẬT TOÁN và KỸ THUẬT LẬP TRÌNH

[trungvu]

Topic này sẽ là nơi post những Thuật toán cũng như những Kĩ thuật lập trình hay (nhớ kèm theo ví dụ cho dễ hiểu).
Đề nghị các bạn không spam lung tung chỉ click nút Thanks khi thấy bài viết hữu ích.
Những bạn nào vi phạm sẽ bị Del bài.

[aukid412]

Em xin đóng góp 1 giải thuật đảo chữ theo tiếng ( không phải đảo chữ cái ):

uses crt;
var a,b,c,d,i,h,dem:integer;t,t1,t2,t3:string;
begin
clrscr;
write('Nhap vao ');readln(t);
begin
while t[1]=' ' do delete(t,1,1);
while t[length(t)]=' ' do delete(t,length(t),1);
for a:=1 to length(t) do
while (t[a]=' ') and (t[a+1]=' ') do delete(t,a,1);
end;
t:=' '+t+' ';
for c:=1 to length(t) do
if t[c]=' ' then
t2:=copy(t,1,length(t)-c);
 
for b:=length(t) downto 1 do
if t[b]=' ' then
begin
t1:=t1+copy(t,b,length(t)-b);
delete(t,b,length(t)-b);
end;
t3:=t2+t1;
delete(t3,1,1);
write('Cau dao nghich la ','"',t3,'"');
readln;
end.

#-o

[sownlee]

Kỹ thuật khử đệ quy
​

Trần Đức Thiện
​

Đệ quy là quả tim trong các nghiên cứu lý thuyết cũng như thực hành tính toán, đã thể hiện rất nhiều sức mạnh và có ưu điểm trong nhiều bài toán. Tuy nhiên bài này tôi lại đi ngược với công việc chúng ta thường làm: khử đệ quy, đó là vấn đề cũng có nhiều thú vị và đáng để chúng ta xem xét.


Khử đệ quy ở đây là biến một thủ tục đệ quy thành một thủ tục chỉ chứa vòng lặp mà không ảnh hưởng gì đến các yếu tố khác, chứ không phải là thay đổi thuật toán. Ví dụ như trong các hàm đệ quy tính n! và số Fibonaci F(n) ta có thể thay bằng một vòng lặp để tính; Đó không phải là phương pháp khử đệ quy mà tôi muốn nói. Trong trường hợp tổng quát, khử đệ quy là một việc làm khá phức tạp và khó khăn. ở hàm n! hay F(n) ta có thể dùng một thuật toán không đệ quy, nhưng trong một số bài toán, đệ quy là bắt buộc. Bạn có thể nói rằng, vậy thì cứ sử dụng đệ quy, vừa ngắn gọn dễ hiểu, vừa dễ cài đặt. Nhưng có đôi khi, sự hạn hẹp của bộ nhớ dành cho chương trình con không cho phép chúng ta làm điều đó; hoặc chúng ta biết rằng, ngôn ngữ máy không có đệ quy, vì vậy các trình biên dịch đều phải có nhiệm vụ khử đệ quy. Và bạn có thể thực sự gặp rắc rối với thủ tục đệ quy của mình khi trong một môi trường lập trình mà không cung cấp khả năng gọi đệ quy. Khử đệ quy giúp bạn vẫn giữ được nguyên bản thuật toán đệ quy của mình mà không hề có lời gọi đệ quy, và như thế chương trình có thể chạy được trong bất kỳ môi trường lập trình nào.
Khử đệ quy thực chất là chúng ta phải làm công việc của một trình biên dịch đối với một thủ tục, đó là: Đặt tất cả các giá trị của các biến cục bộ và địa chỉ của chỉ thị kế tiếp vào ngăn xếp (Stack), quy định các giá trị tham số cho thủ tục và chuyển tới vị trí bắt đầu thủ tục, thực hiện lần lượt từng câu lệnh. Sau khi thủ tục hoàn tất thì nó phải lấy ra khỏi ngăn xếp địa chỉ trả về và các giá trị của các biến cục bộ, khôi phục các biến và chuyển tới địa chỉ trả về.


Để dễ theo dõi chúng ta lấy ví dụ với bài toán cụ thể là bài toán duyệt cây. Giả sử có một cây nhị phân lưu trữ trong biến động t được định nghĩa:

type pnode = ^node;
node = record
  inf : variable; { truong luu tru thong tin }
  l,r : pnode;
end;
var t : pnode;

Xuất phát từ nút gốc t, cần duyệt qua hết cây theo thứ tự từ trái qua phải. Chương trình con đệ quy sẽ như sau:

procedure Try(t : pnode);
begin
if t <> nil then
  begin
    visit(t);
    Try(t^.l);
    Try(t^.r);
  end;
end;

Trước hết có thể thấy rằng lệnh gọi đệ quy thứ hai có thể được khử dễ dàng bởi không có mã lệnh theo sau nó. Khi lệnh này thực hiện thì thủ tục Try( ) được gọi với tham số t^.r và khi lệnh gọi này kết thúc thì thủ tục Try hiện hành cũng kết thúc. Chương trình được viết lại như sau dùng goto:

     procedure try(t : pnode);
label 0;
begin
0 : if t = nil then exit;
visit(t);
try(t^.l);
t := t^.r;
goto 0;
end;

Đó là kỹ thuật rất nổi tiếng được gọi là khử đệ quy phần cuối. Việc khử lần gọi đệ quy còn lại đòi hỏi phải làm nhiều việc hơn. Giống như một trình biên dịch chúng ta phải tổ chức một ngăn xếp (Stack) để lưu trữ các biến cục bộ, các tham số, và sử dụng các thủ tục:

Push(t): Đặt biến t vào đỉnh Stack;
Hàm pop: lấy 1 giá trị ở đỉnh stack.
Hàm stackempty: Báo hiệu Stack đã rỗng.

ở đây không có giá trị trả về và chỉ có một biến cục bộ là t nên chúng ta sẽ nạp nó vào stack nếu chưa được xử lý và ở mỗi bước chúng ta lấy biến ở đỉnh stack ra để xử lý nó và các nút con tiếp theo của nó. Chương trình khử cả lời gọi đệ quy thứ hai sẽ như sau:

procedure try(t : pnode);
label 0,1,2;
begin
0: if t = nil then goto 1;
visit(t);
push(t);
t := t^.l;
goto 0;
2 : t := t^.r; goto 0;
1 : if stackempty then exit;
t := pop;
goto 2;
end;

Thủ tục trên chỉ là diễn giải thô của ý tưởng để các bạn dễ hiểu, vì vậy các chỉ thị goto còn rườm ra, chúng ta sẽ viết lại một cách có cấu trúc hơn như sau:

procedure try(t : pnode);
label 0;
begin
0: while t <> nil do
begin
visit(t);
push(t^.r);
t := t^.l
end;
if stackempty then exit;
t := pop;
goto 0;
end;

Bây giờ, loại bỏ hoàn toàn các chỉ thị goto và tránh trường hợp nạp các nút rỗng vào stack ta có thủ tục duyệt cây không đệ quy chuẩn như sau, các bạn sẽ thấy rằng về bản chất nó không khác thủ tục đệ quy là mấy:

procedure try(t : pnode);
begin
  push(t);
  repeat
    t := pop;
    visit(t);
    if t^.l <> nil then push(t^.l);
    if t^.r <> nil then push(t^.r);
  until stackempty;
end;

Để minh hoạ cụ thể hơn cho kỹ thuật này, tôi xin trình bày với các bạn chương trình sắp xếp nhanh(QuickSort) khử đệ quy:

Program Quick_sort_Khu_de_quy_Th;
  const
    inp = 'FileName.inp';
    out = 'FileName.out';
    maxstack = 1000;
    maxn = 1000;
  type
    it = longint;
  var
    a : array[1..maxn] of it;
    sl,sr : array[1..maxstack] of word;
    n,top : it;
    f : text;
   
  procedure push(l,r : word);
  begin
    inc(top);
    sl[top] := l;
    sr[top] := r;
  end;
   
  procedure pop(var l,r : word);
  begin
    l := sl[top];
    r := sr[top];
    dec(top);
  end;
   
  function stackEmpty : boolean;
  begin
    stackempty := top = 0;
  end;
   
  procedure init;
  begin
    top := 0;
  end;
   
  procedure nhap;
  var
    i : it;
  begin
    assign(f,inp);
    reset(f);
    readln(f,n);
    for i := 1 to n do read(f,a[i]);
    close(f);
  end;
   
  procedure sort(l1,r1 : word);
  var
    l,r,i,j : word;
    t,tg : it;
  begin
    push(l1,r1);
    repeat
      pop(l,r);
      i := l;
      j := r;
      t := a[(l+r) div 2];
      repeat
        while a[i] < t do inc(i);
        while t < a[j] do dec(j);
        if i <= j then
        begin
          tg := a[i];
          a[i] := a[j];
          a[j] := tg;
          inc(i);
          dec(j);
        end;
      until i > j;
   
      if i < r then push(i,r);
      if l < j then push(l,j);
    until stackEmpty;
  end;
   
  procedure xuat;
  var
    i : it;
  begin
    assign(f,out);
    rewrite(f);
    for i := 1 to n do write(f,a[i],' ');
    close(f);
  end;
   
  BEGIN
    nhap;
    init;
    sort(1,n);
    xuat;
  END.

Trong một lúc nào đó chúng ta có thể khảo sát tính hiệu quả của việc khử đệ quy. Còn bây giờ bạn vẫn có thể trung thành với thủ tục Try đệ quy của mình, nó thực sự ngắn gọn, dễ hiểu và dễ cài đặt. Dù có thể không dùng đến nhưng nghiên cứu thêm là một việc không hề thừa. Biết đâu sau này bạn trở thành một người viết chương trình dịch thì sao, thế thì nó − bài viết này rất bổ ích cho bạn rồi đấy. Chào thân ái và hẹn gặp lại.

[bentremegumi]

Mình xin cung cấp thêm 2 thuật toán tìm kiếm và sắp sếp (tăng dần) với thời gian tính toán tốt hơn làm tuần tự:
* Sắp xếp (Quick Soft):

Procedure QS(var a:array[1..n] of integer);
Procedure Soft(left,right:integer);
Var i,j,a,x:integer;
Begin
X:=A[(left+right) div 2];
i:=left;
j:=right;
Repeat
While (a<x) do inc(i);
While (A[j]>x) do dec(j);
If j<=j then
Begin
[i] a{biến trung gian}:=a;
[i] a:=a[j];
a[j]:=a;
inc(i);
dec(j);
End;
Until i>j;
If left<j then sort(left,j);
If i<right then sort(i,right);
Begin
sort(1,n);
End;
End.

---------------------------------------------------------------------------
< Thuật toán trên được làm theo cách top-down, tức là cùng làm điều kiện (ở đây là xử lý phần tử giữa mảng với phần tử đầu (cuối) rồi xét điều kiện để hoán vị) cho mảng ban đầu rồi cho các mảng chia nhỏ theo phương thức nhị phân (từ phần tử đầu đến phần tử giữa mảng, từ phần tử liền sau phần tử giữa mảng đến phần tử cuối mảng >
Lưu ý: áp dụng cho mảng được sắp sếp theo thứ tự tăng dần, điều kiện để rút ngắn thời gian tính toán của một số bài tìm kiếm sự có mặt trong mảng.
* Tìm kiếm:

Function Tim(x:integer;a:array[1..n] of integer):word;
Var dau,giua,cuoi:integer;
Begin
dau:=1;cuoi:=n;
While cuoi>=dau do
Begin
giua:=(dau+cuoi) div 2;
If (a[giua]<x) then
dau:=giua+1
Else
If (x<a[giua]) then
cuoi:=giua-1;
Else
cuoi:=-1;
End;
If cuoi:=-1 then Tim:=giua
else Tim:=0;
End.

-----------------------------------------------------------------------------------
< Thuật toán sử dụng chia mảng chứa dữ liệu thành các mảng nhỏ hơn, với cùng một thuật toán cho các mảng (nhỏ, lớn) cho ta một thời gian tính toán chấp nhận được >
Lưu ý: Thuật toán chỉ sử dụng được với mảng được sắp xếp theo thứ tự tăng dần.
> Có gì sai sót hoặc ý kiến cải thiện thuật toán xin liên hệ YM!:isukeshiro <[IMG]data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAEAAAABAQMAAAA l21bKAAAAA1BMVEXh5PJm+yKVAAAAAXRSTlMAQObYZgAAAApJR EFUCNdjYAAAAAIAAeIhvDMAAAAASUVORK5CYII=[/IMG])

[duancanhotp]

Thuật toán 8 quân hậu và mã đi tuần chắc hẳn khá quen thuộc với các bạn, nhưng nhiều bạn vẫn chưa có một chương trình tham khảo, với kinh nghiệm của mình, mình xin đưa ra giải thuật cho hai bài toán đó:
8 quân hậu:

[/U]

Var 
a:array[1..8] of integer;
b:array[2..16] of integer;
c:array[-7..7] of integer;
x:array[1..8] of integer;
i:integer;
Procedure print;
var j:integer;
Begin
For j:=1 to 8 do write(x[k]:4);
Writeln;
Readln;
end;
Procedure try(i:integer);
var j:integer;
Begin
If i>8 then print 
Else for j:=1 to 8 do
if (a[j]=0) and (b[i+j]=0) and (c[i-j]=0) then
Begin
x:=j;
a[j]:=1;b[i+j]:=1;c[i-j]:=1; {thông cảm, mình làm biếng xuống hàng rồi gõ space quá:emlaugh:}
try(+1);
a[j]:=0;b[i+j]:=0;c[i-j]:=0; {bạn biết lý do không xuống hàng rồi nhỉ :shifty:}
End;
End;
Procedure init;
var j:integer;
Begin
fillchar(a,sizeof(a),0);
fillchar(b,sizeof(b),0);
fillchar(c,sizeof(c),0);
end;
Begin
init;
try(1);
End;

---------------------------------------------------
Mã đi tuần:

[/U]

Const
a:array[1..8] of integer=(2,1,-1,-2,-2,-1,1,2);
b:array[1..8] of integer=(1,2,2,1,-1,-2,-2,-1);
n=5;nsq=25;
Type
index=1..n;
var
q:boolean;
dd:array[index,index] of integer;
s:set of index;
x,y:integer;
procedure init;
begin
fillchar(dd,size of(dd),0);
writeln('Cho biet toa do ban dau cua ngua');
readln(x,y);
dd[x,y]:=1;
q:=false;
s:=[1,2,3,4,5];
end;
procedure print;
var i,j:integer;
begin
q:=true;
for j:=1 to n do
begin
for j:=1 to n do write(dd[i,j]:5);
writeln;
end;
end;
procedure try(i);
var j,u,v:integer;
begin
if i>nsq then
print
else for j:=1 to 8 do
begin
u:=x+a[j];
v:=y+b[j];
if (u in s) and (v in s) and (dd[u,v]=0) then
begin
dd[u,v]:=i;
x:=u;y:=v;
try(i+1);
x:=u-a[j];y:=v-b[j];
dd[u,v]:=0;
end;
end;
end;
BEGIN
init;
try(2);
if q=false then writeln('no solution');
end;

--------------------------------------------------------------------------------
2 bài trên là mình đóng góp chứ không phải ý tưởng của mình, có gì thắc mắc mấy bạn hỏi 1 lượt để mình trả lời, mình hiện tại chưa thật sự rõ giải thuật này :emlaugh:[/B][/B]

[jindo11111]

Sơ đồ đệ quy quay lui

Về sơ đồ đệ quy quay lui hẳn là có nhiều người đã biết, song bên cạnh đó số người không biết không phải là ít, mình xin cung cấp sơ đồ như sau:
procedure try(i:integer);
var j:integer;
begin
if i>m then print{hàm xuất} else
for j:=1 to n do if Nhận được then
begin
Ghi nhận nó;
try(i+...);
Xóa bỏ ghi nhận; {back}
end;
end;
-----------
Sau đó khởi động với try(1).
Hi vọng sơ đồ này sẽ giúp ít cho nhiều bạn muốn tìm hiểu về đệ quy:book:. Thân

[langocthao]

Công thức thu gọn

Tổng n số nguyên dương lẻ đầu tiên: bạn sẽ phải dùng 1 dòng while hay repeat để tính giá trị tổng, bạn hãy quên nó đi, sử dụng công thức: Tổng các số nguyên dương lẻ=n^2.
Tổng n số nguyên dương chẵn đầu tiên: Được tính theo công thức f(n)=2*(f(n-1)+n). Dùng đệ quy nhá.
Tổng số hoán vị n số tự nhiên đầu tiên (1<=n<=9): bạn làm từng hoán vị rồi đếm à, hãy xem công thức mới nhé: n!.
Tổng số tập hợp tạo bởi 2 phần tử của tập hợp a (mảng a): Nghe phức tạp nhỉ, mình đã chứng minh, yên tâm nhé: Sum(x,1,n-1). (n là số phần tử mảng a).
Tổng số đường thằng trong mặt phẳng tạo bởi n điểm bất kỳ: chà, công thức hơi rắc rối: tổ hợp chập 2 của n: n!/(2*(n-2)!).
Chúc các bạn học tốt. Thân.

[seller79]

Mình xin trình bày giải thuật đảo chuỗi thành chuỗi ngược lại mà không sử dụng đến for, while hay repeat...until... :

procedure xuly(i:integer);
var s1:string;
begin
  if i<1 then write(s)
     else
         begin
              s1:=copy(s,i,1);
              delete(s,i,1);
              s:=s+s1;
              xuly(i-1);
         end;
end;

Ai có cách khác post lên cho anh em học tập nhé!:book:

[dangban321]

Sau đây là giải thuật in ra hoán vị của n số nguyên dương đầu tiên, số n nằm trong file f.inp , các hoán vị nằm trong tệp f.out.

[/FONT]
const fi='f.inp';
      fo='f.out';
      max=20;
var i,n:integer;a:array[1..max] of byte;b:array[1..max]of boolean;
    f:text;
procedure print;
var k:integer;
begin
     for k:=1 to n do write(f,a[k]);
     writeln;
end;
procedure xuly(i:integer);
var j:integer;
begin
     if i>n then print
        else
            for j:=1 to n do
                if b[j] then
                   begin
                        a[i]:=j;
                        b[j]:=false;
                        xuly(i+1);
                        b[j]:=true;
                   end;
end;
procedure input;
begin
     assign(f,fi);
     reset(f);
     read(f,n);
     close(f);
end;
procedure output;
begin
     assign(f,fo);
     rewrite(f);
     xuly(1);
     close(f);
end;
BEGIN
     input;
     for i:=1 to n do b[i]:=true;
     output;
END.
[FONT=Courier New]

Thân.:book:

[minhkiet0907]

Giải thuật tính số fibonacy cỡ lớn!

Kỹ thuật tính hạng tử thứ n trong dãy fibonacy: 1 1 2 3 5 8 13 21 34 55 ....

uses crt;
var n,i:byte;a,b:extend;
begin
        clrscr;
        write('Nhap n ');
        readln(n);
        a:=1;
        b:=1;
        for i:=3 to n do
                if a>b then b:=b+a
                        else a:=a+b;
        if a>b then write('f(n)=',a:0:0)
                else write('f(n)=',b:0:0);
        readln;
end.

:book: