Làm theo kiểu file được không ạ.
Code đó là cách làm theo kiểu file đó bạn
Làm theo kiểu file được không ạ.
Code đó là cách làm theo kiểu file đó bạn
Master Kaiser
Liên hệ facebook : https://www.facebook...uyenhoanganh238
bài 1 :cho hỏi bài tìm số hoàn hảo cho biết có bao nhiêu số hoàn hảo và in ra các số đó. ( làm theo file được không ạ).
PROGRAM So_hoan_hao;
uses crt;
Var S,n,i,j: integer;
BEGIN
Clrscr;
Write('Nhap so n : '); readln(n);
For i:=1 to n do
begin
S:=0;
For j:=1 to i do
if i mod j = 0 then
S:=S+j;
if S = 2*i then
write(i:6);
end;
Readln;
END.
(Mấy bài bạn nói rõ đề ra giùm ... như vậy thì chả biết nó là dạng gì ... ví dụ như dãy fibonacci thì mình cũng chat hiểu là viết dãy hay tìm số hay tìm dãy ... nữa :3)
Master Kaiser
Liên hệ facebook : https://www.facebook...uyenhoanganh238
PROGRAM So_hoan_hao;
uses crt;Var S,n,i,j: integer;
BEGIN
Clrscr;
Write('Nhap so n : '); readln(n);
For i:=1 to n do
begin
S:=0;
For j:=1 to i do
if i mod j = 0 then
S:=S+j;
if S = 2*i then
write(i:6);
end;
Readln;
END.(Mấy bài bạn nói rõ đề ra giùm ... như vậy thì chả biết nó là dạng gì ... ví dụ như dãy fibonacci thì mình cũng chat hiểu là viết dãy hay tìm số hay tìm dãy ... nữa :3)
In dãy fibonacci ạ. Làm giúp mình mấy bài kia luôn với ạ.
In dãy fibonacci ạ. Làm giúp mình mấy bài kia luôn với ạ.
Sau đây là chương trình in ra n số fibonacci ( n lấy từ file FIBO.INP )
{Đây là cách đơn giản nhất nhưng hơi khó nhớ }
PROGRAM FIBONACCI;
uses crt;
var i,n,f1,f2: integer;
g:text;
BEGIN
assign(g,'FIBO.INP');reset(g);
readln(g,n);
close(g);
assign(g,'FIBO.OUT');rewrite(g);
f1:=0;
f2:=1;
for i:=1 to n do
begin
writeln(g,f1);
f2:=f2+f1;
f1:=f2-f1;
end;
close(g);
END.
Master Kaiser
Liên hệ facebook : https://www.facebook...uyenhoanganh238
In dãy fibonacci ạ. Làm giúp mình mấy bài kia luôn với ạ.
Còn đây là làm theo mảng sẽ dễ nhớ và dễ hiểu
Program FIBONACI;
Uses CRT;
Var F:array[1..100] of integer;
N,I:Longint; f:text;
BEGIN
Assign(f,'FIBO.INP');reset(f);
Readln(f,n);close(f);
Assign(f,'FIBO.OUT');rewrite(f);
F[1]:=1; F[2]:=1;
For i:=1 to N do
Begin
If i>2 then F[i]:=F[i-1]+F[i-2];
Writeln(f,F[i]);
End;
Close(f);
END.
Master Kaiser
Liên hệ facebook : https://www.facebook...uyenhoanganh238
Còn đây là làm theo mảng sẽ dễ nhớ và dễ hiểu
Program FIBONACI;
Uses CRT;
Var F:array[1..100] of integer;
N,I:Longint; f:text;
BEGIN
Assign(f,'FIBO.INP');reset(f);Readln(f,n);close(f);
Assign(f,'FIBO.OUT');rewrite(f);
F[1]:=1; F[2]:=1;
For i:=1 to N do
Begin
If i>2 then F[i]:=F[i-1]+F[i-2];
Writeln(f,F[i]);
End;
Close(f);
END.
Cảm ơn bạn. Làm giúp mình mấy bài kia với ạ.
PROGRAM So_hoan_hao;
uses crt;Var S,n,i,j: integer;
BEGIN
Clrscr;
Write('Nhap so n : '); readln(n);
For i:=1 to n do
begin
S:=0;
For j:=1 to i do
if i mod j = 0 then
S:=S+j;
if S = 2*i then
write(i:6);
end;
Readln;
END.(Mấy bài bạn nói rõ đề ra giùm ... như vậy thì chả biết nó là dạng gì ... ví dụ như dãy fibonacci thì mình cũng chat hiểu là viết dãy hay tìm số hay tìm dãy ... nữa :3)
Sao mình in không ra 8128 nhỉ.
Sao mình in không ra 8128 nhỉ.
Code mình thì mình nghĩ đúng rồi nhưng bạn thử xem lại cái test xem ?
Master Kaiser
Liên hệ facebook : https://www.facebook...uyenhoanganh238
CONST fi='XEPCHU.inp';fo='XEPCHU.out';var st:array['A'..'Z'] of longint;i,j,N:longint;f:text;x:CHAR;beginassign(f,fi); reset(f);readln(f,n);for i:=1 to n dobeginread(f,x);ST[x]:=ST[x]+1;end;close(f);assign(f,fo); rewrite(f);for x:='A' to 'Z' doif st[x]<>0 thenwriteln(f,x, st[X]);close(f);END.Đây là bài nén xâu, ai giúp mình giải xâu đi.
Dưới đây là một code full từ nén xâu đến giải nén xâu (xâu thuần nhất) :
PROGRAM xau;
uses crt;
var s,ss,st,si:string; i,j,l:integer; f:text;
function kttn(s:string):boolean;
var x:char; ok:boolean;
begin
kttn:=true;
for i:=1 to length(s) do
s[i]:=upcase(s[i]);
for i:=1 to length(s) do
begin
ok:=false;
for x:='A' to 'Z' do
if s[i]=x then ok:=true;
if not ok then begin kttn:=false;break;end;
end;
end;
procedure nen(s:string;var st:string);
begin
ss:='';
while s<>'' do
begin
i:=1;
while (s[i+1]=s[1])and(i<length(s)) do
inc(i);
if i>1 then
begin
str(i,si);
ss:=ss+s[1]+si;
end
else ss:=ss+s[1];
delete(s,1,i);
end;
s:=ss;l:=2;
while l<length(s) do
begin
i:=1;
while i<=length(s)-l do
begin
si:=copy(s,i,l);
j:=i+l;
ss:=copy(s,j,l);
while ss=si do
begin
j:=j+l;
ss:=copy(s,j,l);
end;
if j=i+l then inc(i)
else
begin
str((j-i)div l,ss);
delete(s,i,j-i);
si:='('+si+')'+ss;
insert(si,s,i);
i:=i+l+2+length(ss);
end;
end;
inc(l);
end;
st:=s;
end;
function ktcd(st:string):boolean;
begin
ktcd:=false;
for i:=1 to length(st) do
if st[i]='(' then begin ktcd:=true; break; end;
end;
procedure giainen(st:string;var s:string);
var d,c:byte; code:integer;
begin
while ktcd(st) do
begin
i:=1; c:=0;
while st[i]<>'(' do inc(i);
d:=1; j:=i+1;
while c<d do
begin
inc(j);
if st[j]='(' then inc(d);
if st[j]=')' then inc(c);
end;
si:=copy(st,i,j-i+1);
delete(st,i,j-i+1);
delete(si,1,1);
delete(si,length(si),1);
j:=i;
while st[j+1] in['0'..'9'] do inc(j);
ss:=copy(st,i,j-i+1);
delete(st,i,j-i+1);
val(ss,l,code);
for j:=1 to l do
insert(si,st,i);
end;
i:=1;
while i<=length(st) do
begin
inc(i);
if st[i] in['0'..'9'] then
begin
j:=i;
while st[j+1] in['0'..'9'] do inc(j);
ss:=copy(st,i,j-i+1);
delete(st,i,j-i+1);
val(ss,l,code);
ss:=st[i-1];
for j:=1 to l-1 do insert(ss,st,i);
i:=i+l-1;
end;
end;
s:=st;
end;
BEGIN
assign(f,'XAU.INP');reset(f);
readln(f,s);close(f);
assign(f,'XAU.OUT');rewrite(f);
if kttn(s) then
begin
nen(s,st);
writeln(f,'Chuoi sau khi nen la: ',st);
giainen(st,s);
writeln(f,'Chuoi sau khi giai nen la: ',s);
end
else write(f,'Xau ko thuan nhat.');
close(f);
END.
Master Kaiser
Liên hệ facebook : https://www.facebook...uyenhoanganh238
Dưới đây là một code full từ nén xâu đến giải nén xâu (xâu thuần nhất) :
PROGRAM xau;
uses crt;
var s,ss,st,si:string; i,j,l:integer; f:text;
function kttn(s:string):boolean;
var x:char; ok:boolean;
begin
kttn:=true;
for i:=1 to length(s) do
s[i]:=upcase(s[i]);
for i:=1 to length(s) do
begin
ok:=false;
for x:='A' to 'Z' do
if s[i]=x then ok:=true;
if not ok then begin kttn:=false;break;end;
end;
end;
procedure nen(s:string;var st:string);
begin
ss:='';
while s<>'' do
begin
i:=1;
while (s[i+1]=s[1])and(i<length(s)) do
inc(i);
if i>1 then
begin
str(i,si);
ss:=ss+s[1]+si;
end
else ss:=ss+s[1];
delete(s,1,i);
end;
s:=ss;l:=2;
while l<length(s) do
begin
i:=1;
while i<=length(s)-l do
begin
si:=copy(s,i,l);
j:=i+l;
ss:=copy(s,j,l);
while ss=si do
begin
j:=j+l;
ss:=copy(s,j,l);
end;
if j=i+l then inc(i)
else
begin
str((j-i)div l,ss);
delete(s,i,j-i);
si:='('+si+')'+ss;
insert(si,s,i);
i:=i+l+2+length(ss);
end;
end;
inc(l);
end;
st:=s;
end;
function ktcd(st:string):boolean;
begin
ktcd:=false;
for i:=1 to length(st) do
if st[i]='(' then begin ktcd:=true; break; end;
end;
procedure giainen(st:string;var s:string);
var d,c:byte; code:integer;
begin
while ktcd(st) do
begin
i:=1; c:=0;
while st[i]<>'(' do inc(i);
d:=1; j:=i+1;
while c<d do
begin
inc(j);
if st[j]='(' then inc(d);
if st[j]=')' then inc(c);
end;
si:=copy(st,i,j-i+1);
delete(st,i,j-i+1);
delete(si,1,1);
delete(si,length(si),1);
j:=i;
while st[j+1] in['0'..'9'] do inc(j);
ss:=copy(st,i,j-i+1);
delete(st,i,j-i+1);
val(ss,l,code);
for j:=1 to l do
insert(si,st,i);
end;
i:=1;
while i<=length(st) do
begin
inc(i);
if st[i] in['0'..'9'] then
begin
j:=i;
while st[j+1] in['0'..'9'] do inc(j);
ss:=copy(st,i,j-i+1);
delete(st,i,j-i+1);
val(ss,l,code);
ss:=st[i-1];
for j:=1 to l-1 do insert(ss,st,i);
i:=i+l-1;
end;
end;
s:=st;
end;
BEGINassign(f,'XAU.INP');reset(f);
readln(f,s);close(f);
assign(f,'XAU.OUT');rewrite(f);
if kttn(s) then
begin
nen(s,st);
writeln(f,'Chuoi sau khi nen la: ',st);
giainen(st,s);
writeln(f,'Chuoi sau khi giai nen la: ',s);
end
else write(f,'Xau ko thuan nhat.');close(f);
END.
Tách riếng cho mình bài giải nén theo dạng file với ạ. Với sao bạn không giúp mình mấy bài trước với. Mình có đưa lên rồi.
Tách riếng cho mình bài giải nén theo dạng file với ạ. Với sao bạn không giúp mình mấy bài trước với. Mình có đưa lên rồi.
Lồng ghép đoạn Procedure giainen đó bạn
mấy bài kia ok mình sẽ up lời giải sau nhé ^^
Master Kaiser
Liên hệ facebook : https://www.facebook...uyenhoanganh238
bài tập pascal mong các bạn giúp đỡ
Cho dãy số gồm n (n < = 10000) số nguyên a1, a2, … , an (|ai| <= 10^9), tìm số nguyên X bất kì ñể S = |a1 — X| + |a2 — X| + … + |an — X| ñạt giá trị nhỏ nhất, có bao nhiêu giá trị nguyên khác nhau thoả mãn.
Ví dụ 1: dãy gồm 5 số 3, 1, 5, 4, 5, ta có duy nhất một giá trị X = 4 ñể S ñạt giá trị nhỏ nhất bằng 6.
Ví dụ 2: dãy gồm 6 số 3, 1, 7, 2, 5, 7 ta có ba giá trị nguyên của X là 3, 4, 5 ñể S ñạt giá trị nhỏ nhất bằng 13.
Cho mình hỏi bài này với
cho số k và n (k<n)
Hãy xóa k phần tử để được số n là lớn nhất?
VD1:
n=58916
k=2
--> 916
VD2:
n=69257502
k=4
--> 9752
Cho mình hỏi bài này: Nhập số nguyên dương $N$. Tìm số chữ số của $N$.
Cho mình hỏi bài này: Nhập số nguyên dương $N$. Tìm số chữ số của $N$.
bạn đổi số sang xâu
str(n;s);
rồi tính
Yêu cầu:
Cho trước một số n có đúng 5 chữ số lấy từ các chữ số 1, 2, 3, 4, 5. Tìm mã số của con số n.
0 thành viên, 2 khách, 0 thành viên ẩn danh