Tin học Tây Sơn

Con Kiến mà leo cành đa....

Go down

Con Kiến mà leo cành đa....

Bài gửi by Admin on Thu Nov 22, 2018 4:25 pm

Cho một đàn kiến gồm n con đang đi trên một sợi dây căng ngang có hai đầu là A và B chiều dài k cm. Trong đàn có số con kiến đi về phía điểm A, những con còn lại đi về phía điểm B, ban đầu không có hai con nào ở cùng vị trí.
Các con kiến đều di chuyển với tốc độ giống nhau: 1 cm/s, khi hai con kiến gặp nhau, chúng chạm râu vào nhau rồi cùng quay lại để di chuyển theo hướng ngược lại. Khi một con kiến chạm vào điểm A hay điểm B, nó sẽ bị rơi xuống đất và không còn trên dây nữa.
Yêu cầu: Biết vị trí và hướng di chuyển của từng con kiến tại thời điểm xuất phát là thời điểm 0, tính thời điểm chú kiến cuối cùng bị rơi xuống đất
Dữ liệu: Vào từ file văn bản ANTS.INP
l  Dòng 1 chứa hai số nguyên dương n < = 105 và k <= 1018;
l  Dòng 2 chứa n số nguyên x1, x2,.., xn trong đó |xi | là khoảng cách từ chú kiến thứ i tới điểm A, xi<0 có nghĩa là ban đầu chú kiến thứ i di chuyển về phía điểm A , xi>0 có nghĩa là ban đầu chú  kiến thứ I di chuyển về phía điểm B. (0<| xi |< k)
Các số trên một dòng của input file được ghi cách nhau ít nhất một dấu cách
Kết quả: Ghi ra file văn bản ANTS.OUT một số nguyên duy nhất là thời điểm chú kiến cuối cùng bị rơi xuống đất
Ví dụ

avatar
Admin
Admin
Admin

Posts : 658
Reputation : -39
Join date : 16/11/2015
Age : 29

Xem lý lịch thành viên http://tinhocts.forumvi.com

Về Đầu Trang Go down

Re: Con Kiến mà leo cành đa....

Bài gửi by Đinh Ngọc Mạnh on Thu Nov 22, 2018 4:27 pm

Quá khó, chắc 12 cái lên cơ chuột rầu!! ưertert ưertert
avatar
Đinh Ngọc Mạnh
Teen cá tính
Teen cá tính

Posts : 71
Reputation : -30
Join date : 18/06/2018
Age : 14
Location : Ở nhà

Xem lý lịch thành viên http://tinhocts.forumvi.com

Về Đầu Trang Go down

Re: Con Kiến mà leo cành đa....

Bài gửi by Admin on Fri Nov 23, 2018 8:35 pm

sdfg
avatar
Admin
Admin
Admin

Posts : 658
Reputation : -39
Join date : 16/11/2015
Age : 29

Xem lý lịch thành viên http://tinhocts.forumvi.com

Về Đầu Trang Go down

Re: Con Kiến mà leo cành đa....

Bài gửi by Đinh Ngọc Mạnh on Fri Nov 23, 2018 8:36 pm

Khó quá thầy ưertert
avatar
Đinh Ngọc Mạnh
Teen cá tính
Teen cá tính

Posts : 71
Reputation : -30
Join date : 18/06/2018
Age : 14
Location : Ở nhà

Xem lý lịch thành viên http://tinhocts.forumvi.com

Về Đầu Trang Go down

Re: Con Kiến mà leo cành đa....

Bài gửi by Admin on Fri Nov 23, 2018 9:23 pm

Đinh Ngọc Mạnh đã viết:Khó quá thầy ưertert
Suspect
avatar
Admin
Admin
Admin

Posts : 658
Reputation : -39
Join date : 16/11/2015
Age : 29

Xem lý lịch thành viên http://tinhocts.forumvi.com

Về Đầu Trang Go down

Re: Con Kiến mà leo cành đa....

Bài gửi by nguyen77 on Sat Nov 24, 2018 5:00 pm

CODE:

Program bt;
Uses crt;
Var i,n,k,dem,j,tg:integer;
kt:boolean;
fi,fo:text;
A:Array[1..1000] of integer;
Begin
Clrscr;
Assign(fi,'ANtS.INP');
Reset(fi);
Readln(fi,n,k);
For i:=1 to n do
Read(fi,a[i]);
Close(fi);
Assign(fo,'ANTS.OUT');
Rewrite(fo);
kt:=false;
While not kt do
Begin
For i:=1 to n do
If (a[i]<>0) and (a[i]<>k) then
Inc(a[i]);
Inc(dem);
For i:=1 to n do
For j:=1 to n do
If abs(a[i])=abs(a[j]) then
Begin
a[i]:=a[i]*-1;
a[j]:=a[j]*-1;
End;
For i:=1 to n do
If (a[i]=0) or (a[i]=k) then
kt:=true
Else
Begin
kt:=false;
Break;
End;

End;

Write(fo,dem);
Close(fo);
Readln;
End.
avatar
nguyen77
Năng động
Năng động

Posts : 68
Reputation : -22
Join date : 18/06/2018

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Con Kiến mà leo cành đa....

Bài gửi by nganvonhat123 on Sun Nov 25, 2018 9:13 am

Code:
program conkien;

uses crt;
 type mang=array[1..100]of integer;
 var i,j,d,n,k,dd:integer;
    fi,fo:text;
    a,b:mang;

        procedure nhap;
        begin
                assign(fi,'ants.inp');
                reset(fi);
                readln(fi,n,k);
                for i:=1 to n do read(fi,a[i]);
                close(fi);
        end;

        function kt(a:mang;n:integer):boolean;
        begin
                kt:=false;
                for i:=1 to n do if (a[i]<>0) and (a[i]<>k)  then exit;
                kt:=true;
        end;


        procedure tinh;
        begin
                assign(fo,'ants.out');
                rewrite(fo);
                dd:=0;
                while not kt(a,n)  do
                begin
                inc(dd);
                begin
                for i:=1 to n do


                                if (a[i]<>0) or (a[i]<>k) then inc(a[i]);


                for i:=1to n-1 do
                        for j:=i+1 to n do
                                        if abs(a[i])=abs(a[j]) then
                                                begin
                                                        a[i]:=a[i]*-1;
                                                        a[j]:=a[j]*-1;
                                                end;

                for i:=1to n do if (a[i]=k) then a[i]:=0;

                end;
                end;
                write(fo,dd);
                close(fo);

    end;



BEGIN
 clrscr;
 nhap;
 tinh;
 readln;
END.

avatar
nganvonhat123
Begin
Begin

Posts : 9
Reputation : -2
Join date : 24/11/2018
Age : 14

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Con Kiến mà leo cành đa....

Bài gửi by thanhtruc on Sun Nov 25, 2018 7:04 pm

Code:
program ANTS;
uses crt;
type mang=array[1..1000] of integer;
var i,j,d,n,k:integer;
        fi,fo:text;
        a:mang;kt:boolean;

procedure doc;
begin
assign(fi,'ants.inp');
reset(fi);
readln(fi,n,k);
for i:=1 to n do
read(fi,a[i]);
close(fi);
end;

BEGIN
clrscr;
doc;
assign(fo,'ants.out');
rewrite(fo);
kt:=false;
while not kt  do
        begin
        for i:=1 to n do
        if (a[i]<>0) or (a[i]<>k) then
        inc(a[i]);
        inc(d);
        for i:=1 to n do
        for j:=1 to n do
        if abs(a[i])=abs(a[j]) then
                begin
                a[i]:=a[i]* -1;
                a[j]:=a[j]* -1;
                end;
        for i:=1to n do
        if (a[i]=0) or (a[i]=k) then
        kt:=true
        else
                begin
                kt:=false;
                break;
                end;
        end;
write(fo,d);
close(fo);
readln;
end.


avatar
thanhtruc
Nhiệt tình
Nhiệt tình

Posts : 43
Reputation : -7
Join date : 25/06/2018
Age : 14
Location : TNPPTSBĐ

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Con Kiến mà leo cành đa....

Bài gửi by huynhtanluc on Mon Nov 26, 2018 1:56 pm

Code:
Program cnkien;
uses crt;
type mang=array[1..1000] of integer;
var i,n,k,d,j:integer;
    t1,t2:text;a:mang;

Procedure doc;
begin
assign(t1,'ants.inp');
reset(t1);
readln(t1,n,k);
for i:=1 to n do
        read(t1,a[i]);
close(t1);
end;

Function kt(a:mang;n:integer):boolean;
begin
kt:=false;
for i:=1 to n do
if (a[i]<>0) and (a[i]<>k) then exit;
kt:=true;
end;

Procedure inra;
begin
assign(t2,'ants.out');
rewrite(t2);
d:=0;
while not kt(a,n) do
begin
inc(d);
for i:=1 to n do inc(a[i]);
for i:=1 to n-1 do
for j:=i+1 to n do
if abs(a[i])=abs(a[j]) then
begin
a[i]:=a[i]*-1;
a[j]:=a[j]*-1;
end;
for i:=1 to n do
if (a[i]=0) and (a[i]=k) then a[i]:=0;
end;
write(t2,d);
close(t2);
end;

Begin
clrscr;
doc;
inra;
readln;
End.
avatar
huynhtanluc
Năng động
Năng động

Posts : 61
Reputation : -14
Join date : 18/06/2018

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Con Kiến mà leo cành đa....

Bài gửi by tonguyengiahan237 on Mon Nov 26, 2018 6:02 pm

Code:
Program KIEN;
Uses crt;
Type Mang_K=array[1..20] of integer;
Var  x:Mang_K;
    n,k,T:integer;
    fi,fo:text;

Procedure Docdl(Var x:Mang_K;Var n,k:integer;Var fi:text);
Var i:integer;
Begin
Assign(fi,'ANTS.INP');
Reset(fi);
Readln(fi,n,k);
        For i:=1 to n do
        begin
        Read(fi,x[i]);
        end;
Close(fi);
End;

Function KT(x:Mang_K;n,k:integer):boolean;
Var i:integer;
Begin
KT:=False;
For i:=1 to n do
        If (x[i]<>0) and (x[i]<>k)then exit;
KT:=True;
End;

Procedure Tinh_TG(Var x:Mang_K;Var n,k,T:integer);
Var i,j:integer;
Begin
T:=0;
While not KT(x,n,k) do
  Begin
  For i:=1 to n do
        x[i]:=x[i]+1;
  T:=T+1;
  For i:=1 to n-1 do
  For j:=i+1 to n do
        If abs(x[i])=abs(x[j]) then
        Begin
        x[i]:=x[i]*(-1);
        x[j]:=x[j]*(-1);
        End;
  End;
End;

BEGIN
Clrscr;
Docdl(x,n,k,fi);
Tinh_TG(x,n,k,T);
Assign(fo,'ANTS.OUT');
Rewrite(fo);
Write(fo,T);
Close(fo);
Readln;
END.
avatar
tonguyengiahan237
Teen Chính hiệu
Teen Chính hiệu

Posts : 28
Reputation : -2
Join date : 06/11/2018
Age : 14
Location : TT Phú Phong Huyện Tây Sơn Tỉnh Bình Định

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Con Kiến mà leo cành đa....

Bài gửi by lohan on Mon Nov 26, 2018 6:05 pm

Code:
program Kien_leo_day;
uses crt;
Type M=array[1..100]of integer;
var    a:M;
   n,k:integer;
   fi,fo:text;
procedure Doc;
var i:integer;
begin
assign(fi,'ANTS.INP');
reset(fi);
readln(fi,n,k);
   for i:=1 to n do
   begin
   read(fi,a[i]);
   end;
close(fi);
end;
function kt(a:M;n:integer):boolean;
var i:integer;
begin
kt:=false;
for i:=1 to n do
if (a[i]<>0) and (a[i]<>k) then exit;
kt:=true;
end;
procedure Tim;
var i,j,tg:integer;
begin
Assign(fo,'ANTS.OUT');
Rewrite(fo);
tg:=0;
while not kt(a,n) do
begin
for i:=1 to n do
a[i]:=a[i]+1;
tg:=tg+1;
for i:=1 to n do
for j:=1 to n do
       if abs(a[i])=abs(a[j]) then
       begin
       a[i]:=-a[i];
       a[j]:=-a[j];
       end;
end;
write(fo,tg);
close(fo);
end;

BEGIN
Clrscr;
Doc;
Tim;
Readln;
END.
avatar
lohan
Teen Chính hiệu
Teen Chính hiệu

Posts : 20
Reputation : -3
Join date : 06/11/2018
Age : 14

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Con Kiến mà leo cành đa....

Bài gửi by mainhatthong2004 on Tue Nov 27, 2018 5:02 am

thong:
Program cnkien;
uses crt;
type mang=array[1..1000] of integer;
var i,n,k,d,j:integer;
   fi,fo:text;a:mang;

Procedure doc;
begin
assign(fi,'ants.inp');
reset(fi);
readln(fi,n,k);
for i:=1 to n do
       read(fi,a[i]);
close(fi);
end;

Function kt(a:mang;n:integer):boolean;
begin
kt:=false;
for i:=1 to n do
if (a[i]<>0) and (a[i]<>k) then exit;
kt:=true;
end;

Procedure ghi;
begin
assign(fo,'ants.out');
rewrite(fo);
d:=0;
while not kt(a,n) do
begin
inc(d);
for i:=1 to n do inc(a[i]);
for i:=1 to n-1 do
for j:=i+1 to n do
if abs(a[i])=abs(a[j]) then
begin
a[i]:=a[i]*-1;
a[j]:=a[j]*-1;
end;
for i:=1 to n do
if (a[i]=0) and (a[i]=k) then a[i]:=0;
end;
write(fo,d);
close(fo);
end;

Begin
clrscr;
doc;
ghi;
readln;
End.
avatar
mainhatthong2004
Teen cá tính
Teen cá tính

Posts : 76
Reputation : -25
Join date : 18/06/2018

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Con Kiến mà leo cành đa....

Bài gửi by truongquocbao2004 on Tue Nov 27, 2018 11:00 am

Code:
program kien;
uses crt;
type mang=array[1..100]of integer;
var i,j,d,n,k:integer;
    fi,fo:text;
    a:mang;

procedure doc;
begin
assign(fi,'ants.inp');
reset(fi);
readln(fi,n,k);
for i:=1 to n do read(fi,a[i]);
close(fi);
end;

function kt(a:mang;n:integer):boolean;
begin
kt:=false;
for i:=1 to n do if (a[i]<>0)and(a[i]<>k) then exit;
kt:=true;
end;

procedure xuly;
begin
assign(fo,'ants.out');
rewrite(fo);
d:=0;
while not kt(a,n) do
        begin
        inc(d);
                begin
                for i:=1 to n do
                        if (a[i]<>0) or (a[i]<>k) then inc(a[i]);
                for i:=1to n-1 do
                        for j:=i+1 to n do
                                if abs(a[i])=abs(a[j]) then
                                        begin
                                        a[i]:=a[i]*(-1);
                                        a[j]:=a[j]*(-1);
                                        end;
                for i:=1to n do if a[i]=k then a[i]:=0;
                end;
        end;
write(fo,d);
close(fo);
end;

begin
clrscr;
doc;
xuly;
readln;
end.
avatar
truongquocbao2004
Nhiệt tình
Nhiệt tình

Posts : 40
Reputation : -10
Join date : 18/06/2018

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Con Kiến mà leo cành đa....

Bài gửi by quantran on Tue Nov 27, 2018 1:30 pm

Spoiler:
program bai;
type mang=array[1..1000] of integer;
var
s,n,k,i,so:integer;
kien,j,tam:integer;
fi,fo:text;
a:mang;
//--------------------------------
procedure doc;
begin
assign(fi,'ants.inp');
reset(fi);
readln(fi,n,k);
for i:=1 to n do
read(fi,a[i]);
close(fi);
end;
//-------------------------------------
function kt( a:mang; n,k:integer):boolean;
begin
kt:=false;
for i:=1 to n do
if (a[i]<>0) and (a[i]<>k) then
exit;
kt:=true;
end;
//--------------------------------------
procedure xuli;
begin
doc;
assign(fo,'ANTS.OUt');
rewrite(fo);
so:=0;
while not kt(a,n,k) do
begin
inc(so);
begin
for i:=1 to n do
if (a[i]<>0) or (a[i]<>k) then
a[i]:=a[i]+1;

for i:=1 to n-1 do
for j:=i+1 to n do
if (abs(a[i]) = abs(a[j])) then
begin
a[i]:=a[i]*(-1);
a[j]:=a[j]*(-1);
end;
for i:=1 to n do
if (a[i]=0) or (a[i]=k) then
a[i]:=0;
end; end;
write(fo,so);
close(fo);
end;
//-------------------------------
begin
xuli;
readln;
end.
avatar
quantran
Teen cá tính
Teen cá tính

Posts : 73
Reputation : -20
Join date : 18/06/2018
Age : 14
Location : Binh Thuan-Tay Son-Binh Dinh

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Con Kiến mà leo cành đa....

Bài gửi by Tạ Thúy Phượng on Tue Nov 27, 2018 1:40 pm

CODE:
Program bt;
Uses crt;
Var i,n,k,dem,j,tg:integer;
kt:boolean;
fi,fo:text;
A:Array[1..1000] of integer;

Begin
Clrscr;
Assign(fi,'ANtS.INP');
Reset(fi);
Readln(fi,n,k);
For i:=1 to n do
Read(fi,a[i]);
Close(fi);
Assign(fo,'ANTS.OUT');
Rewrite(fo);
kt:=false;
While not kt do
Begin
For i:=1 to n do
If (a[i]<>0) and (a[i]<>k) then
Inc(a[i]);
Inc(dem);
For i:=1 to n do
For j:=1 to n do
If abs(a[i])=abs(a[j]) then
Begin
a[i]:=a[i]*-1;
a[j]:=a[j]*-1;
End;
For i:=1 to n do
If (a[i]=0) or (a[i]=k) then
kt:=true
Else
Begin
kt:=false;
Break;
End;

End;

Write(fo,dem);
Close(fo);
Readln;
End.
avatar
Tạ Thúy Phượng
Năng động
Năng động

Posts : 63
Reputation : -19
Join date : 18/06/2018
Location : Binh Thuan-Tay Son-Binh Dinh

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Con Kiến mà leo cành đa....

Bài gửi by Nguyễn Văn Biên on Tue Nov 27, 2018 1:45 pm

CODE:
program ANTS;
var fi,fo:text;
n,k,i,so,j:integer;
A:array[1..1000] of integer;

function kt:boolean;
begin
kt:=false;
for i:=1 to n do
if (A[i]<>0) and (A[i]<>k) then exit;
kt:=true
end;

begin
assign(fi,'ANTS.INP'); reset(fi);
readln(fi,n,k);
for i:=1 to n do read(fi,a[i]);
close(fi);
so:=0;
while not kt do
begin
inc(so);
for i:=1 to n do
if (A[i]<>0) or (A[i]<>k) then inc(A[i]);
for i:=1 to n-1 do
for j:=i+1 to n do
if abs(A[i])=abs(A[j]) then
begin A[i]:=A[i]*(-1); A[j]:=A[j]*(-1) end;
for i:=1 to n do
if (a[i]=0) or (a[i]=k) then a[i]:=0;
end;
assign(fo,'ANTS.OUT'); rewrite(fo);
write(fo,so); close(fo)
end.
avatar
Nguyễn Văn Biên
S-mod
S-mod

Posts : 186
Reputation : 21
Join date : 18/06/2018
Age : 14
Location : ?

Xem lý lịch thành viên https://bien2004official.blogspot.com

Về Đầu Trang Go down

Re: Con Kiến mà leo cành đa....

Bài gửi by Nguyễn Hoàng Nam on Tue Nov 27, 2018 2:03 pm

Code:
Program btck;
Uses crt;
Type Mang_K=array[1..20] of integer;
Var  x:Mang_K;
    n,k,T:integer;
    fi,fo:text;

Procedure Docdl(Var x:Mang_K;Var n,k:integer;Var fi:text);
Var i:integer;
Begin
Assign(fi,'ANTS.INP');
Reset(fi);
Readln(fi,n,k);
        For i:=1 to n do
        begin
        Read(fi,x[i]);
        end;
Close(fi);
End;

Function KT(x:Mang_K;n,k:integer):boolean;
Var i:integer;
Begin
KT:=False;
For i:=1 to n do
        If (x[i]<>0) and (x[i]<>k)then exit;
KT:=True;
End;

Procedure Tinh_TG(Var x:Mang_K;Var n,k,T:integer);
Var i,j:integer;
Begin
T:=0;
While not KT(x,n,k) do
  Begin
  For i:=1 to n do
        x[i]:=x[i]+1;
  T:=T+1;
  For i:=1 to n-1 do
  For j:=i+1 to n do
        If abs(x[i])=abs(x[j]) then
        Begin
        x[i]:=x[i]*(-1);
        x[j]:=x[j]*(-1);
        End;
  End;
End;

BEGIN
Clrscr;
Docdl(x,n,k,fi);
Tinh_TG(x,n,k,T);
Assign(fo,'ANTS.OUT');
Rewrite(fo);
Write(fo,T);
Close(fo);
Readln;
END.
avatar
Nguyễn Hoàng Nam
Teen Chính hiệu
Teen Chính hiệu

Posts : 16
Reputation : -2
Join date : 06/11/2018
Age : 14

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Con Kiến mà leo cành đa....

Bài gửi by Nguyễn Ngọc Thiên on Tue Nov 27, 2018 2:04 pm

Code:
program conk;
uses crt;
var  a:array[1..100]of integer;
    i,j,d,n,k,dem:integer;
    fi,fo:text;
//-----------------------------------
procedure nhap;
    begin
      assign(fi,'ants.inp');
      reset(fi);
      readln(fi,n,k);
      for i:=1 to n do read(fi,a[i]);
      close(fi);
    end;
//---------------------------------------
function kt(n:integer):boolean;
    begin
      kt:=false;
      for i:=1 to n do if (a[i]<>0) and (a[i]<>k)  then exit;
      kt:=true;
    end;
//------------------------------------------
procedure tinh;
    begin
      assign(fo,'ants.out');
      rewrite(fo);
      dem:=0;
      while not kt(n)  do
          begin
          inc(dem);
          begin
            for i:=1 to n do
            if (a[i]<>0) or (a[i]<>k) then inc(a[i]);
          for i:=1to n-1 do
          for j:=i+1 to n do
            if abs(a[i])=abs(a[j]) then
                        begin
                        a[i]:=a[i]*-1;
                        a[j]:=a[j]*-1;
                        end;
            for i:=1to n do if (a[i]=k) then a[i]:=0;
          end;
          end;
write(fo,dem);
close(fo);
end;
//---------------------------------------------
BEGIN
 clrscr;
 nhap;
 tinh;
 readln;
END.
avatar
Nguyễn Ngọc Thiên
Teen Chính hiệu
Teen Chính hiệu

Posts : 17
Reputation : -4
Join date : 06/11/2018
Age : 13
Location : Bình tường, Tây Sơn, Bình Định

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Con Kiến mà leo cành đa....

Bài gửi by Sponsored content


Sponsored content


Về Đầu Trang Go down

Về Đầu Trang


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