Правила форума
Прочтите прежде чем задавать вопрос!
program Zadacha1;
uses Crt;
var c:boolean;
a,b:string;
function Sovmestimost(a,b:string):boolean;
var len1,len2,i,ii,res:integer;
aM,bM:array [1..20] of string;
d3:boolean;
begin
res:=0;
len1:=length(a);
len2:=length(b);
for i:=1 to len1 do aM[i]:=copy(a,i,1);
for i:=1 to len2 do bM[i]:=copy(b,i,1);
for i:=1 to len2 do
for ii:=1 to len1 do
if bM[i]=aM[ii] then begin res:=res+1; aM[ii]:=''; bM[i]:='*' end;
if res=len2 then d3:=true else d3:=false;
Sovmestimost:=d3
end;
begin
clrscr;
writeln('Vvedite pervoe slovo');
readln(a);
writeln('Vvedite vtoroe slovo');
readln(b);
if length(a)>length(b) then c:=Sovmestimost(a,b) else c:=Sovmestimost(b,a);
if c=true then writeln('YES') else writeln('NO');
readln
end.
В общем, можно сделать все намного изящнее (напр., процедуру проверки, есть ли "меньшее слово в старшем", сравнить слова и применить процедуру на меньшем), но, так как в задаче ничего не сказано, делал все по проще, так что не судите строго
Ну а вот вторая:
program Zadacha2;
uses Crt;
const n=6;
type masyv=array [1..n] of integer;
var a,b:masyv;
i,ii,x:integer;
begin
clrscr;
writeln('Vvedite 6 chusel');
for i:=1 to n do readln(a[i]);
for i:=1 to n-1 do
for ii:=i+1 to n do
begin
if a[i]>a[ii] then
begin
x:=a[i];
a[i]:=a[ii];
a[ii]:=x
end
end;
if (a[1]+a[6]=a[2]+a[5])and(a[2]+a[5]=a[3]+a[4]) then writeln(a[1]+a[6])
else writeln('N');
readln
end.
А это третья
. Знаю, написано плохо в плане стиля, но на доработку и оптимизацию нет времени да и желания (главное, что верно, об чем я надеюсь).Это верно, что этих чисел Армстронга так немного? Например, при н=2 нуль, при н=3 четыре (153,370,371,407), при н=4 три, а при н=5 нуль?
program zadaha3;
uses Crt;
var n,d5,k,ii:integer;
min,max,i,control:longint;
iText:string;
iLetter:array [1..10] of string;
iDigit:array [1..10] of integer;
function Stepin(x,y:integer):integer;
var d1:integer;
d2:integer;
begin
d2:=x;
for d1:=1 to y-1 do d2:=d2*x;
Stepin:=d2
end;
function Minimal(n:integer):longint;
var d3:integer;
d4:longint;
begin
d4:=1;
if n=0 then d4:=1 else for d3:=1 to n-1 do d4:=d4*10;
Minimal:=d4
end;
begin
clrscr;
writeln('Vvedite n');
readln(n);
min:=Minimal(n);
max:=Minimal(n+1)-1;
for i:=min to max do
begin
control:=0;
str(i,iText);
for ii:=1 to n do begin iLetter[ii]:=copy(iText,ii,1);
val(iLetter[ii],iDigit[ii],d5) end;
for ii:=1 to n do control:=control+Stepin(iDigit[ii],n);
if control=i then begin writeln(i); k:=k+1 end
end;
writeln('Vsego chusel Armstronga ',k);
readln
end.
Сообщение отредактировано: Vinchkovsky -
