i had just tried all given test ?but it WA in #1 .
Const   finp    ='';
        Fout    ='';
        Maxn    =101;
        Limit   =200000;
var     fi,fo   :Text;
        n,s     :Longint;
        A       :array[0..Maxn] of Integer;
        d,f     :array[0..Limit] of Integer;
Procedure       OpenFile;
Begin
        Assign(fi,finp); Reset(fi);
        Assign(fo,fout); Rewrite(fo);
End;

Procedure       CloseFile;
Begin
        Close(fi); Close(fo);
End;

Procedure       Readinp;
Var     i:Integer;
        sum:Longint;
Begin
        Readln(fi,s);
        readln(fi,n);
        For i:=1 to n do Read(fi,a[i]);
end;

Procedure       Solve;
Var     i,st,Maxtong,Max:Longint;
Begin
        Fillchar(d,sizeof(d),0);
        Fillchar(f,sizeof(f),0);
        f[0]:=1; maxtong:=0;
        For i:=1 to n do
        Begin
                Max:=Maxtong;
                For st:=Maxtong downto 0 do
                if f[st] <>0 then
                Begin
                        if f[st+a[i]]=0 then
                        Begin
                                f[st+a[i]]:=i;
                                d[st+a[i]]:=1;
                        end else d[st+a[i]]:=d[st]+d[st+a[i]];
                        if max<st+a[i] then Max:=st+a[i];
                ENd;
                Maxtong:=max;
        End;
End;

Procedure       Trace;
Var     i,dem:Integer;
Begin
        if d[s]=0 then Writeln(fo,0)
        else if d[s] >1 then Writeln(fo,-1)
        else
        Begin
                dem:=0;
                While s>0 do
                Begin
                        Inc(dem); d[dem]:=f[s];
                        s:=s-a[f[s]];
                        if s=0 then Break;
                End;
                For i:=dem downto 1 do Write(fo,d[i],' ');
        End;
End;

begin
        OpenFile;
        Readinp;
        Solve;
        Trace;
        CloseFile;
End.

Edited by author 29.11.2008 18:30