Tin học Tây Sơn

Công nghệ Tưới tiêu

Go down

Công nghệ Tưới tiêu

Bài gửi by Admin on Thu Jan 03, 2019 8:54 pm

Bài 2: Tưới ruộng – FARM.* (7 điểm)
Trên khu đất ruộng hình chữ nhật, được chia thành từng thửa vuông đều nhau có cạnh
là một đơn vị để cho các tá điền thuê lại trồng trọt. Tại một số thửa ruộng, bạn Bờm cho đào
giếng để lấy nước tưới. Vì năm nay trời hạn nên mỗi giếng chỉ đủ nước để tưới cho các thửa
ruộng xung quanh trong phạm vi bán kính 2 ô vuông đơn vị. Các tá điền không thể đưa nước
đi xa vì họ không có dụng cụ cũng không đủ sức đưa đi.
Yêu cầu: Hãy đếm xem có bao nhiêu thửa ruộng sẽ không tưới được.
Ví dụ: Với diện tích ruộng 6*9 như hình bên có 3 giếng nước
tại các ô ở dòng 2 cột 6, dòng 3 cột 2 và dòng 5 cột 7. Các ô tô đen
chính là những ô không thể tưới.
Dữ liệu vào: Trong tập tin văn bản FARM.INP gồm:
- Dòng đầu là hai số nguyên dương M và N cách nhau một
dấu cách cho biết kích thước khu đất (1< M, N ≤ 100);
- Dòng thứ hai là một số nguyên dương K cho biết số giếng đã đào trên khu đất.
Trên K dòng tiếp theo, mỗi dòng ghi hai số nguyên dương tương ứng với chỉ số dòng 
và cột của từng giếng đào trên khu đất, các số cách nhau một dấu cách. Chỉ số dòng được 
đánh số từ 1, tính từ trên xuống dưới của bảng. Chỉ số cột được đánh số từ 1, tính từ trái sang 
phải của bảng (0 ≤ K ≤ 104
).
Kết quả: Ghi vào tập tin văn bản FARM.OUT gồm một số nguyên duy nhất là số
thửa ruộng không thể tưới.
Ví dụ:
FARM.INP FARM.OUT
6 9
3
2 6
3 2
5 7
avatar
Admin
Admin
Admin

Posts : 687
Reputation : -10042
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: Công nghệ Tưới tiêu

Bài gửi by tonguyengiahan237 on Thu Jan 03, 2019 8:58 pm

Code:
Program Tuoi_ruong;
Uses crt;
Type Mang2c=array[1..50,1..50] of integer;
Var M,N,K:integer;
    F,T:Mang2c;
    fi,fo:text;
Procedure Ruong;
Var i,j:integer;
Begin
For i:=1 to M do
For j:=1 to N do
        begin
        F[i,j]:=0;
        end;
End;

Procedure Docdl;
Var a,b,i,j:integer;
Begin
Assign(fi,'FARM.INP');
Reset(fi);
Readln(fi,M,N);
Readln(fi,K);
For a:=1 to k do
For b:=1 to 2 do
        begin
        Read(fi,T[a,b]);
        If b=2 then Readln(fi);
        end;
Close(fi);
End;

Procedure Dao;
Var a,i,j:integer;
Begin
a:=1;
For i:=1 to M do
For j:=1 to N do
        If (i=T[a,1]) and (j=T[a,2]) then
                begin
                F[i,j]:=1;
                inc(a);
                end;
End;




Procedure Tim;
Var i,j,a,b,c,d,g,h:integer;
Begin
For i:=1 to M do
For j:=1 to N do
        If F[i,j]=1 then
                begin
                a:=j;
                b:=j;
                a:=a+1;
                F[i,a]:=2;
                If b+2<>N+1 then
                        begin
                        b:=b+2;
                        F[i,b]:=2;
                        end;
                c:=i;
                d:=i;
                c:=c-1;
                F[c,a]:=2;
                F[c,b]:=2;
                If d-2<>0 then
                        begin
                        d:=d-2;
                        F[d,a]:=2;
                        F[d,b]:=2;
                        end;
                c:=i;
                d:=i;
                c:=c+1;
                F[c,a]:=2;
                F[c,b]:=2;
                If d+2<>M+1 then
                        begin
                        d:=d+2;
                        F[d,a]:=2;
                        F[d,b]:=2;
                        end;
                a:=j;
                b:=j;
                a:=a-1;
                F[i,a]:=2;
                If b-2<>0 then
                        begin
                        b:=b-2;
                        F[i,b]:=2;
                        end;
                c:=i;
                d:=i;
                c:=c-1;
                F[c,a]:=2;
                F[c,b]:=2;
                If d-2<>0 then
                        begin
                        d:=d-2;
                        F[d,a]:=2;
                        F[d,b]:=2;
                        end;
                c:=i;
                d:=i;
                c:=c+1;
                F[c,a]:=2;
                F[c,b]:=2;
                If d+2<>M+1 then
                        begin
                        d:=d+2;
                        F[d,a]:=2;
                        F[d,b]:=2;
                        end;
                g:=i;
                h:=i;
                g:=g+1;
                F[g,j]:=2;
                If h+2<>M+1 then
                        begin
                        h:=h+2;
                        F[h,j]:=2;
                        end;
                g:=i;
                h:=i;
                g:=g-1;
                F[g,j]:=2;
                If h-2<>0 then
                        begin
                        h:=h-2;
                        F[h,j]:=2;
                        end;

                end;
End;

Procedure Demruong;
Var i,j,Dem:integer;
Begin
Assign(fo,'FARM.OUT');
Rewrite(fo);
Dem:=0;
For i:=1 to M do
For j:=1 to N do
If F[i,j]=0 then Inc(Dem);
Writeln(fo,Dem);
Close(fo);
End;

BEGIN
CLRSCR;
Ruong;
Docdl;
Dao;
Tim;
Demruong;
READLN;
END.
avatar
tonguyengiahan237
Nhiệt tình
Nhiệt tình

Posts : 42
Reputation : -1
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: Công nghệ Tưới tiêu

Bài gửi by nguyen77 on Thu Jan 03, 2019 9:51 pm

Code:
program BT;
uses crt;
var a:array[1..100,1..100] of integer;
n,m,i,j,k,x,y,d,l,r:longint;
fi,fo:text;

begin
clrscr;
assign(fi,'farm.inp');
reset(fi);
readln(fi,m,n);
m:=m+4;
n:=n+4;
readln(fi,k);
for i:=1 to k do
begin
readln(fi,x,y);
a[x+2,y+2]:=1;
end;
close(fi);
assign(fo,'farm.out');
rewrite(fo);
d:=0;
for i:=3 to m-2 do
for j:=3 to n-2 do
if a[i,j]=1 then
for x:=i-2 to i+2 do
for y:=j-2 to j+2 do
if a[x,y]<>1 then
a[x,y]:=2;
for i:=3 to m-2 do
for j:=3 to n-2 do
if a[i,j]=0 then
inc(d);
write(fo,d);
close(fo);
readln;
end.
avatar
nguyen77
Năng động
Năng động

Posts : 75
Reputation : -309991
Join date : 18/06/2018

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

Về Đầu Trang Go down

Re: Công nghệ Tưới tiêu

Bài gửi by nganvonhat123 on Fri Jan 04, 2019 1:23 pm

Code:
program bai2;

uses crt;
        var  fo,fi:text;
                n,m,x,y,k,i,j,d:integer;
            a:array[1..100,1..100]of integer;


        procedure nhap;
        begin
                assign(fi,'tn.inp');
                reset(fi);
                readln(fi,n,m);
                m:=m+4;
                n:=n+4;
                readln(fi,k);
                for i:=1 to k do
                        begin
                                readln(fi,x,y);
                                a[x+2,y+2]:=1;
                                end;
                close(fi);
        end;

        procedure tim;
        begin
                assign(fo,'tn.out');
                rewrite(fo);
                for i:=3 to n-2 do

                        for j:=3 to m-2 do
                                if a[i,j]=1 then
                                for x:=i-2 to i+2 do
                                        for y:=j-2 to j+2 do
                                        if a[x,y]<>1 then a[x,y]:=2;
                d:=0;
                for i:=3 to n-2 do
                      for j:=3 to m-2 do
                                if a[i,j]=0 then inc(d);
                write(fo,d);
                close(fo);

        end;


BEGIN
clrscr;
nhap;
tim;
readln;
END.

avatar
nganvonhat123
Teen Chính hiệu
Teen Chính hiệu

Posts : 12
Reputation : -109991
Join date : 24/11/2018
Age : 14

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

Về Đầu Trang Go down

Re: Công nghệ Tưới tiêu

Bài gửi by Nguyễn Văn Biên on Fri Jan 04, 2019 3:24 pm

Spoiler:
Code:
program FARM;
var A:array[1..100,1..100] of byte;
    n,m,i,j,k,x,y,d:longint;
    f:text;
begin
        assign(f,'FARM.INP'); reset(f);
        readln(f,m,n); inc(m,4); inc(n,4);
        readln(f,k);
        for i:=1 to k do begin readln(f,x,y); A[x+2,y+2]:=1 end; close(f);
        for i:=3 to m-2 do
        for j:=3 to n-2 do
        if A[i,j]=1 then
        for x:=i-2 to i+2 do
        for y:=j-2 to j+2 do
        if A[x,y]<>1 then A[x,y]:=2; d:=0;
        for i:=3 to m-2 do
        for j:=3 to n-2 do
        if A[i,j]=0 then inc(d);
        assign(f,'FARM.OUT'); rewrite(f);
        write(f,d); close(f)
end.

_________________

My:
- XDA Account
- Blog
- Game

...
avatar
Nguyễn Văn Biên
Recognised Member & Recognised Developer & Protected Member & Super Administrator
Recognised Member & Recognised Developer & Protected Member & Super Administrator

Posts : 220
Reputation : 1129923
Join date : 18/06/2018
Age : 15
Location : ?

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

Về Đầu Trang Go down

Re: Công nghệ Tưới tiêu

Bài gửi by Tạ Thúy Phượng on Sat Jan 05, 2019 2:03 pm

CODE:
var
a:array[1..100,1..100] of integer;
n,m,i,j,k,x,y,dem,l,r:longint;
fi,fo:text;
//----------------------------------------
procedure nhap;
begin
assign(fi,'FARM.INP');
reset(fi);
readln(fi,m,n);
m:=m+4;
n:=n+4;
readln(fi,k);
for i:=1 to k do
begin
readln(fi,x,y);
a[x+2,y+2]:=1;
end;
close(fi);
end;
//------------------------------------------
procedure xu_li;
begin
assign(fo,'FARM.OUT');
rewrite(fo);
dem:=0;
for i:=3 to m-2 do
for j:=3 to n-2 do
if a[i,j]=1 then
for x:=i-2 to i+2 do
for y:=j-2 to j+2 do
if a[x,y]<>1 then a[x,y]:=2;
for i:=3 to m-2 do
for j:=3 to n-2 do
if a[i,j]=0 then inc(dem);
write(fo,dem);
close(fo);
end;
//----------------------------------------
begin
nhap;
xu_li;
readln;
end.
avatar
Tạ Thúy Phượng
Năng động
Năng động

Posts : 66
Reputation : -259993
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: Công nghệ Tưới tiêu

Bài gửi by huynhtanluc on Sat Jan 05, 2019 2:03 pm

Code:
Program TR;
uses crt;
var a:array[1..100,1..100] of integer;
n,m,i,j,k,x,y,d,l:longint;t1,t2:text;

Procedure nhap;
begin
assign(t1,'FARM.INP');
reset(t1);
readln(t1,m,n);
m:=m+4;
n:=n+4;
readln(t1,k);
for i:=1 to k do
begin
readln(t1,x,y);
a[x+2,y+2]:=1;
end;
close(t1);
end;

Procedure xuli;
begin
assign(t2,'FARM.OUT');
rewrite(t2);
d:=0;
for i:=3 to m-2 do
for j:=3 to n-2 do
if a[i,j]=1 then
for x:=i-2 to i+2 do
for y:=j-2 to j+2 do
if a[x,y]<>1 then
a[x,y]:=2;
for i:=3 to m-2 do
for j:=3 to n-2 do
if a[i,j]=0 then
inc(d);
write(t2,d);
close(t2);
end;

Begin
clrscr;
nhap;
xuli;
readln;
End.
avatar
huynhtanluc
Năng động
Năng động

Posts : 63
Reputation : -299984
Join date : 18/06/2018

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

Về Đầu Trang Go down

Re: Công nghệ Tưới tiêu

Bài gửi by quantran on Sat Jan 05, 2019 2:04 pm

Code:
program bai2;
var
a:array[0..50,0..50] of integer;
n,m,i,j,k,c,h,x,y,d:integer;
fi,fo:text;
//-----------------------------
procedure nhap;
begin
assign(fi,'farm.inp');
reset(fi);
readln(fi,m,n);
m:=m+4;
n:=n+4;
readln(fi,k);
for i:=1 to k do
begin
readln(fi,h,c);
a[h+2,c+2]:=1;
end;
close(fi);
end;
//-----------------------------
procedure xuli;
begin
assign(fo,'FARM.out');
rewrite(fo);
for i:=3 to m-2 do
for j:=3 to n-2 do
if a[i,j]=1 then
for x:=i-2 to i+2 do
for y:=j-2 to j+2 do
if a[x,y]<>1 then
a[x,y]:=2;
d:=0;
for i:=3 to m-2 do
for j:=3 to n-2 do
if a[i,j]=0 then
inc(d);
write(fo,d);
close(fo);
end;
//----------------------------
begin
nhap;
xuli;
readln;
end.
avatar
quantran
Năng động
Năng động

Posts : 77
Reputation : -339986
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: Công nghệ Tưới tiêu

Bài gửi by Nguyễn Ngọc Thiên on Sat Jan 05, 2019 3:34 pm

Code:
program dd;
uses crt;
var a:array[1..100,1..100] of integer;
n,m,i,j,k,x,y,dem:longint;
fi,fo:text;
//-----\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\
procedure nhap;
begin
assign(fi,'farm.inp');reset(fi);
readln(fi,m,n);
m:=m+4;
n:=n+4;
readln(fi,k);
for i:=1 to k do
                begin
                readln(fi,x,y);
                a[x+2,y+2]:=1;
                end;
close(fi);
end;
//-----\/\/\/\\/\//\/\/\/\/\/\/\/\/\/\
procedure xuli;
begin
assign(fo,'farm.out');rewrite(fo);
dem:=0;
for i:=3 to m-2 do
 for j:=3 to n-2 do
        if a[i,j]=1 then
                for x:=i-2 to i+2 do
                for y:=j-2 to j+2 do
                        if a[x,y]<>1 then
                              a[x,y]:=2;
for i:=3 to m-2 do
 for j:=3 to n-2 do
        if a[i,j]=0 then
                inc(dem);
write(fo,dem);
close(fo);
end;
//-----\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\
begin
clrscr;
nhap;
xuli;
readln;
end.
avatar
Nguyễn Ngọc Thiên
Teen Chính hiệu
Teen Chính hiệu

Posts : 19
Reputation : -179986
Join date : 06/11/2018
Age : 14
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: Công nghệ Tưới tiêu

Bài gửi by mainhatthong2004 on Sat Jan 05, 2019 3:35 pm

Code:
[spoiler="thong"]program BT;
uses crt;
var a:array[1..100,1..100] of integer;
n,m,i,j,k,x,y,d,l,r:longint;
fi,fo:text;

begin
clrscr;
assign(fi,'farm.inp');
reset(fi);
readln(fi,m,n);
m:=m+4;
n:=n+4;
readln(fi,k);
for i:=1 to k do
begin
readln(fi,x,y);
a[x+2,y+2]:=1;
end;
close(fi);
assign(fo,'farm.out');
rewrite(fo);
d:=0;
for i:=3 to m-2 do
for j:=3 to n-2 do
if a[i,j]=1 then
for x:=i-2 to i+2 do
for y:=j-2 to j+2 do
if a[x,y]<>1 then
a[x,y]:=2;
for i:=3 to m-2 do
for j:=3 to n-2 do
if a[i,j]=0 then
inc(d);
write(fo,d);
close(fo);
readln;
end.[/spoiler]
avatar
mainhatthong2004
Teen cá tính
Teen cá tính

Posts : 85
Reputation : -369988
Join date : 18/06/2018

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

Về Đầu Trang Go down

Re: Công nghệ Tưới tiêu

Bài gửi by thanhtruc on Sat Jan 05, 2019 3:36 pm

Code:
program bai16;
uses crt;
var a:array[1..100,1..100] of integer;
n,m,i,j,k,x,y,d,l,r:longint;
fi,fo:text;

procedure nhap;
begin
assign(fi,'farm.inp');
reset(fi);
readln(fi,m,n);
m:=m+4;
n:=n+4;
readln(fi,k);
for i:=1 to k do
begin
readln(fi,x,y);
a[x+2,y+2]:=1;
end;
close(fi);
end;

procedure xl;
begin
assign(fo,'farm.out');
rewrite(fo);
d:=0;
for i:=3 to m-2 do
for j:=3 to n-2 do
if a[i,j]=1 then

for x:=i-2 to i+2 do
for y:=j-2 to j+2 do
if a[x,y]<>1 then
a[x,y]:=2;

for i:=3 to m-2 do
for j:=3 to n-2 do
if a[i,j]=0 then
inc(d);

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

begin
clrscr;
nhap;
xl;
readln;
end.
avatar
thanhtruc
Nhiệt tình
Nhiệt tình

Posts : 45
Reputation : -189988
Join date : 25/06/2018
Age : 14
Location : TNPPTSBĐ

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

Về Đầu Trang Go down

Re: Công nghệ Tưới tiêu

Bài gửi by Cao Hải Dương on Sat Jan 05, 2019 3:36 pm

CODE:
Code:
Program tuoi_ruong;
Uses crt;
Var fi,fo:text; n,m,i,j,k,x,y,d,l,r:longint;
a:array[1..100,1..100] of integer;

Procedure xl;
Begin
Assign(fo,'FARM.OUT'); Rewrite(fo);
d:=0;
For i:=3 to m-2 do
For j:=3 to n-2 do
        If a[i,j]=1 then
                For x:=i-2 to i+2 do
                For y:=j-2 to j+2 do
                        If a[x,y]<>1 then a[x,y]:=2;
For i:=3 to m-2 do
For j:=3 to n-2 do
        If a[i,j]=0 then inc(d);
Write(fo,d);
Close(fo);
End;

Begin
Clrscr;
Assign(fi,'farm.inp'); Reset(fi);
Readln(fi,m,n);
m:=m+4; n:=n+4;
Readln(fi,k);
For i:=1 to k do
        Begin
        Readln(fi,x,y);
        a[x+2,y+2]:=1;
        End;
Close(fi);
xl;
Readln;
End.
avatar
Cao Hải Dương
Nhiệt tình
Nhiệt tình

Posts : 58
Reputation : -329968
Join date : 18/06/2018
Age : 14
Location : Bình Định

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

Về Đầu Trang Go down

Re: Công nghệ Tưới tiêu

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