Решаем не сложные задачи на разные темы., задачи на циклы, массивы, строки. Опции

[Александр]

вот ещё задачка небольшая есть


1.В данном тексте удвоить вхождение некоторй буквы.

2.Дан текст, если длина текста чётное число , то удалить 2 средние буквы, если нечётное , то одну

Сообщение отредактировано: Oleg_Z - 24.04.2004 18:54

[Altair]

а остальные сможете решить?

Сможем!

... мне тоже дали решать 7 задач.

Надо же какое совпадение
---
Итак поехали

5.

Код

const MaxN=100;
var
a:array[1..MaxN] of integer;
i,ke:integer;
begin
repeat write('dlinna massiva:'); readln(ke) until ke<MaxN;
for i:=1 to ke do begin  write('a[',i,']='); readln(a[i]) end;
for i:=1 to ke do If (a[i]>0) and (a[i+1]>0) and (a[i+2]<=0)  then  
writeln(i,' and ',i+1)
end.

-------------------------------------
6.

Код

const
Nmax=20;
Mmax=20;
var
a:array[1..N,1..M] of integer;
i,j,n,m,chet,nechet:integer;
begin
write('n='); readln(n);
write('m='); readln(m);
{vvod matrizi}
for i:=1 to n do
for j:=1 to m do
begin
write('a[',i,',',j,]='); readln(a[i,j]) end;
{------}
for i:=1 to n do
for j:=1 to m do If a[i,j] mod 2=0 then inc(chet) else inc(nechet);
writeln('chetnie=',chet);
writeln('nechet=',nechet);
writeln('press ENTER ...');
readln
end.

Ух. Ну вот. Проверьте все это на предмет ошибок, а 7 я посмотрю сейчас, у меня помоему была где- то такая решенная.
---
процедурный вариант вас устроит? или обязательно линейную прогу?

[Altair]

Ну вот тогда:

Код

var
s:string;
c:char;
i:byte;
NEWs;
begin
writeln('Vvdedite TEXT');
readln(s);
wrieln('kakyu bykvy YDVOIT:');
readln©;
for i:=1 to ORD(s[0]) do
begin
  NEWs:=NEWs+s[i];
  If s[i]=c then NEWs:=NEWs+c
end;
{for i:=1 to (ord(s[0])+1) do NEWs:=NEWs+NEWs[i]; } {раскоментировать, если не будет работать}
writeln(NEWs);
end.

---
P.S. Сможете 2 задачу сами написать? Или помочь?

[Altair]

2. задача на строки

Код

Var
s,ns:string;
i:byte;
sr,sr1:byte;
begin
writeln('BBEDITE CTPOKY:');
readln(s);
If Ord(s[0]) mod 2 =0 then
begin
  sr:=Ord(s[0]) div 2;
  sr1:=sr+1;
  for i:=1 to ord(s[0]) do If (i<>sr) and (i<>sr1) then NS:=NS+s[i]
end else
begin
  sr:=(ORD(s[0]) div 2)+1;
  for i:=1 to ord(s[0]) do If i<>sr then NS:=NS+s[i]
end; {IF}
writeln(NS)
end.

[Altair]

7.

Код

const
n=15; m=15;
{ так выглядит матрица:
1,2,3,...n
2
3...
m
}
type
atype= array[1..n] of array[1..m] of integer;

var
ar:array[1..m] of integer;
a:atype;
nmax,mmax,i,j:integer;
{------------------}

procedure sort(var x:array of integer; left,rig:integer);
var l,r,a:integer;
begin
l:=left; r:=rig; a:=x[l];
repeat
  while (x[r]>=a) and (l<r) do r:=r-1;
  x[l]:=x[r];
  while (x[l]<=a) and (l<r) do l:=l+1;
  x[r]:=x[l]
until r=l;
x[l]:=a;
if left<l-1 then sort(x,left,l-1);
if r+1<rig then sort(x,r+1,rig)
end;
Procedure PRINT(a:atype; nmax,mmax:integer);
var i,j:integer;
begin
for i:=1 to nmax do
  begin
  for j:=1 to mmax do write(a[i,j]);
  writeln;
  end;
end;
{--------}
var k:integer;
Begin
write('K-BO CTPOK='); readln(mmax);
write('K-BO CTOLBZOB='); readln(nmax);
Writeln('POSTROCHNO VVEDITE MATRIZY');
for i:=1 to mmax do
for j:=1 to nmax do
begin
  write('a[',i,',',j,']=');
  readln(a[i,j])
end;
{------}
writeln;
print(a,mmax,nmax);
writeln;
{---------}
for i:=1 to nmax do
begin
  for j:=1 to mmax do ar[j]:=a[j,i];
  sort(ar,0,mmax-1);
  for j:=1 to mmax do a[j,i]:=ar[j];
end;
{--------}
writeln;
print(a,mmax,nmax);
readln
end.

[brut03]

;) У меня есть еще 3 не сложных задачи. ;)
Вот они:
1) Даны 2 последовательности а1, а2, . . . ,аn и b1, b2, ... , bm, где m<n.
В каждой из них члены различны. Верно ли, что все члены второй последовательности входят в первую?

2) Определить номера строк матрицы R [M,N], в которых хотя бы один элемент равен С. Умножить все элементы этих строк на D.

3) Упорядочить данный массив английских строк по алфавиту.

Сообщение отредактировано: brut03 - 3.05.2004 11:23