thieumao

Bài 10 Phân Việc - Thứ đã sửa

Sep 15th, 2013
139
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 2.47 KB | None | 0 0
  1. {
  2. Nguoi\viec      1       2       3
  3.  
  4. 1               5       7       5
  5. 2               6       2       9
  6. 3               8       5       9
  7. --> Hieu suat max la 7 9 8
  8. }
  9.  
  10. uses crt;
  11. Var
  12.   a,x,xmax:array[1..7] of integer;
  13.   v: array[1..7,1..7] of integer;
  14.   i,j,n,HSX,HSMAX:integer;
  15.  
  16. procedure bandau;
  17. var i,j,k: integer;
  18. begin
  19.  clrscr;
  20.  textcolor(white);
  21.  write('   ');
  22.  for k:=1 to n do write('V',k,' ');
  23.  for i:=1 to n do
  24.   begin
  25.    writeln;
  26.    write('N',i);
  27.    for j:=1 to n do write(v[i,j]:3);
  28.   end;
  29. end;
  30.  
  31. procedure velai;
  32. var i,j,k: integer;
  33. begin
  34.  clrscr;
  35.  textcolor(white);
  36.  write('   ');
  37.  for k:=1 to n do write('V',k,' ');
  38.  for i:=1 to n do
  39.   begin
  40.    writeln;
  41.    write('N',i);
  42.    for j:=1 to n do
  43.     if x[i] <> j then
  44.      begin
  45.       write(v[i,j]:3);
  46.      end
  47.     else
  48.      begin
  49.        textcolor(yellow);
  50.        write(v[i,j]:3);
  51.        textcolor(white);
  52.      end;
  53.   end;
  54.  writeln;
  55.  writeln;
  56.  writeln('HSX= ', HSX);
  57. end;
  58.  
  59. procedure xong;
  60. var i,j,k: integer;
  61. begin
  62.  clrscr;
  63.  textcolor(white);
  64.  write('   ');
  65.  for k:=1 to n do write('V',k,' ');
  66.  for i:=1 to n do
  67.   begin
  68.    writeln;
  69.    write('N',i);
  70.    for j:=1 to n do
  71.     if xmax[i] <> j then
  72.      begin
  73.       write(v[i,j]:3);
  74.      end
  75.     else
  76.      begin
  77.        textcolor(red);
  78.        write(v[i,j]:3);
  79.        textcolor(white);
  80.      end;
  81.   end;
  82.  writeln;
  83.  writeln;
  84.  writeln('HSMAX= ', HSMAX);
  85. end;
  86.  
  87. procedure print;
  88. var j,k:integer;
  89. begin
  90.  //velai; {Ve lai tat ca truong hop}
  91.  HSX:=0;
  92.  for j:=1 to n do HSX:=HSX+v[j,x[j]];
  93.  if (HSX<>HSMAX) then velai else xong;
  94.  delay(3000);
  95. end;
  96.  
  97. procedure print1;
  98. var j,k:integer;
  99. begin
  100.  HSX:=0;
  101.  for j:=1 to n do HSX:=HSX+v[j,x[j]];
  102.  if HSX>HSMAX then
  103.   begin
  104.    HSMAX:=HSX;
  105.    for k:=1 to n do xmax[k]:=x[k];
  106.   end;
  107. end;
  108.  
  109. procedure try(i:integer; t:integer);
  110. var j:integer;
  111.  begin
  112.   if i>n then
  113.     begin
  114.     case t of
  115.     0: print1;
  116.     1: print;
  117.     end;
  118.     end
  119.     else
  120.   for j:=1 to n do
  121.    if (a[j]=0) then
  122.     begin
  123.      x[i]:=j;
  124.      a[j]:=1;
  125.      try(i+1,t);
  126.      a[j]:=0;
  127.     end;
  128.   end;
  129.  
  130. begin
  131.  clrscr;
  132.  HSMAX:=0;
  133.  repeat
  134.   write('Nhap so nguoi va so cong viec n= ');
  135.   readln(n);
  136.  until (n>0) and (n<8);
  137.  writeln('Nhap du lieu: ');
  138.  for i:=1 to n do
  139.  begin
  140.  writeln('Cong viec ',i,': ');
  141.  for j:=1 to n do
  142.   begin
  143.    writeln('Hieu suat cong viec ',i,' cua nguoi ',j,' la: ');
  144.    write('v[',i,',',j,']= ');
  145.    readln(v[i,j]);
  146.   end;
  147.  end;
  148.  bandau;
  149.  try(1,0);
  150.  try(1,1);
  151.  xong;
  152.  readln;
  153. end.
Advertisement
Add Comment
Please, Sign In to add comment