// PascalABC.NET 3.1, сборка 1172 от 19.02.2016 begin var x:=ReadlnString('Введите слово Х:'); var y:=ReadlnString('Введите слово Y:'); var Good:=True; for var i:=1 to y.Length do begin var p:=Pos(y[i],x); if p>0 then Delete(x,p,1) else begin Good:=False; Break end end; if Good then Writeln('Можно составить ',y) else Writeln('Нельзя составить ',y) end.
Тестовое решение: Введите слово Х: образование Введите слово Y: название Нельзя составить название
Введите слово Х: образование Введите слово Y: барон Можно составить барон
procedure maxs(ar:ty;var max,maxi:integer); Var i:integer; begin for i:=1 to n do if max<ara[i] then begin maxi:=i; max:=ar[i]; end; end;
begin randomize; max:=-1; writeln('Array A:'); for i:=1 to n do begin ara[i]:=random(100); write(ara[i]:4); end; maxs(ara,max,maxia); writeln; max:=-1; writeln('Array B:'); for i:=1 to n do begin arb[i]:=random(100); write(arb[i]:4); end; maxs(arb,max,maxib); j:=ara[maxia]; ara[maxia]:=arb[maxib]; arb[maxib]:=j; writeln; writeln('Final array A:'); for i:=1 to n do write(ara[i]:4); writeln; writeln('Final array B:'); for i:=1 to n do write(arb[i]:4); end.
//Двумерные Const n=10;
Type ty=array[1..n,1..n] of integer;
Var ara,arb:ty; i,j,max,maxia,maxib,maxja,maxjb:integer;
procedure maxs(ar:ty;var max,maxi,maxj:integer); Var i,j:integer; begin for i:=1 to n do for j:=1 to n do if max<ara[i,j] then begin maxi:=i; maxj:=j; max:=ar[i,j]; end; end;
begin randomize; max:=-1; writeln('Matrix A:'); for i:=1 to n do begin writeln; for j:=1 to n do begin; ara[i,j]:=random(100); write(ara[i,j]:4); end; end; maxs(ara,max,maxia,maxja); writeln; max:=-1; writeln('Matrix B:'); for i:=1 to n do begin writeln; for j:=1 to n do begin; arb[i,j]:=random(100); write(arb[i,j]:4); end; end; maxs(arb,max,maxib,maxjb); j:=ara[maxia,maxja]; ara[maxia,maxja]:=arb[maxib,maxjb]; arb[maxib,maxjb]:=j; writeln; writeln('Final matrix A:'); for i:=1 to n do begin writeln; for j:=1 to n do write(ara[i,j]:4); end; writeln; writeln('Final matrix B:'); for i:=1 to n do begin writeln; for j:=1 to n do write(arb[i,j]:4); end; end.
begin
var x:=ReadlnString('Введите слово Х:');
var y:=ReadlnString('Введите слово Y:');
var Good:=True;
for var i:=1 to y.Length do begin
var p:=Pos(y[i],x);
if p>0 then Delete(x,p,1)
else begin Good:=False; Break end
end;
if Good then
Writeln('Можно составить ',y)
else
Writeln('Нельзя составить ',y)
end.
Тестовое решение:
Введите слово Х: образование
Введите слово Y: название
Нельзя составить название
Введите слово Х: образование
Введите слово Y: барон
Можно составить барон
//Одномерные
Const
n=10;
Type
ty=array[1..n] of integer;
Var
ara,arb:ty;
i,j,max,maxia,maxib:integer;
procedure maxs(ar:ty;var max,maxi:integer);
Var
i:integer;
begin
for i:=1 to n do
if max<ara[i] then
begin
maxi:=i;
max:=ar[i];
end;
end;
begin
randomize;
max:=-1;
writeln('Array A:');
for i:=1 to n do
begin
ara[i]:=random(100);
write(ara[i]:4);
end;
maxs(ara,max,maxia);
writeln;
max:=-1;
writeln('Array B:');
for i:=1 to n do
begin
arb[i]:=random(100);
write(arb[i]:4);
end;
maxs(arb,max,maxib);
j:=ara[maxia];
ara[maxia]:=arb[maxib];
arb[maxib]:=j;
writeln;
writeln('Final array A:');
for i:=1 to n do
write(ara[i]:4);
writeln;
writeln('Final array B:');
for i:=1 to n do
write(arb[i]:4);
end.
//Двумерные
Const
n=10;
Type
ty=array[1..n,1..n] of integer;
Var
ara,arb:ty;
i,j,max,maxia,maxib,maxja,maxjb:integer;
procedure maxs(ar:ty;var max,maxi,maxj:integer);
Var
i,j:integer;
begin
for i:=1 to n do
for j:=1 to n do
if max<ara[i,j] then
begin
maxi:=i;
maxj:=j;
max:=ar[i,j];
end;
end;
begin
randomize;
max:=-1;
writeln('Matrix A:');
for i:=1 to n do
begin
writeln;
for j:=1 to n do
begin;
ara[i,j]:=random(100);
write(ara[i,j]:4);
end;
end;
maxs(ara,max,maxia,maxja);
writeln;
max:=-1;
writeln('Matrix B:');
for i:=1 to n do
begin
writeln;
for j:=1 to n do
begin;
arb[i,j]:=random(100);
write(arb[i,j]:4);
end;
end;
maxs(arb,max,maxib,maxjb);
j:=ara[maxia,maxja];
ara[maxia,maxja]:=arb[maxib,maxjb];
arb[maxib,maxjb]:=j;
writeln;
writeln('Final matrix A:');
for i:=1 to n do
begin
writeln;
for j:=1 to n do
write(ara[i,j]:4);
end;
writeln;
writeln('Final matrix B:');
for i:=1 to n do
begin
writeln;
for j:=1 to n do
write(arb[i,j]:4);
end;
end.
Пример работы(одномерный):
Array A:
11 83 41 30 0 23 14 41 93 66
Array B:
53 40 58 40 56 17 98 33 90 6
Final array A:
11 83 41 30 0 23 14 41 90 66
Final array B:
53 40 58 40 56 17 98 33 93 6