Change background image
Chuyên Tin - Lê Khiết

Go downThông điệp [Trang 1 trong tổng số 1 trang]

© FMvi.vn

on Wed Feb 22, 2012 4:41 pm
Admin
avatar
avatar

Code - Huyền Thoại

___________________________________________________________________________________________________________________________________________
ấn vào để xem :
program doitien;
const fi='doitien.inp';fo='doitien.out';vc=-maxint;
var s,n,w:integer;f:text;
a,t,b:array[1..100] of integer;
l:array[0..100] of integer;
dd:array[1..100] of boolean;
procedure doc;
var i:integer;
begin
assign(f,fi);reset(f);
readln(f,n,s);
for i:=1 to n do readln(f,a[i],b[i]);
close(f);
assign(f,fo);rewrite(f);
end;
procedure khoitao;
var i:integer;
begin
fillchar(dd,sizeof(dd),false);
l[0]:=0;
for i:=1 to s do l[i]:=vc;
end;
procedure xdbang;
var i,j:integer;
begin
for i:=1 to s do
for j:=1 to n do
if a[j]<=i then
begin
if l[i]<(l[i-a[j]]+b[j]) then
begin
l[i]:=l[i-a[j]]+b[j];
t[i]:=j;
end;
end;
end;
procedure truyvet;
var c:array[1..100] of integer;
i:integer;
begin
Fillchar(c,sizeof(c),0);
if l[s]=vc then writeln(f,-1)else
begin
writeln(f,l[s]);
while l[s]<>0 do
begin
i:=t[s];
inc(c[i]);
s:=s-a[i];
end;
for i:=1 to n do
if c[i]>0 then
begin
write(f,i,' ',c[i]);
writeln(f);
end;
end;
end;
BEGIN
doc;khoitao;xdbang;truyvet;close(f);
END.
Code:

program doitien;
const fi='doitien.inp';fo='doitien.out';vc=-maxint;
var  s,n,w:integer;f:text;
    a,t,b:array[1..100] of integer;
    l:array[0..100] of integer;
    dd:array[1..100] of boolean;
procedure doc;
var i:integer;
begin
    assign(f,fi);reset(f);
    readln(f,n,s);
    for i:=1 to n do readln(f,a[i],b[i]);
    close(f);
    assign(f,fo);rewrite(f);
end;
procedure khoitao;
var i:integer;
begin
    fillchar(dd,sizeof(dd),false);
    l[0]:=0;
    for i:=1 to s do l[i]:=vc;
end;
procedure xdbang;
var i,j:integer;
begin
    for i:=1 to s do
    for j:=1 to n do
        if a[j]<=i then
            begin
                if l[i]<(l[i-a[j]]+b[j]) then
                    begin
                        l[i]:=l[i-a[j]]+b[j];
                        t[i]:=j;
                    end;
            end;
end;
procedure truyvet;
var  c:array[1..100] of integer;
    i:integer;
begin
    Fillchar(c,sizeof(c),0);
    if l[s]=vc then writeln(f,-1)else
    begin
          writeln(f,l[s]);
          while l[s]<>0 do
                begin
                    i:=t[s];
                    inc(c[i]);
                    s:=s-a[i];
                end;
          for i:=1 to n do
              if c[i]>0 then
              begin
                  write(f,i,' ',c[i]);
                  writeln(f);
              end;
end;
end;
BEGIN
    doc;khoitao;xdbang;truyvet;close(f);
END.

http://chuyentinlk.123.st

Thích

Báo xấu [0]

Gửi một bình luận lên tường nhà Admin
Trả lời nhanh
on Thu Feb 23, 2012 2:27 pm
Admin
avatar
avatar

Code - Huyền Thoại

Xem:

Program Bai1;
Const fi = 'bai5.inp';
fo = 'bai5.out';
maxn=1000;
Type Cuochop= Record
tt,a,b:Integer;
End;
Var t,l:array[0..100] OF Integer;
Ch:array[1..maxn] of Cuochop;
chon : Array[1..100] Of Boolean;
s,n,m,i,j : Integer;
f,g : Text;
Procedure doctep;
Var i,j : Integer;
Begin
Assign(f,fi);
Reset(f);
Readln(f,n,s);
For i:=1 to n do
Begin
ch[i].tt:=i;
Read(f,ch[i].a);
End;
Readln(f);
For i:=1 to n do
Read(f,ch[i].b);
Readln(f);
Close(f);
End;
Procedure xep;
VAr tg:Cuochop;
Begin
For i:=1 to n-1 do
For j:=i+1 to n do
If ch[i].b > ch[j].b then
Begin
tg:=ch[i];
ch[i]:=ch[j];
ch[j]:=tg;
End;
End;
Procedure khoitao;
Var i,j : Integer;
Begin
Fillchar(l,sizeof(l),0);
l[1]:=1;
Fillchar(chon,sizeof(chon),false);
End;
Procedure xaydung;
Var i,j : Integer;
Begin
For i:=2 to n do
For j:=1 to i-1 do
If (ch[j].b<=ch[i].a) then
If l[i] Begin
l[i]:=l[j]+1;
t[i]:=j;
End;
End;
Procedure truyvet;
Var p,max,vt,i,j:Integer;
Begin
p:=0;
Assign(g,fo);
Rewrite(g);
max:=0;
For i:=1 to n do
If l[i]>max then begin max:=l[i]; vt:=i; end;
i:=vt;
While i>0 do
Begin
chon[i]:=true;
i:=t[i];
End;
writeln(g,max*s);
For i:=1 to n do
If chon[i]=true then write(g,ch[i].tt,' ');
Close(g);
End;
Begin
doctep;
xep;
khoitao;
xaydung;
truyvet;
For i:=1 to n do
Write(ch[i].tt:3);
Writeln;
FOr i:=1 to n do
Write(ch[i].a:3);
Writeln;
For i:=1 to n do
Write(ch[i].b:3);
Readln;
End.
Code:

Program Bai1;
Const fi = 'bai5.inp';
fo = 'bai5.out';
maxn=1000;
Type Cuochop= Record
            tt,a,b:Integer;
            End;
Var t,l:array[0..100] OF Integer;
  Ch:array[1..maxn] of Cuochop;
 chon : Array[1..100] Of Boolean;
 s,n,m,i,j : Integer;
 f,g : Text;
Procedure doctep;
Var i,j : Integer;
 Begin
 Assign(f,fi);
 Reset(f);
 Readln(f,n,s);
 For i:=1 to n do
 Begin
  ch[i].tt:=i;
  Read(f,ch[i].a);
 End;
 Readln(f);
 For i:=1 to n do
  Read(f,ch[i].b);
  Readln(f);
 Close(f);
 End;
Procedure xep;
 VAr tg:Cuochop;
  Begin
  For i:=1 to n-1 do
    For j:=i+1 to n do
    If ch[i].b > ch[j].b then
      Begin
      tg:=ch[i];
      ch[i]:=ch[j];
      ch[j]:=tg;
      End;
  End;
Procedure khoitao;
Var i,j : Integer;
 Begin
 Fillchar(l,sizeof(l),0);
 l[1]:=1;
 Fillchar(chon,sizeof(chon),false);
 End;
Procedure xaydung;
Var i,j : Integer;
 Begin
 For i:=2 to n do
 For j:=1 to i-1 do
 If  (ch[j].b<=ch[i].a) then
  If l[i]<l[j]+1 then
 Begin
 l[i]:=l[j]+1;
  t[i]:=j;
End;
End;
Procedure truyvet;
Var p,max,vt,i,j:Integer;
 Begin
 p:=0;
 Assign(g,fo);
 Rewrite(g);
 max:=0;
 For i:=1 to n do
  If l[i]>max then begin  max:=l[i]; vt:=i; end;
 i:=vt;
 While i>0 do
  Begin
 chon[i]:=true;
 i:=t[i];
 End;
 writeln(g,max*s);
For i:=1 to n do
 If chon[i]=true then write(g,ch[i].tt,' ');
 Close(g);
 End;
Begin
doctep;
xep;
khoitao;
xaydung;
truyvet;
For i:=1 to n do
 Write(ch[i].tt:3);
 Writeln;
FOr i:=1 to n do
 Write(ch[i].a:3);
 Writeln;
For i:=1 to n do
 Write(ch[i].b:3);
 Readln;
End.

_________________


[You must be registered and logged in to see this link.]
http://chuyentinlk.123.st

Thích

Báo xấu [0]

Gửi một bình luận lên tường nhà Admin
Trả lời nhanh
on Thu Feb 23, 2012 3:18 pm
Admin
avatar
avatar

Code - Huyền Thoại

const fi='btht.inp';fo='btht.out';
type cuochop=record a,b,tt,c:integer;
end;
var n,p,max,vt:integer;
ch:array[1..100]of cuochop;
l,t:array[0..100]of integer;
f:text;
procedure doc;
var i:integer;
begin
assign(f,fi);reset(f);
readln(f,n);
for i:=1 to n do
begin
ch[i].tt:=i;
read(f,ch[i].a);
end;
Readln(f);
for i:=1 to n do read(f,ch[i].b);
readln(f);
for i:=1 to n do read(f,ch[i].c);
close(f);
end;
procedure sx;
var tg:cuochop;i,j:integer;
begin
for i:=1 to n-1 do
for j:=i+1 to n do
if ch[i].b>ch[j].b then
begin
tg:=ch[i];
ch[i]:=ch[j];
ch[j]:=tg;
end;
end;
procedure khoitao;
var i:integer;
begin
fillchar(l,sizeof(l),0);
l[0]:=0;
l[1]:=ch[1].c;
fillchar(t,sizeof(t),0);
assign(f,fo);rewrite(f);
end;
procedure xdbang;
var i,j:integer;
begin
for i:=2 to n do
for j:=1 to i-1 do
if (ch[j].b begin
l[i]:=ch[i].c+l[j];
t[i]:=j;
end;
end;

procedure xuat;
var i:integer;
begin
max:=l[1];
for i:=2 to n do if l[i]>max then
begin
max:=l[i];
vt:=i;
end;
writeln(f,l[vt]);
end;
procedure truyvet;
var i:integer;chon:array[1..100]of boolean;
begin
fillchar(chon,sizeof(chon),false);
i:=vt;
while l[i]>0 do
begin
chon[i]:=true;
i:=t[i];
end;
for i:=1 to n do if chon[i]=true then write(f,ch[i].tt,' ');
end;
BEGIN
doc;
sx;
khoitao;
xdbang;
xuat;
truyvet;
close(f);

END.

_________________


[You must be registered and logged in to see this link.]
http://chuyentinlk.123.st

Thích

Báo xấu [0]

Gửi một bình luận lên tường nhà Admin
Trả lời nhanh
Sponsored content

Thích

Báo xấu [0]

Gửi một bình luận lên tường nhà Sponsored content
Trả lời nhanh

Về Đầu TrangThông điệp [Trang 1 trong tổng số 1 trang]

  © FMvi.vn

|_-Diễn Đàn Tin Học - Lê Khiết-_|

« Xem bài trước | Xem bài kế tiếp »

Bài viết liên quan

    Quyền hạn của bạn:

    Bạn không có quyền trả lời bài viết