Cân đĩa

 Tin học trẻ quốc gia 2010 - Bài 2/3
Cho một cân đĩa và n quả cân đánh số từ 1 tới n. Quả cân thứ i có khối lượng là i (i = 1..n). Với một vật khối lượng m, người ta đặt vật đó vào đĩa cân bên trái sau đó đặt thêm một số quả cân lên hai đĩa cân sao cho cân thăng bằng từ đó xác định được trọng lượng của vật. Ta goi một cách làm như vậy là một cách cân vật có khối lượng m.
Hai cách cân được gọi là khác nhau nếu tập các quả cân ở đĩa trái trong hai cách cân là khác nhau hoặc tập các quả cân ở đĩa phải trong 2 cách cân là khác nhau.

Ví dụ với n = 4, m = 2 ta có 7 cách cân:

2 - 2
2 1 - 3
2 2 - 4
2 2 - 1 3
2 3 - 1 4
2 4 - 1 2 3
2 1 3 - 2 4

(Số đầu tiên bên trái của mỗi hàng là vật nặng m)
Test
n = 4,m = 2
n = 6,m = 11
n = 10,m = 22
n = 11,m = 33
n = 13,m = 44
n = 16,m = 55
n = 25,m = 66
n = 36,m = 77
n = 99, m = 88
n = 100,m = 100

                                                           Lời giải tham khảo

var
        a,t,p: array[1..100] of integer;
        b: array[1..100] of boolean;
        i,k,m,n,vt,vp: integer;
        d: real;
procedure inra;
        begin
                for i:=1 to n do
                   if t[i]<>0 then write(t[i],' ');
                write(' - ');
                for i:=1 to n do
                   if p[i]<>0 then write(p[i],' ');
                writeln;
                d:=d+1;
        end;
procedure tryp(i:integer) ;
        var j:integer;
        Begin
                if vp=vt then inra
                else
                for j:=i to n do
                        if b[j] then
                        if vp<vt then
                        begin
                                vp:=vp+j;
                                p[i]:=j;
                                b[j]:=false;
                                tryp(j+1);
                                b[j]:=true;
                                vp:=vp-j;
                                p[i]:=0;
                        end;
        end;
Procedure try(i: integer);
        var j:integer;
        begin
                for j:= i to n do
                if b[j] then
                        begin

                                vt:= vt+j;
                                t[i+1]:=j;
                                b[j]:=false;
                                vp:=0;
                                tryp(1);
                                try(i+1);
                                b[j]:=true;
                                vt:=vt-j;
                                t[i+1]:=0;

                        end;
        end;
BEGIN
        Write('nhap n, m: '); readln(n,m);
        vt:=m;
        t[1]:=m;
        for i:=1 to n do b[i]:=true;
        try(1);
        if m<=n then
                begin
                        writeln(m,' - ',m);
                        d:=d+1;
                end;
        write(d);
        readln;
END.