Thảo luận pascal 11

P

p_trk

[TẶNG BẠN] TRỌN BỘ Bí kíp học tốt 08 môn
Chắc suất Đại học top - Giữ chỗ ngay!!

ĐĂNG BÀI NGAY để cùng trao đổi với các thành viên siêu nhiệt tình & dễ thương trên diễn đàn.

Rất vui mừng khi ban ghe thăm topic pascal 11 này , nhưng hy vọng hơn bạn sẽ đóng góp xây dựng topic này nói riêng và hocmai nó chung. Cảm ơn bạn rất nhiều


Mình có một số bài cơ bản đâu tiên :
Bài 1: Viết chương trình tìm số nguyên tố MAX và MIN có 3 chữ số
Bài 2: Nhập vào mảng n số
Tìm số mà tổng các chữ số của nó là lớn nhất và tổng các chữ số đó là số nguyên tố.
 
G

greennumber

Cho mình tham gia với nhé :D:D
Bài 1: mình có thể cho biến i chạy từ 100 đến 999, với mỗi trường hợp kiểm tra i là số nguyên tố không ? Nếu nó là số nguyên tố thì dừng lặp (break) và in ra MIN. Sau đó chạy từ 999 xuống 100, nếu nó là số nguyên tố thì in MAX. Cái lặp thay bằng while cũng được.

Bài 2: Cái này mình nghĩ đơn giản thôi, viết hàm tính tổng các chữ số, kiểm tra nó có phải nguyên tố không, nếu đúng thì cập nhật max.

Mong mọi người giúp đỡ :D:D
 
P

p_trk

Cho mình tham gia với nhé :D:D
Bài 1: mình có thể cho biến i chạy từ 100 đến 999, với mỗi trường hợp kiểm tra i là số nguyên tố không ? Nếu nó là số nguyên tố thì dừng lặp (break) và in ra MIN. Sau đó chạy từ 999 xuống 100, nếu nó là số nguyên tố thì in MAX. Cái lặp thay bằng while cũng được.

Bài 2: Cái này mình nghĩ đơn giản thôi, viết hàm tính tổng các chữ số, kiểm tra nó có phải nguyên tố không, nếu đúng thì cập nhật max.

Mong mọi người giúp đỡ :D:D
ừ. rất cảm ơn bạn đã tham gia topic ,
Lần sau bạn post code giúp mình luôn nha :)
 
P

p_trk

Bài tiếp theo:
Nhập mảng n*n và số k. đưa ra vị trí ô vuông có cạnh bằng k trong mảng sao cho ô vuông đó cỏ tổng các giá trị trong nó là MAX. { Nếu muốn đầy đủ bạn có thể cho thêm MIN } ( chú ý vị trí ô vuông được xác định bằng tọa độ của ô đầu tiên , góc trên bên trái )
 
N

nvtan256

Bài tiếp theo:
Nhập mảng n*n và số k. đưa ra vị trí ô vuông có cạnh bằng k trong mảng sao cho ô vuông đó cỏ tổng các giá trị trong nó là MAX. { Nếu muốn đầy đủ bạn có thể cho thêm MIN } ( chú ý vị trí ô vuông được xác định bằng tọa độ của ô đầu tiên , góc trên bên trái )
PHP:
Const fi='';
          fo='';
Var  n,k:integer;
     a:array[0..1000,0..1000] of integer;
     b:array[0..1000,0..1000] of longint;
     max,s:longint;
Procedure mo;
  Begin
     assign(input,fi);   reset(input);
     assign(output,fo);  rewrite(output);
  End;


Procedure nhap;
  Var  i,j:integer;
  Begin
      readln(n,k);
      for i:=1 to n do
       for j:=1 to n do read(a[i,j]);
  End;
Procedure solve;
  Var i,j:integer;
  Begin
      for i:=1 to n do
          for j:=1 to n do
               b[i,j]:= b[i,j-1]+b[i-1,j]-b[i-1,j-1]+a[i,j];
      max:=0;
      for i:=k to n do
          for j:=k to n do
          begin
              s:=b[i,j]-b[i-k,j]-b[i,j-k]+b[i-k,j-k];
              if s>max then max:=s;
          end;
  End;


Procedure ghi;
  Begin
     write(max);
  End;


Procedure dong;
  Begin
     close(input);
     close(output);
  End;
BEGIN
     mo;
     nhap;
     solve;
     ghi;
     dong;
END.
đây bạn , mình làm thế này:)
bạn chạy thử nha
 
N

nvtan256

à nhầm, bài đó mình mới chỉ ra giá trị lớn nhất thôi:-SS
PHP:
for i:=k to n do
          for j:=k to n do
          begin
              s:=b[i,j]-b[i-k,j]-b[i,j-k]+b[i-k,j-k];
              if s>max then max:=s;
          end;
đoạn này nếu s>max bạn lưu i,j lại là xong:(i,j) là ô dưới phải của ô vuông cần tìm, từ đó suy ra ô trên trái là (i-k,j-k)
hì thông cảm nha.
 
Last edited by a moderator:
P

p_trk

Bài :
nhập vào xâu S ( họ tên ) --> chuẩn hóa xâu S ( đầu cuối S không có dấu space và giữa mỗi từ có 1 space , đầu từ viết hoa. Nếu trong S có số hay các kí tự không cấu tạo nên từ thì thông báo tên sai.
 
T

tieuhoalong_102_galucsi

các bạn giỏi pacal nhỉ có j thêm cho mình vs nha
tại phần này pacal càng ngày càng kó hiểu
 
G

greennumber

Bài tập chuẩn hóa xâu:
PHP:
uses crt;
var
   p, i: integer;
   s: string;
BEGIN
   clrscr;
   write('Nhap vao ten cua ban: '); readln(s);
   while s[1] = ' ' do delete(s, 1, 1);
   while s[length(s)] = ' ' do delete(s, length(s), 1);
   p := pos('  ', s);
   while p > 0 do
   begin
      delete(s, p, 1);
      p := pos('  ', s);
   end;
   s[1] := upcase(s[1]);
   for i := 2 to length(s) do if s[i] = ' ' then s[i + 1] := upcase(s[i + 1]);
   for i := 1 to length(s) do if not (s[i] in [' ', 'A'..'Z', 'a'..'z']) then 
   begin
       write('Ten sai!');
       readln;
       halt;
   end;
   write('Ten cua ban: ', s);
   readln;
END.
 
M

matnatinhyeu_1995

Các bạn giúp mình bài này nha ^_^

Viết một chương trình tìm tất cả những số nguyên tố đối xứng nằm trong đoạn [a;b]

[TEX](5 \leq a < b \leq 100 000 )[/TEX]
 
N

nghiahung2000

minh co tap nay hay lam . pót cho cac ban tham khao
---------------------------------------------------------------------DẠNG 1: Bài toán kiểm tra số nguyên n thõa mãn tính chất nào đó.
1/ Kiểm tra số nguyên tố: lớn hơn 1, chỉ có hai ước là 1 và chính nó
2/a/ Kiểm tra số siêu nguyên tố
Là số khi bỏ bất kỳ một số chữ số từ phải sang trái số đã cho, kq vẫn là một số nt
b/ kiểm tra số phản nguyên tố
Là số khi bỏ bất kỳ một số chữ số từ phải sang trái số đã cho, thì nó đều không phải là số nguyên tố( vd 9468 là số pnt;3468 ko phải là phản nguyên tố)
3/ Kiểm tra số chính phương: bằng bình phưong của một số
4/ Kiểm tra số hoàn hảo: tổng các uớc nhỏ hơn nó bằng chính nó. Vd 6,28
5/ Kiểm tra số fibonaci 1 1 2 3 5 8 13….. 6/ Kiểm tra số phản nguyên tố
6/ kiểm tra số armstrong: lập phương các chữ số bằng nó
7/ số phản nguyên tố: là số có nhiều ước nhất trog n số tự nhiên đầu tiên( cho số k<=1000 ) hãy tìm các số phản nguyên tố nhỏ hơn hoặc bằng k
8/ Tên file được đặt là BL1.PAS (2,5 điểm)
Tại vương quốc Ba Tư xa xưa, người ta tổ chức các cuộc thi tìm dãy số hạnh phúc : các chàng trai cô gái thông minh trong thời gian ngắn nhất phải tìm ra được một dãy số hạnh phúc có nhiều phần tử nhất.
Dãy số tự nhiên a1, a2,.., ak được gọi là hạnh phúc nếu nó thoả mãn các điều kện sau :
- Dãy trên là dãy giảm dần .
- Với mọi i (1<i<=k) ai hoặc là số nguyên tố, hoặc phải là ước của một trong các số a1, a2,.., ai-1 .
Em hãy viết chương trình giúp các chàng trai cô gái Ba Tư để : Nhập vào một số N từ bàn phím và in ra màn hình một dãy số hạnh phúc dài nhất với số hạng đầu tiên là N .
Ví dụ :
Nhập N Đọc ra màn hình
8 DAY THOA MAN: 8 7 5 4 3 2 1







1/ FUNCTION nt(x:integer):boolean;
var kt:boolean; i:integer;
begin
if x<2 then nt:=false
else
begin
kt:=true;
for i:= 2 to x-1 do
if x mod I = 0 then
begin
kt:=false;
break;
end;
nt:=kt;
end;
end;
2/a/ FUNCTION snt(x:integer):boolean;
var kt:boolean;
begin
kt:=true;
while (x>0) and (kt=true) do
if not nt(x) then kt:=false
else x:=x div 10;
snt:=kt;
end;
b// procdure pnt(x:integer);
begin
if x> 0 then
if nt(x)=true then write(x,’la so nguyen to’)
else
begin
x:=x div 10;
pnt(x);
end;
else write(x,’la so phan nguyen to’)
{ while (x>0) and (nt(x)=false) do x:=x div 10;
if x=0 then write('la so phan nuyen to')
else write('ko phai phan nguyen to');}
end;

3/ / FUNCTION cp(x:integer):boolean;
var kt:boolean;
begin
kt:=false;
if sqr(trunc(sqrt(x)))=x then kt:=true;
cp:=kt;
end;
4/ / FUNCTION hoanhao(x:integer):boolean;
var kt:boolean; tong:integer;
begin
kt:=false;
tong:=0;
for i:=1 to (x div 2) do
if x mod I =0 then s:=s+i;
if s=x then kt:=true;
hoanhao:=kt;
end;
5/ {THUẬT TOÁN IN SỐ FIBONACI THỨ N}
PRCEDURE FIBO(var n:integer);
Var u1,u2,u3:integer;
Begin
If n <= 2 then write(‘ fibonaci thu’,n, ‘ = 1’)
Else
Begin
U1:=1;u2:=1;
For i:=3 to n do
Begin
U3:=u1+u2;
U1:=u2;
U2:=u3;
End;
End;
Write(‘ so fibonaci thu n’, u3);
End;

{THUẬT TOÁN KIỂM TRA MỘT SỐ CÓ PHẢI LÀ SỐ FIBONACI THỨ N KHÔNG}
FUNCTION fibonaci(var n:integer):boolean;
Var u1,u2,u3:integer;
Begin
If n=1 then fibonaci:=true;
Else
Begin
U1:=1;u2:=1;
Repeat
U3:=u1+u2;
U1:=u2;
U2:=u3;
Until u3>=n;
If u3=n then fibonaci:=true
Else fibonaci:=false;
End;
End;
6/ abc là số ARMSTRONG nếu abc =a*a*a+b*b*b+c*c*c;
FUNCTION ARMSTRONG (var n:integer): boolean;
Var t,tam,cs:integer;
Begin
T:=0; tam:=x;
While x<>0 do
Begin
Cs:= x mod 10;
T:=t + cs*cs*cs;
X :=x div 10 ;
End;
If tong=tam then ARMSTRONG:=true
Else ARMSTRONG:=false;

End;

7/var m,i,c,tam:integer;
function demuoc(var n:integer):integer;
var c,i:integer;
begin
c:=0;
for i:=1 to n do
if n mod i =0 then c:=c+1;
demuoc:=c;
end;
begin
m:=0;
for i:=1 to 1000 do
if demuoc(i)> m then
begin
m:=demuoc(i);
tam:=i;
end;
write('so phan nguyen to nho hon 1000 la',tam);
readln;
end.
8/ Bµi1:
{Day so hanh phuc}
uses crt;
var a: array[1..1000]of integer;
i,j,k,n,d:integer;
kt:boolean;
function nt(n:longint):boolean;
var i:longint;
begin
if n<2 then nt:=false
else begin
i:=2;
while (i<=sqrt(n)) and (n mod i<>0) do inc(i);
nt:=(i>sqrt(n));
end;
end;
BEGIN
clrscr;
write('vao n=');readln(n);
if n=2 then write(n,' ',1)
else
begin
d:=1; a[1]:=n;
for i:= n-1 downto 1 do
begin
if(nt(i)) then begin inc(d);a[d]:=i;a[d]:=i;end
else
begin
kt:=false;
for j:=1 to d-1 do
if a[j] mod i=0 then kt:=true;
if kt then begin
inc(d);
a[d]:=i;
end;
end;
end;
for i:=1 to d do write(a,' ');
end;
readln;
END.
 
N

nghiahung2000

Tiep ne
----------------------------------------------------DẠNG 2: CÁC BÀI TẬP VỀ MẢNG
1/ NhẬP vào một mảng gồm n số
a/ Kiểm tra xem nảg có đói xứng hay không
b/ Xác định số lần xuất hiện các phần tử trong mảng
c/ Giữ nguyên dãy ban đầu. Tìm dãy con liên tục tăng dần có độ dài dài nhất
d/ Sắp xếp dãy theo thứ tự giảm dần, sau đó nhập vào sô k sao cho thứ tự của dãy vẫn không thay đổ
e/ Chèn phần tử vào mảng
f/Xóa phần tử của mảng

procedure nhap(var a:mang;n:integer);
begin
for i:=1 to n do
begin
writeln( 'a[',i,']=');readln(a);
end;
end;

procedure sapxep(var a:mang;n:integer);
var i,j,tam:integer;
begin
for i:=1 to n-1 do
for j:=i+1 to n do
if a<a[j] then
begin
tam:=a;
a:=a[j];
a[j]:=tam;
end;
writeln('mang sau khi sap xep');
for i:=1 to n do
write('a[',i,']=', a,' ');
readln;

end;

procedure xem(var a:mang;n:integer);
begin
for i:=1 to n do

writeln( 'a[',i,']=',a);
writeln;
end;

procedure ktdx(var a:mang;n:integer);
var kt:boolean;
begin
kt:=true;
for i:=1 to n do
if a<>a[n-i+1] then
begin
kt:=false;
break;
end;
if kt then write('mang dx')
else writeln('mang ko dx');
end;

procedure solanxh(var a:mang;n:integer);
var b:mang; max,min:integer;
begin
max:=a[1];min:=a[1];b[a[1]]:=0;
for i:=2 to n do
begin
b[a]:=0;
if max<a then max:=a;
if min>a then min:=a;
end;
for i:=min to max do b:=0;
for i:=1 to n do b[a]:=b[a]+1;
for i:=min to max do
if b>0 then writeln(i,'xuat hien', b,'lan');
end;

procedure ptxhnln;
var pos,maxlen,dem:integer;
begin
pos:=1;
i:=1;
maxlen:=1;
repeat
dem:=1;
while (a=a[i+1]) and (i<n) do
begin
inc(i);
inc(dem);
end;
if maxlen<dem then
begin
maxlen:=dem;
pos:=i;
end;
inc(i);
until i>=n;
write(a[pos],'xuat hien nhieu nhat la',dem);
end;

procedure ptxh_k_lan;
var pos,maxlen,dem:integer;
begin

i:=1;
repeat
dem:=1;
while (a=a[i+1]) and (i<n) do
begin
inc(i);
inc(dem);
end;
if dem=k then write(a,'xh', k ,'lan');
inc(i);
until i>=n;
end;

procedure daytang(var a:mang;n:integer)
var cmax,dem,dau,cuoi:integer;
begin
cmax:=0;
i:=1;
while i<=n do
begin
dem:=1;
j:=i;
while (a[j]<a[j+1]) and (j<=n) do
begin
dem:=dem+1;
j:=j+1;

end;
if dem>=cmax then
begin
cmax:=dem;
dau:=i;
cuoi:=j;
end;
i:=j+1;
end;
write('day con co tong tang dai nhat');
for i:= dau to cuoi do write(a:4);
end;
Procedure Chen(var a:mang);
Var i,spt:Integer;
so,vitri:Integer;
a:Array[1..100] Of Integer;
Begin
Writeln('MANG TRUOC KHI CHEN');
For i:=1 To n Do
Write(a:6);
Writeln;
Write('-Can che so: ');
Readln(so);
Write('-Vao vi tri: ');
Readln(vitri);
For i:=n+1 Downto Vitri+1 Do
a:=a[i-1];
a[vitri]:=so;
n:=n+ 1;
Writeln;
Writeln('MANG SAU KHI CHEN');
For i:=1 To n Do
Write(a:6);
Readln
End.----
{CHEN MOT SO K VAO MANG DA SAP XEP SAO CHO THU TU KHONG DOI}
Procedure Chen(var a:mang);
Var i,spt:Integer;
so,vitri:Integer;
a:Array[1..100] Of Integer;
Begin

Write('-Can che so: ');
Readln(so);
Vitri:=1;
while (vitri<n) and (a[vitri]>k) then vitri:=vitri+1;
For i:=n+1 Downto Vitri+1 Do
a:=a[i-1];
a[vitri]:=so;
n:=n+ 1;
Writeln;
Writeln('MANG SAU KHI CHEN');
For i:=1 To n Do
Write(a:6);
Readln
End.----

Prcedure Xoa_Pt(var a:mang);
Var i,spt,vitri:Integer;
a:Array[1..100] Of Integer;
Begin

Writeln(' MANG TRUOC KHI XOA');
Writeln(' -----------------');
Writeln;
For i:=1 To n Do
Write(a:6);
Writeln;
Writeln;
Write('-Vi tri muon xoa: ');
Readln(vitri);
For i:=vitri to n - 1 Do
a:=a[i+1];
n:=n - 1;
Writeln;
Writeln(' MANG SAU KHI XOA');
Writeln(' ----------------');
Writeln;
For i:= 1 to n Do
Write(a:6);
Writeln;
Writeln;
Writeln(' Bam phim <Enter> de ket thuc ');
Readln

End;
Nhập mảng, sắp xếp các pt chẵn về đầu mảng, lẽ về cuối mảng
Procedure sx(var:mang;n:integer);
Var
Begin
sx:=1;ex:=n;
while sx<ex do
begin
while (a[sx] mod 2=0 ) and (sx<ex) do sx:=sx+1;
while (a[ex] mod 2=1 ) and (sx<ex) do ex:=ex-1;
if sx<ex then
begin
tg:=a[sx];
a[sx]:=a[ex];
a[ex]:=tg;
end;
ex:=ex-1;sx:=sx+1;
end;
for i:=1 to n do write(a:4);
readln;
End;
Nhập mảng, in ra pt lớn thứ k
Nhấpsắp xếp->in a[k];
BEGIN
write('nhap n: ');readln(n);
nhap(a,n);
xem(a,n);
{ ktdx(a,n);
solanxh(a,n); }
write('nhAp k');readln(k);
sapxep(a,n);
ptxh_k_lan;
readln;
END.
 
N

nghiahung2000

Tiep nua ne. Do no dai qua
--------------------------------------------------------------DẠNG 3/ CÁC BÀI TẬP TỔNG HỢP
1. Tam giác pascal
1
1 1
1 2 1
1 3 3 1
1 4 6 4 1
var Dong:array[0..20] of integer;
n,i,j: byte;
begin
write('=n'); readln(n);
dong[0]:=1;
writeln(dong[0]:4);
for i:=1 to n do dong:=0;
for i:=1 to n do
begin
for j:=1 downto i do
begin
dong[j]:=dong[j-1]+dong[j];
write(dong[j]:4);
end;
writeln(dong:4);
end;
readln;
end.
2/ Nhập mảng,in ra hai số liên tiếp có gttd của tổng bé nhất
program mang;
var a:array[1..50] of integer;
i,n,sx,ex,tg:integer;
begin
writeln('nhap so phan tu cua mang');readln(n);
for i:=1 to n do
begin
writeln( 'a[',i,']=');readln(a);
end;
tong:=abs(a[1] +a[2]);
fỏ i:=2 to n-1 do
if tong<abs(a + a[i+1]) then
begin
tong:=abs(a +a[i+1);
vitri:=I;
end;
write(‘ hai so lien tiep co gttd cua tong be nhat’,a:4,a[i+1]);
readln;
end.
3/ Tìm tổng các sô bất kỳ từ dãy 1,2,2,3,3,3,4,4,4,4
NHẬP M,N TÍNH a[m] +a[m+1] +…+a[n]
Program bt;
Var di:word;m,n,I,res:longint;
Begin
Write(‘nhap m’);readln(m);
Write(‘nhap n’);readln(n);
Di:=0;
I:=0;
While i<m do
Begin
Di:=di+1;
I:=i+di;
End;
Res:=(i-m+1)*di;
While i<=n do
Begin
Di:=di+1;
I:=di+1;
Res:=res+di*di
End;
Res:=res – di*(i-n);
witeln(‘ket qua’,res);
readln;
End.
4/ Đổi thập phân sang hệ cơ số bất kỳ
Program Doi_thap_phan_ra_he_bat_ky;
Var He10,N,Y,HeN:Word;
He,Tam:String;
Begin
Writeln('DOI SO TU HE THAP PHAN SANG HE BAT KY');
Write('-Nhap so nguyen he thap phan: ');Readln(He10);
N:=He10;
Write('-Doi sang he nao: ');Readln(HeN);
He:=' ';
Repeat
Y:=He10 Mod HeN;
If Y < 10 Then Str(Y, Tam)
Else
Tam:=Chr(Y+55);
He:=Tam + He;
He10:= He10 Div HeN;
Until He10 = 0;
Writeln('+So he 10 la : ',N);
Writeln('+Doi sang he: ',HeN:2,' la: ',He);
Writeln(' Bam phim <Enter> de ket thuc');
End.
5/ SỐ LIỀN TRƯỚC

Var S:string;
i, j, cs, k:integer;
max, t:char;

procedure hoanvi(var a,b:char);
var tam:char;
begin
tam:=a;
a:=b;
b:=tam;
end;

procedure solientruoc(var s:string);
Begin

i:=length(S);
while (i>1) and (s[i-1]<=s) do dec(i); {Tim s[i-1]>s}
If i=1 then
Begin
Write('Khong co cach doi');
Exit;
End;
i:=i-1;
max:='0';
For j:=i+1 to length(S) do
If (s[j]<s) and (max<s[j]) then
Begin
max:=s[j];
cs:=j;
End;

hoanvi(s,s[cs]);
k:=i+1;
For i:=k to length(S)-1 do
For j:=i+1 to length(S) do
IF s<s[j] then
hoanvi(s,s[j]);
Write(S);
end;

BEGIN
Readln(S);
solientruoc(s);
readln;
END

6.---------------TAM GIAC PASCAL-----------

var Dong:array[0..20] of integer;
n,i,j: byte;
begin
write('=n'); readln(n);
dong[0]:=1;
writeln(dong[0]:4);
for i:=1 to n do dong:=0;
for i:=1 to n do
begin
for j:=1 downto i do
begin
dong[j]:=dong[j-1]+dong[j];
write(dong[j]:4);
end;
writeln(dong:4);
end;
readln;
end.
7. Nhấp số có 5 chữ số.kiểm tra xem số có đx ko
Begin
Write(‘nhap so co 5 chu so’);
Readln(so);
Hcn:=so div 1000;
So:=so –hcn*1000;
Hn:=so div 1000;
So :=so –hn*1000;
Ht:=so div 100;
So:=so-so*100;
Hc:=so div 10;
Dv:=so mod 10;
If (hcn=dv) and(hn=hc) then w(‚ so dx’);
Else w(‘so ko dc’);
End.
8. Tìm chữ số tận cung của n!
Ý tưởng: xét tất cả các số chia hết cho 5. gs mỗi số đó có thể chia hết cho xi chữa số 5. cộng tất các các xi chữ số
Var n,i,j,count: longint;
Begin
Write(‘nhap n’);readln(n);
For i:=1 to n do
Begin
J:=I;
While j mod 5 =0 do
Begin
J:=j div 5;
Inc(count);
End;
End.
Write(‘so chu so tan cung’,count);
TIM SO CHINH PHUONG GAN N NHAT
Var
Begin
W(‘n’);r(n);
{tim cp 1}
I:=n-1;
Found:=false
While not found do
If i=sqr(trunc(sqrt(i))) then found:=true
Else i:=i-1;
Cp1:=i;
I:=n+1;;
Found:=false
While not found do
If i=sqr(trunc(sqrt(i))) then found:=true
Else i:=i+1;
Cp2:=i;
If n-cp1 <cp2-n then w(‘cp gan n nhat’,cp1)
Else write(‘chinh phuong 2’);
Readln;
End.
Phân tích một số ra tsnt
Begin
write(‘nhap n’);readln(n);
i:=2;
while (n>1) do
if n mod I =0 then
begin
write(i);
n:=n div I;
end;
writeln;
end.
Viết số n dưới dạng tổng các số fibonaci
Program tongfibo;
Var i,j,n,m:longint;f,g:text;

Function fi(h:integer): longint;
Var i:integer;
u2,u1,u:longint;
Begin
If (h=1) or (h=2) then fi:=1
Else
Begin
u2:=1;u1:=1;
For i:=3 to h do
begin
u:=u1+u2;
u1:=u2;
u2:=u;
End;
Fi :=u ;
End ;
End;
Function vt(so:longint):integer;
Var i:integer;
Begin
i:=1;
While fi(i) < so do i:=i+1;
If fi(i)=so then vt:=i
Else vt:=i-1;
End;
Procedure doc;
begin
assign(f,'fibo.inp');
reset(f);
read(f,n);
close(f);
end;
Begin
doc;
Assign(g,'fibo.out');rewrite(g);
Write(g,n, '= ');
write(f,fi(vt(n)));
n:=n-fi(vt(n));
While n<>0 do
Begin
M:=fi(vt(n));
write(g,' + ',m);
n:=n-fi(vt(n));

End;
Close(g);
End.
Bài 17/2000 - Số nguyên tố tương đương
(Dành cho học sinh THCS)
Hai số tự nhiên được gọi là Nguyên tố tương đương nếu chúng có chung các ước số nguyên tố. Ví dụ các số 75 và 15 là nguyên tố tương đương vì cùng có các ước nguyên tố là 3 và 5. Cho trước hai số tự nhiên N, M. Hãy viết chương trình kiểm tra xem các số này có là nguyên tố tương đương với nhau hay không.
Có thể viết chương trình như sau:
Program Nttd;
Var M,N,d,i: integer;
{------------------------------------}
Function USCLN(m,n: integer): integer;
Var r: integer;
Begin
While n<>0 do
begin
r:=m mod n; m:=n; n:=r;
end;
USCLN:=m;
End;
{------------------------------------}
BEGIN
Write('Nhap M,N: '); Readln(M,N);
d:=USCLN(M,N); i:=2;
While d<>1 do
begin
If d mod i =0 then
Begin
While d mod i=0 do d:=d div i;
While M mod i=0 do M:=M div i;
While N mod i=0 do N:=N div i;
end;
Inc(i);
end;
`
If M*N=1 then Write('M va N nguyen to tuong duong.')
Else Write('M va N khong nguyen to tuong duong.');
Readln;
END.
Bài 61/2001 - Thuật toán điền số vào ma trận
(Dành cho học sinh THCS và THPT)
lập thuật toán điền các phần tử của ma trận NN các số 0, 1 và -1 sao cho:
a) Tổng các số của mọi hình vuông con 2x2 đều bằng 0.
b) Tổng các số của ma trận trên là lớn nhất.

Program Bai61;
Uses crt;
Var a:array[2..250,2..250] of -1..1;
n,i,j:integer;
BEGIN
Write('Doc vao n:'); Readln(n);
Fillchar(a, sizeof (a), 0);
for i:=1 to n do
for j:=1 to n do
begin
If (i mod 2 <> 0) and (j mod 2 <> 0) then a[i,i] := 1;
If (i mod 2 = 0) and (j mod 2 = 0) then a[i,i] := -1;
end;
Writeln('Mang da dien la: ');
for i:=1 to n do
begin
for j:=1 to n do Write(a[i,j]:3);
Writeln;
end;
Write('Tong lon nhat la:');
If n mod 2 = 0 then Write(0) else Write(n);
Readln;
END.

Bài 10/1999 - Dãy số nguyên
(Dành cho học sinh THCS)
Dãy các số tự nhiên được viết ra thành một dãy vô hạn trên đường thẳng:
1234567891011121314..... (1)
Hỏi số ở vị trí thứ 1000 trong dãy trên là số nào?
Em hãy làm bài này theo hai cách: Cách 1 dùng suy luận logic và cách 2 viết chương trình để tính toán và so sánh hai kết quả với nhau.
Tổng quát bài toán trên: Chương trình yêu cầu nhập số K từ bàn phím và in ra trên màn hình kết quả là số nằm ở vị trì thứ K trong dãy (1) trên. Yêu cầu chương trình chạy càng nhanh càng tốt.
Chương trình:
Program Bai10;
Uses crt;
Var k: longInt;
(*--------------------------------------------*)

Function chuso(NN: longInt):char;
Var st:string[10];
dem,M:longInt;
Begin
dem:=0;
M:=1;
Repeat
str(M,st);
dem := dem+length(st);
inc(M);
Until dem >= NN;
chuso := st[length(st) - (dem - NN)]
(*-------------------------------------*)
BEGIN
clrscr;;
write('Nhap k:');
Readln(k);
Writeln('Chu so thu', k,'cua day vo han cac so nguyen khong am');
write('123456789101112... la:', chu so(k));
Readln;
END.
Nhập vào một dãy số nhị phân(n số nhị phân) . Hãy in ra số thập phân biễu diễn cho số nhị phân này ví dụ nhập 1000 in ra
var m :array[1..30] of 0..1 ;
n,hailt,t,i :longint ;
begin
write(‘nhap n’);readln(n);
for i:=1 to n do
begin
write(‘m’,I,’=’);readln(m);
end;
hailt:=1;t:=0;
for i:=1 downto 1 do
begin
t:=t+hailt*m;
hailt:=hailt*2;
end;
write(‘so thap phan la’);
end.
 
P

phithang_tin

vẽ hình trong pascal

Bạn ơi cho mình hỏi muốn vẽ chữ N và chữ Z trong pascal ta viết như thế nào. Mình biết phải dùng câu lệnh while..do và if..then nhưng không biết if điều kiện gì hết các bạn ơi. Có gì xin giải dùm
 
S

soc_tb

mảng 1 chiều trong pascal

Bạn muốn hỏi bài nào thì cứ post lên các mem hocmai cùng giải . cảm ơn bạn
ai giải hộ mình bài này với: nhập vào mảng A từ A1 đến An, tính tổng các số dương và đưa ra chỉ số số dương đầu tiên xuất hiện trong mảng.giúp mình với ạ mình cần gấp
 
D

demon311

ai giải hộ mình bài này với: nhập vào mảng A từ A1 đến An, tính tổng các số dương và đưa ra chỉ số số dương đầu tiên xuất hiện trong mảng.giúp mình với ạ mình cần gấp

PHP:
Var ...
BEGIN
{Nhập các số, nhập n}
For i:= 1 to n do
If a[i]>0 then s:=s+1 ;
For i:=1 downto 1 do 
If a[i]>0 then vitri:= i;
Write('Vi tri so duong dau tien la ',vitri);
read
END.
 
Top Bottom