M
marik
cho một cái readln trước cái exit là được, lúc trước anh sửa thẳng ở trên này nên ko biết nó chạy đc ko, thông cảm :d
{Kieu du lieu chua thong tin cua 1 buoc di}
Type ma = Record
x, y : Integer;
huong : Integer;
End;
{ Cac bien du lieu chinh}
Var Banco: Array [1..8,1..8] of Integer;
Nuocdi: Array [1..64] of ma;
a,cach,SoNuocdi : Integer;
{Thu tuc khoi dong cac gia tri dau cua chuong trinh}
Procedure Khoidong;
Var i,j : Integer;
Begin
write('Nhap kich thuoc ban co: ');readln(a);
cach := 0;
for i:=1 to a do
for j:= 1 to a do
Banco[i,j] := -1;
write('Nhap toa do hang chua con ma : ');
readln(Nuocdi[1].y);
write('Nhap toa do cot chua con ma : ');
readln(Nuocdi[1].x);
Nuocdi[1].huong := 0;
{Thiet lap nuoc di dau tien cua con ma}
SoNuocdi :=1;
Banco[Nuocdi[SoNuocdi].x,Nuocdi[SoNuocdi].y] := 1;
End;
{In ket qua con ma di tren ban co}
Procedure InKetqua;
Var h,c : Integer;
Begin
cach := cach + 1;
writeln('Cach di thu ',cach,':');
for h:= a downto 1 do begin
{ Hien thi hang luoi ngang ban co }
for c:= 1 to a do write('+--');
writeln('+');
{ Hien thi noi dung hang thu h ban co }
for c:= 1 to a do
write('|',Banco[h,c]:2);
writeln('|');
end;
{Hien thi hang luoi ngang ban co cuoi cung}
for c:= 1 to a do write('+--');
writeln('+');
readln;
End;
{Thu tuc tim nuoc di ke tiep}
Function TimNuocKe : Boolean;
Var x, y : Integer;
RetVal : Boolean;
Begin
RetVal := False;
repeat {lap tim nuoc di ke tiep cho den khi tim duoc hoac het cach di}
while (RetVal=False) and (Nuocdi[SoNuocdi].huong < 8) do begin
Case Nuocdi[SoNuocdi].huong of {thu huong di hien tai}
0 : begin
x := Nuocdi[SoNuocdi].x + 2;
y := Nuocdi[SoNuocdi].y - 1;
end;
1 : begin
x := Nuocdi[SoNuocdi].x + 1;
y := Nuocdi[SoNuocdi].y - 2;
end;
2 : begin
x := Nuocdi[SoNuocdi].x - 1;
y := Nuocdi[SoNuocdi].y - 2;
end;
3 : begin
x := Nuocdi[SoNuocdi].x - 2;
y := Nuocdi[SoNuocdi].y - 1;
end;
4 : begin;
x := Nuocdi[SoNuocdi].x - 2;
y := Nuocdi[SoNuocdi].y + 1;
end;
5 : begin
x := Nuocdi[SoNuocdi].x - 1;
y := Nuocdi[SoNuocdi].y + 2;
end;
6 : begin
x := Nuocdi[SoNuocdi].x + 1;
y := Nuocdi[SoNuocdi].y + 2;
end;
7 : begin
x := Nuocdi[SoNuocdi].x + 2;
y := Nuocdi[SoNuocdi].y + 1;
end
End;
if (0<=x) and (x<=a) and (0<=y) and (y<=a) and (Banco[x,y]=-1) then begin
{neu duoc thi ghi nhan}
SoNuocdi := SoNuocdi + 1;
Banco[x,y] := SoNuocdi;
Nuocdi[SoNuocdi].x := x;
Nuocdi[SoNuocdi].y := y;
Nuocdi[SoNuocdi].huong := 0;
RetVal:=True;
end else
{neu khong duoc thi thu huong ke tiep}
Nuocdi[SoNuocdi].huong := Nuocdi[SoNuocdi].huong + 1;
end;
if (RetVal=False) and (SoNuocdi <> 1) then begin
{neu khong tim duoc nuoc di ke thi lui con ma lai 1 buoc}
Banco[Nuocdi[SoNuocdi].x,Nuocdi[SoNuocdi].y] := -1;
SoNuocdi := SoNuocdi - 1;
Nuocdi[SoNuocdi].huong := Nuocdi[SoNuocdi].huong + 1;
end;
until RetVal or (SoNuocdi = 1);
TimNuocKe := RetVal;
End;
{Chuong trinh chinh}
Begin
Khoidong;
while TimNuocKe do begin
if SoNuocdi = a*a then begin
{neu tim duoc 1 nghiem}
InKetqua;
exit;
end;
end;
readln;
End.
Viết chương trình cho máy đoán số từ 1 đến 100, máy chỉ được hỏi 7 lần "Số của bạn có lớn hơn số .... hay không ?" Bạn chỉ được trả lời y hoặc n, từ đó máy sẽ đoán ra số mà bạn đang nghĩ trong đầu.
Về thuật toán thì chỉ cần máy cứ hỏi con số ở giữa là xong, chẳng hạn như 50, nếu y thì tiếp là 75, ...
Vấn đề là nếu giải thủ công thì bài rất dài mà áp dụng procedure thì em viết mãi không đc, có ai giúp với
uses crt;
var dau,cuoi,giua,i:byte;
k:char;
begin
clrscr;
dau:=0;
cuoi:=100;
i:=0;
repeat
inc(i);
giua:=round((dau+cuoi)/2);
write('So ban chon co lon hon ',giua,' hay ko? : ');
repeat readln(k); until (k='y') or (k='n');
if k='y' then dau:= giua else cuoi:=giua;
until i=7;
write('So ban chon la ', cuoi);
readln;
end.
Em nói rõ chút đi, nhập cái gì và xuất ra cái gì?có ai giúp mình bài thi HKII với !!! thank nhiu`!!!!
" viết chương trình gồm các menu sau:
1. nhập file
2. xuất file
3 tính trung bình cộng các phần tử là số nguyên tố
( sử dụng thủ tục và hàm)"
thank!
uses crt;
var x,c:integer;
procedure ktsnt(x:integer);
var i:integer;
begin
i:=2;
while(x mod i<>0) do i:=i+1;
if i=x then writeln(x, ' la so nguyen to ')
else writeln(x,' khong la so nguyen to');
end;
begin
repeat
clrscr;
writeln('0. Thoat ');
writeln('1. Nhap 1 so nguyen ');
writeln('2. Xuat 1 so nguyen ');
writeln('3. Kiem tra so nguyen to ');
write(' Vui long nhap lua chon : ');
readln(c);
case c of
0:writeln(' Ban da chon thoat ');
1:begin
write('Nhap so nguyen');
readln(x);
end;
2:begin
writeln('so vua nhap la ',x);
readln;
end;
3:begin
ktsnt(x);
readln;
end;
end;
until(c=0);
readln;
end.
uses crt;
var a:array[1..100] of integer;
n:integer;
procedure nhap;
var f:text;
i,j:integer;
begin
clrscr;
assign(f,'inp.txt');
rewrite(f);
write('Nhap so luong phan tu muon nhap: ');readln(n);
for i:=1 to n do
begin
write('Nhap phan tu thu ',i,' : ');readln(j);
write(f,j,' ');
end;
close(f);
end;
procedure xuat;
var f:text;
i:integer;
begin
clrscr;
assign(f,'inp.txt');
reset(f);
for i:=1 to n do read(f,a[i]);
for i:=1 to n do write(a[i]:3);
close(f);
end;
function nto(k:integer):boolean;
var kt:boolean;
j:integer;
begin
kt:=true;
for j:=2 to round(sqrt(k)) do if (k mod j = 0) then kt:=false;
if k=1 then kt:=false;
if (k=2) or (k=3) then kt:=true;
nto:=kt;
end;
procedure tbc;
var
f:text;
s:integer;
i,d:integer;
begin
assign(f,'inp.txt');
reset(f);
for i:=1 to n do read(f,a[i]);
s:=0;
d:=0;
clrscr;
for i:=1 to n do if nto(a[i]) then
begin
s:=s+a[i];
d:=d+1;
end;
if s<>0 then write('TBC= ',s/d:6:3) else write('0');
end;
begin
repeat
clrscr;
writeln('Chon cong viec muon lam: ');
writeln('1.Nhap 1 day so nguyen');
writeln('2.In ra day so vua nhap');
writeln('3.In ra TBC cac so nguyen to');
writeln('4.Thoat');
case readkey of
'1': nhap;
'2': xuat;
'3': tbc;
'4': exit;
end;
until readkey='4';
end.
Nhập vào một mảng 1 chiều n số nguyên dương, đếm xem trong mảng có bao nhiêu số nguyên tố!! Làm ơn giúp mình với nha!! Nhớ sử dụng cấu trúc tin học lớp 11 đó!! Thank nhìu!!!
uses crt;
var
a:array[1..100] of integer;
i,n,s,j:integer;
begin
write('n:=');readln(n);
for i:=1 to n do
begin
write('so thu ',i,':=); readln(a[i]);
end;
for i:=1 to n do
begin
for j:=2 to trunc(sqrt(a[i])) do
begin
if a[i] mod j <> 0 then s:=s+1;
end;
end;
writeln('so so nguyen to:=',s);
readln;
end.
Có ai giúp em bài này với:
Nhập vào 1 mảng 1 chiều có n phần tử. Tìm và in ra số nguyên âm lớn nhất> Thanks nhiều ạ!
var
a:array [1..100] of integer;
i,n,max:integer;
Begin
write('n='); readln(n);
for i:=1 to n do
begin
write('phan tu thu ,'i','='); readln(a[i]);
end;
max:=a[1];
for i:=1 to n do
begin
if (a[i] <0) and (a[i]> max) then
end;
writeln('so nguyen am lon nhat: ',max);
End.
Mình vừa chạy chương trình nhưng có vẻ không ổn lắmMã:var a:array [1..100] of integer; i,n,max:integer; Begin write('n='); readln(n); for i:=1 to n do begin write('phan tu thu ,'i','='); readln(a[i]); end; for i:=1 to n do begin if a[i] <0 then begin max:=a[i]; if a[i]> max then max:=a[i]; end; end; writeln('so nguyen am lon nhat: ',max); End.
chương trình thế này có jì sai ko?
var
a:array [1..100] of integer;
i,n,max:integer;
Begin
write('n='); readln(n);
for i:=1 to n do
begin
write('phan tu thu ,'i','='); readln(a);
end;
max:= a[1];
for i:=1 to n do
if (a <0) and (max < a) then max := a;
if max <0 then writeln('so nguyen am lon nhat: ',max);
Readln
End.
var
a:array [1..100] of integer;
i,n,max:integer;
Begin
write('n='); readln(n);
for i:=1 to n do
begin
write('phan tu thu ,'i','='); readln(a[i]);
end;
for i:=1 to n do
begin
if a[i] <0 then
begin
[COLOR="#ff0000"]max:=a[i];
if a[i]> max then max:=a[i];[/COLOR]
end;
end;
writeln('so nguyen am lon nhat: ',max);
End.
Bài của Tùng đoạn trên là sao? vừa gán max=a lại so sáng luôn 2 số!Mã:var a:array [1..100] of integer; i,n,max:integer; Begin write('n='); readln(n); for i:=1 to n do begin write('phan tu thu ,'i','='); readln(a[i]); end; for i:=1 to n do begin if a[i] <0 then begin [COLOR="#ff0000"]max:=a[i]; if a[i]> max then max:=a[i];[/COLOR] end; end; writeln('so nguyen am lon nhat: ',max); End.