game box tin - Chém code như chém gió

C

cuong276

Mã:
const inp='cuong.inp';
      outp='cuong.out';
var i,k,j,n:integer;
   fi,fo:text;
   tg,dem:integer;
   a,b,c:array[1..200] of  integer;
procedure   nhap;
    begin
        assign(fi,inp);
        reset(fi);
           read(fi,n );
           for i:=1 to n do
            begin
              read(fi,a[i]);
              c[i]:=a[i];
            end;
            j:=i;
           for i:=1 to n do
             begin
               read(fi,b[i]);
               c[i+j]:=b[i]   ;
             end;
        close(fi);
             assign(fo,outp);
     rewrite(fo);

    end;

function kiemtra(x:integer):boolean;
var
   kt1,kt2,kt3,kt4:boolean;

  begin
     kt1:=false;
     kt2:=false;
     kt3:=false;
     kt4:=false;
     for i:=1 to n do
       begin
         if c[x]=b[i] then kt1:=true else kt3:=true;
         if c[x+1]=a[i] then kt2:=true else kt4:=true;
       end;
    if (kt1 and kt2) or (kt3 and kt4) then
    kiemtra:=true;
  end;
procedure sapsep;
   begin
      for i:=1 to 2*n do
         for j:=1 to i do
           if c[i]> c[j] then
              begin
                 tg:=c[i];
                 c[i]:=c[j];
                 c[j]:=tg;
              end;
   end;
procedure xuli;
  begin
     sapsep;
     for k:=1 to 2*n-1 do
        if kiemtra(k) then dem:= dem+1;
     write(fo,dem);
     close(fo);
  end;
begin
   nhap;
   xuli;
end.

Ha ha ha. Anh ơi anh ởi anh ời, anh ơi anh ởi anh ời anh ơi. Anh Thành ơi sai rồi anh ơi. Code anh chạy cho ra kết quả là 5 mà theo đề ra kết quả lại là 2. Ai bảo anh cho tên em thành tên tệp nên trời phạt cho chương trình chạy sai rồi đó. Ha ha ha. Đùa đó. Anh coi lại code đi nha anh.
 
Q

quanghero100

Tui chém code mệt rồi, đao mòn rồi, cần có thời gian mài lại đã. Bây giờ đến mọi người chém đi. Đề chém nè
Nối điểm đen trắng
Trên trục số thực cho n điểm đen và n điểm trắng hoàn toàn phân biệt. Các điểm đen có toạ độ nguyên a1, a2, ..., an còn các điểm trắng có toạ độ nguyên b1, b2, ..., bn. Người ta muốn chọn ra k điểm đen và k điểm trắng để nối mỗi một điểm đen với một điểm trắng sao cho k đoạn thẳng tạo được đôi một không có điểm chung.
Yêu cầu: Cho toạ độ của n điểm đen a1, a2, ..., an và toạ độ của n điểm trắng b1, b2, ..., bn, hãy tìm giá trị k lớn nhất thoả mãn yêu cầu nêu trên.
Dữ liệu: Vào từ file văn bản BWPOINTS.INP:
• Dòng thứ nhất chứa số nguyên dương n (n ≤ 105);
• Dòng thứ hai chứa các số a1, a2, ..., an (|ai| ≤ 109, i = 1, 2, ..., n);
• Dòng thứ ba chứa các số b1, b2, ..., bn (|bi| ≤ 109, i = 1, 2, ..., n).
Các số trên cùng một dòng được ghi cách nhau ít nhất một dấu cách.
Kết quả: Ghi ra file văn bản BWPOINTS.OUT một số nguyên duy nhất là số k lớn nhất tìm được.
Ví dụ:
BWPOINTS.INP
BWPOINTS.OUT
3
0 3 1
-3 5 -1
2
Ràng buộc: 50% số tests ứng với 50% số điểm của bài có 1 ≤ n ≤ 100.
Mã:
uses crt;
var a,b,c,d:array[1..300] of real;
    n,t,k:integer;
    tg:real;
procedure input;
var f:text;
    i,j:integer;
begin
   assign(f,'BWPOINT.INP');
   reset(f);
   readln(f,n);
   j:=0;
   for i:=1 to n do
     begin
        read(f,a[i]);
        inc(j);
        c[j]:=a[i];
     end;
   readln(f);
   for i:=1 to n do
     begin
        read(f,b[i]);
        inc(j);
        c[j]:=b[i];
     end;
   close(f);
end;
procedure quicksort(h,l:integer);
var t,x:real;
    k,i,j:integer;
begin
   i:=h;
   j:=l;
   x:=d[random(h-l+1)+l];
   repeat
       while d[i]<x do inc(i);
       while d[j]>x do dec(j);
       if i<=j then
          begin
             t:=d[i];
             d[i]:=d[j];
             d[j]:=t;
             inc(i);
             dec(j);
          end;
   until i>j;
   if h<j then quicksort(h,j);
   if l>i then quicksort(i,l);
end;
function kt1(k:integer):boolean;
var i:integer;
begin
  kt1:=false;
  for i:=1 to n do
    if a[i]=d[k] then
       begin
          kt1:=true;
          break;
       end;
end;
function kt2(k:integer):boolean;
var i:integer;
begin
  kt2:=false;
  for i:=1 to n do
    if b[i]=d[k] then
       begin
          kt2:=true;
          break;
       end;
end;
procedure xuli;
var u,i,j:integer;
    f:text;
    kt3,kt4:boolean;
begin
 assign(f,'BWPOINT.OUT');
 rewrite(f);
 u:=0;
 {d:=a; quicksort(1,n); a:=d;
 d:=b; quicksort(1,n); b:=d; }
 d:=c; quicksort(1,2*n); c:=d;
 i:=0;
 repeat
     inc(i);
     kt3:=kt1(i);
     if kt3=true then
       begin
          repeat
              inc(i);
              kt4:=kt2(i);
          until (kt4=true) or (i>=2*n);
       end
     else
       begin
          repeat
              inc(i);
              kt3:=kt1(i);
          until (kt3=true) or (i>=2*n);
       end;
     if (kt3=true) and (kt4=true) then inc(u);
 until i>=2*n;
 write(f,u);
 close(f);
end;
begin
  input;
  xuli;
end.
Làm hơi dài xíu :D:D:D có thể bỏ bớt việc sắp xếp hai mảng a và b đi cũng được
 
Last edited by a moderator:
C

cuong276

Bài của anh thì đúng là dài thật, sai chỗ nào thì em không biết nhưng em thấy chương trình cho ra kết quả là 1. Trong đề ra thì kết quả phải là 2 mà anh. Anh xem lại chương trình nha.
 
Q

quanghero100

Bài của anh thì đúng là dài thật, sai chỗ nào thì em không biết nhưng em thấy chương trình cho ra kết quả là 1. Trong đề ra thì kết quả phải là 2 mà anh. Anh xem lại chương trình nha.

em nói sao ấy chứ, anh test đúng mà anh còn thử một vài test khác thấy đúng anh mí dám post bài mừ :S:S:S thui cứ để anh copy post lại em chạy thử phát nửa xem :D:D
 
Q

quanghero100

Đã cập nhật lại rùi đó em test lại coi anh vừa test lại đúng như thường :S:S:S lần này mà sai nữa thì bó tay thôi :D:D
 
C

cuong276

Hi hi hi. Đúng là bó tay thật. Em cóp nguyên cái code của anh mà vẫn chạy sai anh à. Kết quả em chạy vẫn được 1. Chạy nhiều lần vẫn là 1.
 
Q

quanghero100

Hi hi hi. Đúng là bó tay thật. Em cóp nguyên cái code của anh mà vẫn chạy sai anh à. Kết quả em chạy vẫn được 1. Chạy nhiều lần vẫn là 1.

chú có kiểm tra lại file vào chưa đó
3
0 3 1
-3 5 -1
đừng bày file vào một đường mà cứ đối chiếu với file out theo ví dụ thì tội lỗi lắm đấy
anh vừa copy cái code anh post tạo một file mới và chạy thử cũng cho ra kết quả là 2 như vậy mối nghi ngờ cái code anh post bị gì là không xảy ra thế nhưng em test lại sai thì vô lí hết sức haizzz nản thật
 
C

cuong276

Em tạo lại file mới mà vẫn thế, kết quả vẫn bằng 1. Anh thử viết ra 1 số test và kết quả để em thử chạy coi sao
 
Q

quanghero100

test 1:
4
2 3 5 4
0 1 6 7
kết quả: 2
test 2:
5
1 3 5 7 9
2 4 6 8 10
kết quả: 5
test 3:
5
1 3 5 6 7
2 4 8 9 10
kế quả: 3
 
Q

quanghero100

Thôi bỏ code cũ đi anh điều chỉnh lại rùi đây
Mã:
uses crt;
var a,b,c,d:array[1..300] of real;
    n,t,k:integer;
    tg:real;
procedure input;
var f:text;
    i,j:integer;
begin
   assign(f,'BWPOINT.INP');
   reset(f);
   readln(f,n);
   j:=0;
   for i:=1 to n do
     begin
        read(f,a[i]);
        inc(j);
        c[j]:=a[i];
     end;
   readln(f);
   for i:=1 to n do
     begin
        read(f,b[i]);
        inc(j);
        c[j]:=b[i];
     end;
   close(f);
end;
procedure quicksort(h,l:integer);
var t,x:real;
    k,i,j:integer;
begin
   i:=h;
   j:=l;
   x:=d[random(h-l+1)+l];
   repeat
       while d[i]<x do inc(i);
       while d[j]>x do dec(j);
       if i<=j then
          begin
             t:=d[i];
             d[i]:=d[j];
             d[j]:=t;
             inc(i);
             dec(j);
          end;
   until i>j;
   if h<j then quicksort(h,j);
   if l>i then quicksort(i,l);
end;
function kt1(k:integer):boolean;
var i:integer;
begin
  kt1:=false;
  for i:=1 to n do
    if a[i]=d[k] then
       begin
          kt1:=true;
          break;
       end;
end;
function kt2(k:integer):boolean;
var i:integer;
begin
  kt2:=false;
  for i:=1 to n do
    if b[i]=d[k] then
       begin
          kt2:=true;
          break;
       end;
end;
procedure xuli;
var u,i,j,m:integer;
    f:text;
    kt3,kt4:boolean;
begin
 assign(f,'BWPOINT.OUT');
 rewrite(f);
 u:=0;
 d:=a; quicksort(1,n); a:=d;
 d:=b; quicksort(1,n); b:=d;
 d:=c; quicksort(1,2*n); c:=d;
 i:=0;
 kt3:=false;
 kt4:=false;
 repeat
    m:=0;
    inc(i);
    if kt1(i)=true then
      begin
         repeat
             inc(i);
         until (kt2(i)=true) or (i>=2*n);
         if kt2(i)=true then inc(m);
      end
    else if kt2(i)=true then
      begin
         repeat
             inc(i);
         until (kt1(i)=true) or (i>=2*n);
         if kt1(i)=true then inc(m);
      end;
    if m>0 then inc(u);
 until i>=2*n;
 write(f,u);
 close(f);
end;
begin
  input;
  xuli;
end.
 
1

11thanhkhoeo

Mã:
const inp='cuong.inp';
      outp='cuong.out';
var i,k,j,n:integer;
   fi,fo:text;
   tg,dem:integer;
   a,b,c:array[1..200] of  integer;
procedure   nhap;
    begin
        assign(fi,inp);
        reset(fi);
           read(fi,n );
           for i:=1 to n do
            begin
              read(fi,a[i]);
              c[i]:=a[i];
            end;
            j:=i;
           for i:=1 to n do
             begin
               read(fi,b[i]);
               c[i+j]:=b[i]   ;
             end;
        close(fi);
             assign(fo,outp);
     rewrite(fo);

    end;

function kiemtra(x:integer):boolean;
var
   kt1,kt2,kt3,kt4:boolean;

  begin
     kt1:=false;
     kt2:=false;
     kt3:=false;
     kt4:=false;
     for i:=1 to n do
       begin
         if c[x]=b[i] then kt1:=true else kt3:=true;
         if c[x+1]=a[i] then kt2:=true else kt4:=true;
       end;
    if (kt1 and kt2) or (kt3 and kt4) then
    kiemtra:=true;
  end;
procedure sapsep;
   begin
      for i:=1 to 2*n do
         for j:=1 to i do
           if c[i]> c[j] then
              begin
                 tg:=c[i];
                 c[i]:=c[j];
                 c[j]:=tg;
              end;
   end;
procedure xuli;
  begin
     sapsep;
      while k< 2*n-1 do
        if kiemtra(k) then 
            begin   
                inc(dem);
                inc(k,2);
             end else
                  inc(k);
     write(fo,dem);
     close(fo);
  end;
begin
   nhap;
   xuli;
end.

Đã chỉnh sửa
 
C

cuong276

Bài anh quang đúng rồi. Bài anh Thành sai rồi. Đề bài thì yêu cầu đọc và xuất từ tệp bwpoints mà, sao lại là tệp cuong vậy nè.
P/s: t-mod mới của box Tin là ai vậy? Trưởng nhóm nữa à?
 
Q

quanghero100

Mã:
const inp='cuong.inp';
      outp='cuong.out';
var i,k,j,n:integer;
   fi,fo:text;
   tg,dem:integer;
   a,b,c:array[1..200] of  integer;
procedure   nhap;
    begin
        assign(fi,inp);
        reset(fi);
           read(fi,n );
           for i:=1 to n do
            begin
              read(fi,a[i]);
              c[i]:=a[i];
            end;
            j:=i;
           for i:=1 to n do
             begin
               read(fi,b[i]);
               c[i+j]:=b[i]   ;
             end;
        close(fi);
             assign(fo,outp);
     rewrite(fo);

    end;

function kiemtra(x:integer):boolean;
var
   kt1,kt2,kt3,kt4:boolean;

  begin
     kt1:=false;
     kt2:=false;
     kt3:=false;
     kt4:=false;
     for i:=1 to n do
       begin
         if c[x]=b[i] then kt1:=true else kt3:=true;
         if c[x+1]=a[i] then kt2:=true else kt4:=true;
       end;
    if (kt1 and kt2) or (kt3 and kt4) then
    kiemtra:=true;
  end;
procedure sapsep;
   begin
      for i:=1 to 2*n do
         for j:=1 to i do
           if c[i]> c[j] then
              begin
                 tg:=c[i];
                 c[i]:=c[j];
                 c[j]:=tg;
              end;
   end;
procedure xuli;
  begin
     sapsep;
      while k< 2*n-1 do
        if kiemtra(k) then 
            begin   
                inc(dem);
                inc(k,2);
             end else
                  inc(k);
     write(fo,dem);
     close(fo);
  end;
begin
   nhap;
   xuli;
end.

Đã chỉnh sửa
bài anh Thành bị exit code 201 tức có lệnh truy cập ngoài khai báo array anh kiểm tra lại nha
 
1

11thanhkhoeo

Bài anh quang đúng rồi. Bài anh Thành sai rồi. Đề bài thì yêu cầu đọc và xuất từ tệp bwpoints mà, sao lại là tệp cuong vậy nè.
P/s: t-mod mới của box Tin là ai vậy? Trưởng nhóm nữa à?

Tmod starlove là 1 người đã từng làm mod, trưởng nhóm dưới 1 nick khác. Anh ấy là h/s lớp 11 tin.

Anh ấy chỉ hoạt động trong hè nên chú cứ yên tâm. nhé

có lẽ thêm k= 1 thì hay hon
 
S

starlove_maknae_kyuhyun

Hi cả nhà box tin lập trình :
mỗi ngày đóng góp một bài ( nếu như có điều kiện thời gian ) hì hì :

Bài 1:
bảng n*n các số $0,1$ mô tả 1 tấm phôi nguyên liệu của một qui trình chế tác , người ta phải cắ bỏ bớt phôi để chỉ giữ lại thành phẩm là một hình vuông $ k *k $,càng lớn càng tốt , số ô 0 trong thành phẩm không được quá m .
Yêu cầu : với 1 tâm phôi cho trước người ta có thể thu được thành phẩm lớn nhất là bao nhiêu? viết ra k !!
Dữ liệu vào :
file BAI1.INP có dòng đầu là n,m
dòng kế tiếp là bảng $ n*n$ $ (a<n<1000,o<m<10).$
Kết quả : file BÁI.OUt chỉ 1 số duy nhất k .

BAI1.INP
Mã:
 4 1 
1 1 1 1 
1 1 1 1 
1 1 0 1
0 1 1 1

BAI1.OUT
Mã:
 3


Starlove Chúc các bạn học tốt !
 
C

cuong276

Em có cái code này, thấy chạy thử text trên thì đúng, không biết có đúng thật không nên mọi người thử xem nha.
Mã:
var d,e,n,k,m,i,j:integer;
    f,g:text;
    a:array[1..100,1..100]of char;
    kt:array[1..100,1..100]of boolean;
procedure input;
begin
     assign(f,'bai1.inp');
     reset(f);
     readln(f,n,m);
     for i:=1 to n do
         begin
              for j:=1 to n do read(f,a[i,j]);
              readln(f);
         end;
     close(f);
end;
function ktmang(k:integer):integer;
begin
     for i:=1 to k do
         for j:=1 to k do
             if a[i,j]='0' then inc(d);
     ktmang:=d;
end;
procedure xuli;
begin
      d:=0;
      for k:=1 to n do
          if ktmang(k)=1 then break;
end;
procedure output;
begin
     assign(g,'bai1.out');
     rewrite(g);
     write(g,k);
     close(g);
end;
BEGIN
     input;
     xuli;
     output;
END.
 
M

mikelhpdatke

Thuật toán bài này cũng khá đơn giản, đầu tiên kiểm tra mảng n*n, nếu thỏa mãn exit, còn không gọi đệ quy n-1. Ý tưởng của e là thế :D
 
M

mikelhpdatke

Đang đau đầu với cái bài chia N số của bác đây, làm theo cách đó khó, mình đi tìm thuật toán khác :|. Mà mấy bác làm bài xử lý số nguyên lơn chưa nhể

Cho hai số nguyên dương A và B ( A & B có không quá 1000 chữ số )

Yêu cầu:

Tính A + B, A - B, A * B


Khi kết quả là 0 các bạn phải in ra 0, nếu in -0 là sai

Các chữ số 0 không có nghĩa ở đầu không được in ra. VD 013 thì phải in ra là 13, chữ số 0 ở đầu không có nghĩa

Input

Dòng 1: số nguyên A

Dòng 2: số nguyên B
Output

Dòng 1: Kết quả A + B

Dòng 2: Kết quả A - B

Dòng 3: Kết quả A * B
Example

Input:
10
11

Output:
21
-1
110
 
S

starlove_maknae_kyuhyun

về tính số nguyên lớn em có thể áp dụng mảng hoặc xâu !
cộng như lớp 4 ý :) hì hì cứ theo qui luật đó là ra !
code thì hôm nào rảnh anh sẽ code giúp bọn em !
 
Top Bottom