Помогите решить задачи

[nice5531]

Помогите решить задачи

1. Составьте программу подсчёта всех натуральных чисел, меньших М, квадрат суммы цифр которых равен Х.
2. В заданном предложении найти самое короткое и самое длинное слова
3. Удалите строку, в которой находится элемент, кратный 3
4. Составьте программу меняющую местами элементы матрицы симметрично побочной диагонали
5. Вставить два элемента: первый – после всех элементов, больших данного числа Р, а второй – перед всеми элементами, большими данного числа Р (Р вводить с клавиатуры).

 

[Gruvi]

:telepat:Язык программирования?

 

[nice5531]

TurboPascal

 

[Léon1]

2. В заданном предложении найти самое короткое и самое длинное слова

uses crt;
const rz=[' ','.',',','?','!'];
var s,s1,s2,s3:string;
    sk,sd:string;
    k,d,i,ik,id,j,p:byte;
begin
clrscr;
writeln('Введите строку из слов, отделенных разделителями:');
readln(s);
i:=1;
d:=0;id:=1;{длина длинного слова и его начало в строке}
k:=255;ik:=1;{длина корткого слова и его начало в строке}
while i<=length(s) do
if not(s[i] in rz) then
begin
  s1:='';{будем составлять слово}
  j:=i;
  p:=0;
  while not(s[j] in rz)and(j<=length(s)) do
   begin
    s1:=s1+s[j];
    j:=j+1;
    p:=p+1;
   end;
  if length(s1)<k then{если меньше короткого}
   begin
    sk:=s1;{это короткое}
    k:=length(s1);{его длина}
    ik:=i;{начало в строке}
   end;
  if length(s1)>d then{то же с длинным}
   begin
    sd:=s1;
    d:=length(s1);
    id:=i;
   end;
  i:=i+p;
end
else i:=i+1;
writeln('Самое короткое слово ',sk);
writeln('Самое длинное слово ',sd);
if ik<id then{если короткое раньше}
begin
  insert(sk,s,id);{вставляем короткое перед длинным}
  delete(s,id+k,d);{удаляем длинное}
  insert(sd,s,ik);{вставляем длинное на старое место короткого}
  delete(s,ik+d,k);{удаляем короткое}
end
else{если длинное раньше, то все наоборот}
   begin
    insert(sd,s,ik);
    delete(s,ik+d,k);
    insert(sk,s,id);
    delete(s,id+k,d);
   end;
write(s);
readln
end.

4. Составьте программу меняющую местами элементы матрицы симметрично побочной диагонали

program matrix;
uses crt;
var n: BYTE;
    A: array[0..10, 0..10] of Integer;
    i, j: BYTE;
    num: Integer;
 
begin
    clrscr;
    writeln('Vvedite n');
    read(n);
    writeln('vvedite matricy');
    for i:= 0 to n-1 do begin
      for j:= 0 to n-1 do begin
        gotoxy((j+1)*5, 5+i);
        read(A[i, j]);
      end;
    end;
    for i:= 0 to n-1 do
      for j:= 0 to n-1 do
        if (j < n-i) then begin
            num:= A[i, j];
            A[i, j]:= A[n-j-1, n-i-1];
            A[n-j-1, n-i-1]:= num;
        end;
    for i:= 0 to n-1 do begin
      for j:= 0 to n-1 do begin
        gotoxy((j+1)*5, 7+i+n);
        write(A[i, j]);
      end;
    end;
    readkey;
end.

 

[Léon1]

5. Вставить два элемента: первый – после всех элементов, больших данного числа Р, а второй – перед всеми элементами, большими данного числа Р (Р вводить с клавиатуры).

uses crt;
const nmax=50;
type myarray=array[1..nmax] of integer;
var n:byte;
procedure init2 (var n:byte; var m:myarray);
var i:integer;
begin
n:=25;
for i:=1 to n do
m[i]:=Random(111)-35;
end;
procedure print1 (n:integer; var m:myarray);
var i:integer;
begin
for i:=1 to n do
write(m[i]:4);
writeln;
end;
procedure vstavka(var n:byte; var m:myarray; a,k1,k2:integer);
var i,j:byte;
begin
i:=1;
while i<=n do
if m[i]>a then
begin
n:=n+1;
for j:=n downto i+2 do
m[j]:=m[j-1];
m[i+1]:=k1;
n:=n+1;
for j:=n downto i+1 do
m[j]:=m[j-1];
m[i]:=k2;
i:=i+3;
end
else i:=i+1;
end;
var a:myarray; P,k1,k2,k:integer;
begin
Randomize;
init2(n,a);
print1(n,a);
write('Vvedite chislo dlya sravnenia P=');
readln(P);
write('Vvedite chislo dlya vstavki posle bolshih ',P,' k1=');
readln(k1);
write('Vvedite chislo dlya vstavki pered kratnumi P k2=');
readln(k2);
vstavka(n,a,P,k1,k2);
writeln('Vstavka chisel po ysloviu:');
print1(n,a);
end.

 

[Léon1]

3. Удалите строку, в которой находится элемент, кратный 3

const nmax=20;
Type myarray=array [1..nmax]of integer;
Procedure init2(var n1:integer;var x:myarray);
var i:integer;
begin
repeat
write('Размер массива до ',nmax,' n=');
readln(n1);
until n1 in [1..nmax];
for i:=1 to n1 do
x[i]:=random(10);
end;
Procedure print1(n1:integer;x:myarray);
var i:integer;
begin
for i:=1 to n1 do
write(x[i]:3);
writeln;
end;
Procedure Delete(var n1:Integer;Var m:myarray);
Var i,j:Integer;
Begin
i:=1;
while i<=n1 do
if m[i] mod 3=0 then
 begin
  if i=n1 then n1:=n1-1
  else
   begin
    for j:=i to n1-1 do
    m[j]:=m[j+1];
    n1:=n1-1;
   end;
 end
else i:=i+1;
end;
var a:myarray;
    n:integer;
Begin
Randomize;
Init2(n,A);
writeln('Исходный массив');
Print1(n,A);
Delete(n,a);
writeln('Удаление кратных 3');
print1(n,a);
end.