Dưới đây là đề và code của các bài pascal, các bạn có thể tham khảo.
Đề và code Pascal
#2
Đã gửi 05-03-2016 - 14:04
Viết chương trình nhập vào một mảng gồm N số nguyên. Sắp xếp lại mảng theo thứ tự tăng dần và in kết quả ra màn hình.
Code:
Uses Crt;
Nhập vào mảng 1 chiều gồm 1 dãy số nguyên N phần tử. Hãy xóa các phần tử trùng nhau trong mảng và in kết quả ra màn hình. Ý tưởng: Duyệt mảng 1 chiều bằng 2 biến, nếu phát phát hiện phần tử nào trùng thì xóa phần tử ấy ra khỏi mảng.
Code:
Program Bo_so_trung;
Const
Max=100;
Var
a:Array[1..Max] Of Integer;
i,j,k,n:Integer;
Begin
Writeln('XOA BO CAC SO TRUNG NHAU');
Writeln('------------------------');
Writeln;
Write('-Nhap so phan tu mang: ');
Readln(n);
For i:=1 To N Do
Begin
Write('-Phan tu A[',i,']= ');
Readln(a[i]);
End;
i:=2;
While i <= N Do
Begin
j:=1;
While a[j] <> a[i] Do
j:=j+1;
If j < i Then
Begin
For k:=i to n-1 Do
a[k]:= a[k+1];
n:=n-1;
End
Else
i:=i+1;
End;
Writeln;
Write('-Mang con lai: ');
For i:=1 to n Do
Write(a[i]:8);
Writeln;
Writeln(' Bam phim <Enter> de ket thuc ');
Readln
End.
Đề bài: Nhập ngày tháng năm. Hãy cho biết ngày tháng năm sau đó N ngày.
Code:
program gt;
var d,m,y,n:integer;
Function Songay(thang,nam: Integer):Integer;
Var sn:Integer;
Begin
Case thang of
1,3,5,7,8,10,12 : sn:= 31;
4,9,11 : sn:= 30;
2: If (nam MOD 4 = 0) Then
sn:= 29
Else
sn:= 28;
End;
Songay:= sn;
End;
BEGIN
Writeln('Nhap ngay thang nam');Readln(d,m,y);
Writeln('Nhap N');Readln(N);
d:=d+N;
While d > Songay(m,y) Do
Begin
d:= d - Songay(m,y);
m:= m+1;
IF m > 12 Then
Begin
m:= 1;
y:= y + 1;
End;
End;
Writeln('Ket qua ',d,'/',m,'/',y);
Readln;
END.
Dãy FIBONACI là dãy được xác định như sau: F(0) = 0; F(1) = 1 và F(n) = F(n-1) + F(n-2) với n = 2, 3...
Ví dụ: Với M=10 thì các số FIBONACI nhỏ hơn M là: 0, 1, 1, 2, 3, 5, 8. Số 5 là số nguyên tố lớn nhất trong các số FIBONACI nhỏ hơn M. Vậy cần đưa ra màn hình dòng thông báo kết quả: Số cần tìm là: 5.
var j,i,m,a,b,t:longint;
{----------------------}
Function kt(n:longint):boolean;
var i,d:integer;
begin
kt:=false;
d:=0;
For i:=1 to n do
if n mod i=0 then inc(d);
if d=2 then kt:=true;
end;
{----------------------}
begin
clrscr;
Write('Nhap m= ');
readln(m);
a:=0;
b:=1;
Repeat
a:=a+b;
b:=a+b;
Until (a>=m) and (b>=m);
if a<b then begin t:=a;a:=b;b:=t;end;
Repeat
a:=a-b;
b:=b-a;
Until ( (kt(a)) and (a<m)) or ( (kt(b)) and (b<m) );
If a>b then writeln(a);
if b>a then writeln(b);
{----------------------}
readln
end.
type ArrInt = array[1..250] of integer;
Var n,i,x : integer;
a: ArrInt;
BEGIN
clrscr;
write('Nhap so phan tu: ');
readln(n);
for i:=1 to n do
begin
write('Phan tu thu ',i,'= ');
readln(a[i]);
end;
writeln('Cac so chinh phuong co trong mang:');
for i:=1 to n do
begin
x:=trunc(sqrt(a[i]));
if sqr(x)=a[i] then
write(a[i]:4);
end;
readln;
END.
n,i,q,k,p,:integer;
a,b:array [1..1000] of integer;
begin
write('n= ');readln(n);
for i:=1 to n do
begin
write('a[',i,']= ');
readln(a[i]);
end;
write('-Chen pt va vi tri cua pt do: ');readln(k,p);
q:=0;
for i:=1 to n do
begin
inc(q);
if q=p then begin
b[q]:=k;
inc(q);
end;
b[q]:=a[i];
end;
writeln('-Mang sau khi chen la: ');
for i:=1 to q do
write(b[i],' ');
readln
end.
Viết CT nhập từ bàn phím mảng 1 chiều và xóa 1 phần tử của mảng có n phần tử.
var
n,i,q,k,p:integer;
a,b:array [1..1000] of integer;
begin
write('n= ');readln(n);
for i:=1 to n do
begin
write('a[',i,']= ');
readln(a[i]);
end;
write('Xoa pt co vi tri la: ');readln(p);
q:=0;
for i:=1 to n do
if q<>p then
begin
inc(q);
b[q]:=a[i];
end;
writeln('Mang sau khi xoa la: ');
for i:=1 to q do
write(b[i],' ');
readln
end.
Hai số m,n gọi là bạn của nhau nếu tổng các ước của m bằng n và ngược lại.Tìm tất cả các số là bạn của nahu và nhỏ hơn 10001.
Ý tưởng: Thay vì chạy 2 vòng lặp để xét m và n, ta có thể chỉ cần chạy 1 vòng lặp kiểm tra xem m và uoc(m) có là bạn của nhau không.
PROGRAM timban;
FUNCTION uoc(k:INTEGER):longint;
VAR i,tong:INTEGER;
BEGIN
tong:=0;
FOR i:=1 TO k DIV 2 DO
IF k MOD i =0 THEN tong:=tong+i;
uoc:=tong;
END;
VAR m:longint;
BEGIN
for m:= 1 to 10001 do
if uoc(uoc(m)) = m then writeln(m, ' va ', uoc(m),' la ban cua nhau');
readln
END.
Nhập vào 1 số tự nhiên n* và nhập vào m, sau đó tính tổng m các số tận cùng của n.
vd: n = 365 m =2 tổng = 5+6=11.
Cách 1:
var n: longint;
m,tong,i: integer;
BEGIN
clrscr;
write('Nhap n: '); readln(n);
write('Nhap m: '); readln(m);
for i:=1 to m do
begin
tong:=tong+(n mod 10);
n:=n div 10;
end;
write('Tong ',m,' chu so cuoi cua so vua nhap = ',tong);
readln;
END.
Cách 2: Sử dụng xâu: Xâu giúp lưu trữ thoải mái hơn kiểu số nguyên, nên ta có thể khái báo N có ở string thay vì Integer. Như vậy, ở những trường hợp lớn (vd N bao gồm 100 chữ số chẳng hạn) thuật toán vẫn có thể hoạt động bình thường.
var n: string;
m,i,a,tong: integer;
BEGIN
clrscr;
write('Nhap so n: '); readln(n);
write('Nhap m: '); readln(m);
for i:= length(n) downto length(n)-m+1 do
begin
val(n[i],a);
tong:=tong+a;
end;
write(tong);
readln;
END.
- nhungvienkimcuong, tpdtthltvp, PlanBbyFESN và 3 người khác yêu thích
#4
Đã gửi 06-03-2016 - 10:39
À! Nhân tiện cho hỏi 1 bài về xâu:
Bạn phải viết ct đưa ra tất cả các từ có thể có phát sinh từ 1 tập các chữ cái.
VD\
.INP .OUT
Abc abc
acb
bac
bca
cab
cba
Làm tương tự với cả xâu Acba nha
#5
Đã gửi 06-03-2016 - 14:55
À! Nhân tiện cho hỏi 1 bài về xâu:
Bạn phải viết ct đưa ra tất cả các từ có thể có phát sinh từ 1 tập các chữ cái.
VD\
.INP .OUT
Abc abc
acb
bac
bca
cabcba
Làm tương tự với cả xâu Acba nha
Bài này sao giống bài của uyennhi thế....
Mà bài này mình cũng làm rồi nhưng còn 1 bước nữa để hoàn thiện, đó là làm sao để xoa các từ giống nhau trong 1 mảng <vì mình đưa các từ vào trong 1 mảng kiểu xâu mà>.
---->Khi nào làm xong thì post lên cho.
- vanlong12 yêu thích
#6
Đã gửi 06-03-2016 - 15:11
Đề: Tìm chữ số sau số 0 của N!
Ý tưởng:
- Tính n!
- Chuyển kq của n! sang xâu
-Chạy xâu,nếu s[i]=0 thì viết ký tự thứ i+1 ra và thoát ra khỏi vòng lặp.
Code:
program gt;
uses crt;
var i,n,j,k,l:integer;
s,s1,s2:string;
begin
clrscr;
write('Nhap n=');readln(n);
t:=1;
for i:=1 to n do
t:=t*i;
str(t,s);
write('So sau so 0 cua ',n,'! la: ');
for i:=1 to length(s) do
if s[i]='0' then
begin
write(s[i+1]);
break;
end;
readln
end.
Bài viết đã được chỉnh sửa nội dung bởi Zjkar: 06-03-2016 - 15:11
#7
Đã gửi 06-03-2016 - 21:39
BT pascal:
Bài 1 (3 điểm): Hai số tự nhiên n, m được gọi là nguyên tố tương đương nếu chúng có chung các ước số nguyên tố. Hãy viết chương trình nhập vào hai số n, m và kiểm tra chúng có là nguyên tố tương đương với nhau hay không.
Ví dụ: số 75 và số 15 là nguyên tố tương đương vì chúng có cùng các ước số nguyên tố là 3 và 5.
Bài 2 (3 điểm): Cho hệ phương trình bậc nhất hai ẩn:
(I)
Hãy viết chương trình giải hệ phương trình trên, đồng thời xác định vị trí tương đối của hai đường thẳng d: ax+by=c và d’=a’x+b’y =c’ đã tạo nên hệ phương trình (I).
- Fjzar yêu thích
#8
Đã gửi 06-03-2016 - 21:43
BT pascal:
Bài 1 (3 điểm): Hai số tự nhiên n, m được gọi là nguyên tố tương đương nếu chúng có chung các ước số nguyên tố. Hãy viết chương trình nhập vào hai số n, m và kiểm tra chúng có là nguyên tố tương đương với nhau hay không.
Ví dụ: số 75 và số 15 là nguyên tố tương đương vì chúng có cùng các ước số nguyên tố là 3 và 5.
Bài 2 (3 điểm): Cho hệ phương trình bậc nhất hai ẩn:
(I)
Hãy viết chương trình giải hệ phương trình trên, đồng thời xác định vị trí tương đối của hai đường thẳng d: ax+by=c và d’=a’x+b’y =c’ đã tạo nên hệ phương trình (I).
ban tham khao xem lam nhu the nay dung k?
_ _ _ nỗi bất hạnh làm ra con người_ _ _
+ _còn con người làm ra hạnh phúc_ +
#9
Đã gửi 07-03-2016 - 12:05
Đề: Tìm chữ số sau số 0 của N!
Ý tưởng:
- Tính n!
- Chuyển kq của n! sang xâu
-Chạy xâu,nếu s[i]=0 thì viết ký tự thứ i+1 ra và thoát ra khỏi vòng lặp.
Code:
program gt;
uses crt;
var i,n,j,k,l:integer;
s,s1,s2:string;
begin
clrscr;
write('Nhap n=');readln(n);
t:=1;
for i:=1 to n do
t:=t*i;
str(t,s);
write('So sau so 0 cua ',n,'! la: ');
for i:=1 to length(s) do
if s[i]='0' then
begin
write(s[i+1]);
break;
end;
readln
end.
code của bạn ngây thơ vãi . Muốn tìm hiểu vấn đề này có thể vào page qvluom, có công thức tổng quát cho nó.
#10
Đã gửi 07-03-2016 - 12:06
code của bạn ngây thơ vãi . Muốn tìm hiểu vấn đề này có thể vào page qvluom, có công thức tổng quát cho nó.
Sao có ý kiến à....
Nếu vậy bạn nois ý tưởng xem nào
#11
Đã gửi 07-03-2016 - 12:12
À hay bài này phải tìm tìm các chữ số sau n! ?
Này,,, bạn vào gmail mình chat cho dễ
Bài viết đã được chỉnh sửa nội dung bởi Zjkar: 07-03-2016 - 12:18
#12
Đã gửi 07-03-2016 - 16:14
Sao có ý kiến à....
Nếu vậy bạn nois ý tưởng xem nào
yahaha, cứ giữ thái độ đó đi,
#13
Đã gửi 07-03-2016 - 18:05
yahaha, cứ giữ thái độ đó đi,
Còn lâu....
#14
Đã gửi 08-03-2016 - 10:06
À! Nhân tiện cho hỏi 1 bài về xâu:
Bạn phải viết ct đưa ra tất cả các từ có thể có phát sinh từ 1 tập các chữ cái.
VD\
.INP .OUT
Abc abc
acb
bac
bca
cabcba
Làm tương tự với cả xâu Acba nha
Bài này tôi làm được rồi .Up lên để cho mọi người tham khảo
Bài làm nè:
PROGRAM Sinh_hoan_vi;
CONST
MAX = 100;
INP = 'bai1.inp';
OUT = 'bai1.out';
TYPE
STR = array[0..max] of char;
VAR
s :str;
f,g :text;
n :longint; { so luong tu}
time:longint ;
PROCEDURE Nhap_dl;
Begin
Assign(f,inp);
Assign(g,out);
Reset(f);
Rewrite(g);
Readln(f,n);
End;
PROCEDURE DocDay(var s:str);
Begin
Fillchar(s,sizeof(s),chr(0));
While not eoln(f) do
begin
s[0]:=chr(ord(s[0])+1);
read(f,s[ord(s[0])]);
end;
End;
PROCEDURE VietDay(s:str);
Var i :word;
Begin
For i:=1 to ord(s[0]) do Write(g,s[i]);
End;
PROCEDURE Sap_xep(l,r:word);{ giai thuat Quicksort}
Var i,j :word;
tg,tam :char;
Begin
i:=l;j:=r;
tg:=s[(l+r) div 2];
Repeat
While ord(s[i]) < ord(tg) do inc(i);
While ord(s[j]) > ord(tg) do dec(j);
If i<=j then
begin
tam:=s[i];
s[i]:=s[j];
s[j]:=tam;
inc(i);
dec(j);
end;
Until i>j;
If j>l then Sap_xep(l,j);
If i<r then Sap_xep(i,r);
End;
PROCEDURE Sinh_hv(s:str);
Var vti,vtj,i,j:word;
stop :boolean;
tam :char;
Begin
Writeln(g);
VietDay(s);
Repeat
Stop:=true;
For i:= ord(s[0]) downto 2 do
If s[i] > s[i-1] then
begin
vti:=i-1;
stop:=false;
For j:=ord(s[0]) downto vti+1 do
begin
If (ord(s[j])>ord(s[vti])) then
begin
vtj:=j;
break;
end;
end;
tam:=s[vtj];
s[vtj]:=s[vti];
s[vti]:=tam;
For j:=1 to ((ord(s[0]) - (vti+1))+1) div 2 do
begin
tam:=s[vti+j];
s[vti+j]:=s[ord(s[0])-j+1];
s[ord(s[0])-j+1]:=tam;
end;
Writeln(g);
VietDay(s);
break;
end;
Until stop;
End;
PROCEDURE Xu_ly;
Var i:longint;
Begin
For i:=1 to n do
begin
DocDay(s);
readln(f);
Sap_xep(1,ord(s[0]));
Sinh_hv(s);
Writeln(g);
end;
Close(f);
Close(g);
End;
BEGIN
Nhap_dl;
Xu_ly;
END.
- Fjzar yêu thích
#15
Đã gửi 08-03-2016 - 10:52
Bài này tôi làm được rồi .Up lên để cho mọi người tham khảo
Bài làm nè:
PROGRAM Sinh_hoan_vi;
CONST
MAX = 100;
INP = 'bai1.inp';
OUT = 'bai1.out';
TYPE
STR = array[0..max] of char;
VAR
s :str;
f,g :text;
n :longint; { so luong tu}
time:longint ;
PROCEDURE Nhap_dl;
Begin
Assign(f,inp);
Assign(g,out);
Reset(f);
Rewrite(g);
Readln(f,n);
End;
PROCEDURE DocDay(var s:str);
Begin
Fillchar(s,sizeof(s),chr(0));
While not eoln(f) do
begin
s[0]:=chr(ord(s[0])+1);
read(f,s[ord(s[0])]);
end;
End;
PROCEDURE VietDay(s:str);
Var i :word;
Begin
For i:=1 to ord(s[0]) do Write(g,s[i]);
End;
PROCEDURE Sap_xep(l,r:word);{ giai thuat Quicksort}
Var i,j :word;
tg,tam :char;
Begin
i:=l;j:=r;
tg:=s[(l+r) div 2];
Repeat
While ord(s[i]) < ord(tg) do inc(i);
While ord(s[j]) > ord(tg) do dec(j);
If i<=j then
begin
tam:=s[i];
s[i]:=s[j];
s[j]:=tam;
inc(i);
dec(j);
end;
Until i>j;
If j>l then Sap_xep(l,j);
If i<r then Sap_xep(i,r);
End;
PROCEDURE Sinh_hv(s:str);
Var vti,vtj,i,j:word;
stop :boolean;
tam :char;
Begin
Writeln(g);
VietDay(s);
Repeat
Stop:=true;
For i:= ord(s[0]) downto 2 do
If s[i] > s[i-1] then
begin
vti:=i-1;
stop:=false;
For j:=ord(s[0]) downto vti+1 do
begin
If (ord(s[j])>ord(s[vti])) then
begin
vtj:=j;
break;
end;
end;
tam:=s[vtj];
s[vtj]:=s[vti];
s[vti]:=tam;
For j:=1 to ((ord(s[0]) - (vti+1))+1) div 2 do
begin
tam:=s[vti+j];
s[vti+j]:=s[ord(s[0])-j+1];
s[ord(s[0])-j+1]:=tam;
end;
Writeln(g);
VietDay(s);
break;
end;
Until stop;
End;
PROCEDURE Xu_ly;
Var i:longint;
Begin
For i:=1 to n do
begin
DocDay(s);
readln(f);
Sap_xep(1,ord(s[0]));
Sinh_hv(s);
Writeln(g);
end;
Close(f);
Close(g);
End;
BEGIN
Nhap_dl;
Xu_ly;
END.
Dài vãi...... .
Đây là làm được hay copy zậy
#16
Đã gửi 08-03-2016 - 22:03
Làm chuẩn đấy (Mất 2 ngày liền chứ copy ở đâu được ) Ông xem thử đi, nếu có j góp ý thì cứ nói
#17
Đã gửi 09-03-2016 - 11:53
Làm chuẩn đấy (Mất 2 ngày liền chứ copy ở đâu được ) Ông xem thử đi, nếu có j góp ý thì cứ nói
Xài tệp vb à ?
Mà bạn viết ý tưởng nghe xem nha... .
chi tiết vào...
#19
Đã gửi 09-03-2016 - 19:56
Bài có vấn đề hay do máy zậy mà sao mình copy vào ct free pascal mà chạy thì nó báo lỗi:
exited with
exitcode=2
mình làm bằng turbo pascal mà
#20
Đã gửi 09-03-2016 - 20:03
Xài tệp vb à ?
Mà bạn viết ý tưởng nghe xem nha... .
chi tiết vào...
Còn cái này để mai tôi up cho. Giờ tui phải ôn bài mai kiểm tra
1 người đang xem chủ đề
0 thành viên, 1 khách, 0 thành viên ẩn danh