Hãy nhập câu hỏi của bạn vào đây, nếu là tài khoản VIP, bạn sẽ được ưu tiên trả lời.
uses crt;
type mang= array[0..10000 ] of byte;
var a,d,m:mang; dd:array[1..20,1..400] of byte;
b:array [1..10000] of boolean;
r,dem, t,n,max,i,j:integer;
f:text;
procedure doc;
var i:integer;
begin
assign(f,'pthuong.inp');
reset(f);
readln(f,n);
for i:=1 to n do
readln(f,d[i]);
close(f);
end;
function kt( c:mang):boolean;
var i,j:longint;
q:boolean;
begin
i:=1;
q:=true;
while (i<=r-2) and q do
begin
j:=1;
while c[i+j-1]+1=c[i+j] do
j:=j+1;
if j>=3 then q:=false else q:=true;
i:=i+1;
end;
kt:=q;
end;
Procedure print;
var i,tong: byte;
begin if kt(a)=true then
begin dem:=dem+1;
tong:=0;
for i:=1 to r do
begin
dd[dem,i]:= a[i];
tong:=tong+d[a[i]];
end; m[dem]:=tong;
end;
end;
Procedure Find(k:byte);
var j: byte;
begin
if k>r then print else
begin
for j:=1 to n do
if b[j] and (j>a[k-1]) then
begin
a[k]:=j; b[j]:=false;
Find(k+1);
b[j]:=true;
end;
end;
end;
begin
clrscr;
doc;
dem:=0;
r:= n-(n div 3);
for t:=1 to n do
b[t]:=true; a[0]:=0;
Find(1);
max:=m[1];
for i:=1 to dem do
if max< m[i] then max:=m[i];
assign(f,'PTHUONG.OUT');
rewrite(f);
writeln(f,max);
for i:=1 to dem do
if max=m[i] then
begin
j:=1;
while (dd[i,j] <>0) do
begin
write(f,dd[i,j]:2);
j:=j+1;
end;
end;
close(f);
end.
Bạn tham khảo bộ code này nhé.
var i,n,d:word;
t,b,kt:array[1..10] of word;
procedure nhap;
var f:text;
begin
assign(f,'dulieu.inp');
reset(f);
readln(f,n);
for i:=1 to n do read(f,t[i]);
close(f);
fillchar(b,sizeof(kt),0);
end;
procedure tailap;
var i,j,d:integer;
begin
for i:=1 to n do
begin
d:=0;
for j:=1 to n do
begin
if b[j]=0 then d:=d+1;
if d=t[i]+1 then break;
end;
b[j]:=i;
end;
end;
BEGIN
nhap;
tailap;
for i:=1 to n do write(b[i],' ');
readln
END.
câu hỏi này bạn nên để chị @Nguyễn Minh Lệ trả lời giúp bạn
uses crt;
var n,n1,s:real;
begin
clrscr;
write('Nhap n: ');readln(n);
n1:=2*n+1;
s:=((n1 - 1)/2+1)*(n1 + 1)/2;
write(s:0:0);
readln
end.
var
i,j,n,k,x,vt:longint;
s,r,s1,s2:ansistring;
A:array[0..101] of boolean;
B:array[0..101] of longint;
BEGIN
assign(input,'gach.inp'); reset(input);
assign(output,'gach.out'); rewrite(output);
read(n,k);
for i:=1 to 101 do
A[i]:=true;
A[1]:=false;
for i:=1 to trunc(sqrt(101)) do
if (A[i] = true) then
for j:=2 to 101 div i do
A[i*j]:=false;
vt:=0;
for i:=1 to 101 do
if (A[i] =true) then
begin
inc(vt);
B[vt]:=i;
end;
for i:=1 to n do
begin
str(B[i],r);
s:=s+r;
end;
x:=length(s)-k-1;
vt:=1;
while (x >= 0) do
begin
for j:=vt to length(s)-x do
if (s[vt] > s[j]) then vt:=j;
s1:=s1+s[vt];
dec(x);
inc(vt);
end;
x:=length(s)-k-1;
vt:=1;
while (x >= 0) do
begin
for j:=vt to length(s)-x do
if (s[vt] < s[j]) then vt:=j;
s2:=s2+s[vt];
dec(x);
inc(vt);
end;
writeln(s);
writeln(s1);
writeln(s2);
close(input);
close(output);
END.
Bạn tham khảo code này nhé.
Uses crt;
Const fo = 'chenxau.out';
dau: array[1..3] of String[1]= ('','-','+');
s:array[1..9] of char=('1','2','3','4','5','6','7','8','9');
Var d:array[1..9] of String[1];
m:longInt;
f:text;
k:integer;
found:boolean;
Procedure Init;
Begin
Write('Cho M=');
Readln(m);
found:=false;
end;
Function tinh(s:string):longint;
Var i,t:longint;
code:integer;
Begin
i:=length(s);
While not(s[i] in ['-','+']) and (i>0) do dec(i);
val(copy(s,i+1,length(s)-i),t,code);
If i=0 then begin tinh:=t; exit; end
else
begin
delete(s,i,length(s)-i+1);
If s[i]='+' then tinh:=t+tinh(s);
If s[i]='-' then tinh:=tinh(s)-t;
end;
End;
Procedure Test(i:integer);
Var st:string; j:integer;
Begin
st:='';
For j:=1 to i do st:=st+d[j]+s[j];
If Tinh(st) = m then begin writeln(f,st); found:=true; end;
End;
Procedure Try(i:integer);
Var j:integer;
Begin
for j:=1 to 3 do
begin
d[i]:=dau[j]; Test(i);
If i<9 then try(i+1);
end;
End;
BEGIN
Clrscr;
Init;
Assign(f,fo);Rewrite(f);
for k:=1 to 2 do
begin
d[1]:=dau[k];
Try(2);
end;
If not found then write(f,'khong co ngiem');
Close(f);
END.
mình nghĩ là vậy
à mà tiện thể, ban nãy mình để quên não dưới đất
cho phép mình lụm lên lại cái nha :)))
sửa thêm chỗ else if kia nữa là ok :)))
quaylui(sum, j + 1)