Tin học Lập trình Pascal !

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
 
G

gervie

Vẫn không được hix, hay anh thử trước xem được không rồi post lên, em làm mà vẫn ko đươc :(, nó cứ văng ra mà chẳng thấy đc kết quả gì hết
 
M

marik

Mã:
{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.
Chắc chắn sẽ bị thừa vài câu lệnh, em tự edit nhé!
 
C

chunholovetazu

Các bạn giúp mình giải bài tập này với:
1. Nhập từ bàn phím 1 danh sách sinh viên gồm họ và tên,năm sinh, giới tính, quê quán, Viết CT đưa ra:
a, danh sách các sinh viên
b, ________nữ sinh sau năm 1975
c, ________nam quê ở HN
2. Viết CT làm các việc sau
a, Nhập từ bàn phím 1 danh sách thuốc gồm tên thuốc, năm hết hạn, số lg, đơn giá
b, Đưa dsach thuốc ra màn hình
c, Đưa ds thuốc hết hạn ra màn hình
d, Tính tổng giá trị thuốc đã hết hạn
3. Cho 1 danh sách: tên mặt hàng, s lượng, đơn giá
a, Nhập dữ liệu từ bàn phím
b, Đưa ra màn hình ds hàng hoá đã nhập
c, Đưa ra màn hình tên, s.lượng các mặt hàng có số lượng <5
d, Đưa ra màn hình tổng giá trị các mặt hàng đã nhaChâpChập
Mong các bạn chỉ giáo, mai mình phải nộp rồi mà. Cám ơn rất nhiều.
 
G

gervie

Giúp bài tập đoán số

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
 
A

allsuccess

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!
 
M

marik

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
Mã:
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.

Tìm kiếm kiểu nhị phân, bài này khá đơn giản
 
A

allsuccess

:D;)
tức là tạo ra cái menu :
1. nhập file { *nhập các số nguyên từ bàn phím sau đó ghi vào 1 file .txt, lưu lại*}; {thủ tục}
2.xuất file{* gọi file vừa tạo, xuất ra màn hình các phần tử*}; {thủ tục}
3.tính tbc các phần tử là số nguyên tố {*tính tbc các số là số nguyên tố trong file đã tạo rồi xuất ra kết quả*}; {hàm}
ai rnahr thì giúp mình nhé !! thứ bảy này phải nộp bài rồi !! thank nhìu!!
********đây là một ví dụ về tạo menu ******

Mã:
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.
 
M

marik

Mã:
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.
 
T

tungvip95

Trước mùa bóng mới, tờ báo địa phương dự định công bố bảng phân hạng các 5 đội bóng A,B,C,D,E. Để đưa ra kết quả, chủ toà soạn đã nhờ các chuyên gia cho ý kiến nhưng ý kiến của họ khá lệch nhau. Toà soạn quyết định tính độ lệch trung bình của các ý kiến rồi đưa ra kết quả của cuối cùng với độ lệch nhỏ nhất. Mỗi ý kiến được đưa ra dưới dạng 1 sâu ký tự A,B,C,D,E và vị trí của chúng là thứ tự của các đội. Độ lệch được tính bằng sự khác nhau trong sắp xếp các cặp thứ tự: VD có 2 đánh giá là ABCDE và ACDBE, ta thấy cặp chữ C-B và D-B bị xếp khác nên ABCDE lệch 2 so với ACDBE.

Yêu cầu: cho số ý kiến thăm dò n (0<n<100) và kết quả thăm dò dưới dạng như trên và in ra kết quả cùng số dư nhỏ nhất ra file rank.out.
VD: file rank.inp:
4
ABDCE
BACDE
ABCED
ACBDE
0
thì có file rank.out tương ứng
ABCDE 4

P/S: anh marik đừng làm bài này vội để mọi người suy nghĩ nhé:D
 
H

heokuz

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!!!
 
T

tungvip95

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!!!

Mã:
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.
 
Q

qnhu73

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 ạ!:D
 
T

tungvip95

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 ạ!:D
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;
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.
 
Last edited by a moderator:
Q

qnhu73

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
max:=a[i];
if a[i]> max then max:=a[i];
end;
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ắm :(
Ví dụ Mình nhập n=4, phần tử 1 là 2, phần tử 2 là -3, phần tử 1 là -2, phần tử 4 là -4
chương trình in ra số nguyên âm lớn nhất là -4( số cuối cùng nhập vào)???
Bạn xem lại giúp mình nhé!:)
 
Q

qnhu73

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;
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.
có gì sai bạn sửa luôn giúp mình nhé! Cảm ơn nhiều :D
 
M

marik

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.


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.
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ố!
 
T

tungvip95

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.
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ố!


xin lỗi cái phần gán em làm nhầm vì gán với a giá trị của max sẽ thay đổi liên tục nên phải gán với 1 giá trị cụ thể là a[1]:D
 
P

pk_ngocanh

giúp với pà kon ơi !
lập trình bài toán con tính BCNN của 2 số nguyên dương !
 
Top Bottom