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

[brut03]

Вот они:

1) В заданной последовательности определить максимальное количество подряд идущих положительных чисел. (Без использования массива)

2) Дано натуральное число N (N>9) определить количество нулей в цифровой записи числа, кроме нулей в младших разрядах. Пример: N=10025000 - количество нулей = 2.

3) На отрезке [2;n] найти все натуральные числа, сумма цифр которых при умножении числа на А не изменится.

4) Определить наименьший элемент каждой четной строки матрицы А размера [M;N].

5) Дана квадратичная матрица порядка М. Повернуть ее на
а) 90; б) 180; в) 270 градусов в положительном направлении.

6) На отрезке [100;N] ((2^10)<N<(2^31)) найти количество чисел, составленных из цифр a, b, c.

7) Составить программу перевода данного натурального числа в р- ичную систему счисления. (2<=p<=9)


Помогите пожалуйста, если не сложно.
Заранее благодарен!

Сообщение отредактировано: brut03 - 20.04.2004 20:39

[Poison]

1.

Код

Program One;
var ...
begin
for i:=1 to n do
b[i]:=0;
for i:=1 to n do
if A[i]>0 then k:=k+1 else begin
b[i]:=k;
k:=0;
end;
max:=B[1];
for i:=1 to n do
if B[i]>max then max:=B[i];

[Altair]

6.

Код

var
s:string;
i:byte;
o,z:byte;
begin
writeln('введите строку');
readln(s);
for i:=1 to ORD(s[0]) do
begin
  If s[i]='(' then inc(o);
  If s[i]=')' then inc(z)
end;
If o>z then writeln('открывающихся больше');
If o<z then writeln('закрывающихся больше');
If z=o then writeln('скобки расставленны правильно');
end.

[fms]

1.

Код

Program odin;
var a:array[1..n] of integer;
fl:bolean;
i,max,kol:integer;
begin
for i:=1 to n do
read(a[i]);
max:=0;
for i:=1 to n do
begin   if a[i]>0 then
    kol:=kol+1; fl:=true
  else if fl=true and a[i]<0 then
  begin  
    fl:=false;
  if kol>max then
   max:=kol;
  kol:=0;
end;
end;
write(max)
end.

что то вроде. могут быть ошибки.

[fms]

4.

Код

program chetyre;
var a:array[1,n] of integer;
begin
i:=2;
min:=a[2,1];
while j<>m do
begin
for i:=1 to n do
begin
if a[j,i]<min then
min:=a[j,i]
end;
j:=j+2;
write(min);
min:=a[j,1];
end;
end.

вроде так..

[fms]

2.

Код

program dva;
var s,kol,k:integer;
fl:boolean;
begin
kol:=0;
while s div 10 <>0 do
begin
k:=s mod 10;
if k<>0 and fl=false then
fl:=true
else if k=0 and fl=true then
kol:=kol+1;
s:=s div 10;
end;
write(kol);
end.

что то вроде..

[Altair]

1. БЕЗ МАССИВА

Код

uses crt;
var
i:integer; {ўў®¤Ё¬®Ґ зЁб«®}
ip:boolean; {Ўл«® -«Ё ЇаҐ¤л¤г饥 зЁ«® Ї®«®¦Ёв.}
ke:integer; {бзҐвзЁЄ, ­г¦Ґ­ ¤«п Ї®¤бзҐв  Ї®б«Ґ¤®ў.}
max:integer; {ЁбЄ®¬®Ґ зЁб«®}
{Ёв®Ј® 7 Ў ©в Ї ¬пвЁ ­  ЇҐаҐ¬Ґ­­лҐ :-) -¬ иЁ­  ­Ґ ўл¤Ґа¦Ёв!}
begin
{®зЁй Ґ¬ нЄа ­}
clrscr;
repeat
  {ўў®¤Ё¬ зЁб«®}
  read(i);
  { Ґб«Ё ЇаҐ¤л¤г饥 зЁб«® Ї®«®¦ЁвҐ«м­®Ґ, ⮠㢥«ЁзЁў Ґ¬ бзҐвзЁЄ}
  if ip=true then inc(ke);
  {Ґб«Ё ўўҐ¤Ґ­®Ґ зЁб«® Ї®«®¦ЁвҐ«м­®, в® ip:=true }
  If i>0 then ip:=true;
  {Ґб«Ё ўўҐ¤Ґ­® зЁб«® ®ваЁж.   ЇаҐ¤. Ўл«® Ї®«®¦ЁвҐ«м­®, в®...}
  If (i<=0) and (ip=true) then
  begin
   {Ґб«Ё бзҐвзЁЄ Ў®«миҐ ¬ Єб. бзҐвзЁЄ , в® ®Ў­®ў«пҐ¬ ¬ Єб.}
   if ke>max then max:=ke;
   {бЎа®б бзҐвзЁЄ }
   ke:=0;
   {Ґб«Ё нв® 0, ⮠㬥­миЁвм ¬ Єб. в.Є. Ї®б«Ґ¤­ҐҐ зЁб«® ­Ґ бзЁв Ґвбп Ї®б«Ґ¤®ў.}
   If i=0 then dec(max);
  end
until i=0;
writeln('max=',max);
readln;
end.
P.S.
в®з­®  ­Ґ §­ о, з⮠ᤥ« вм ¤® repeat ,­ҐЇа ўЁ«м­л© Ї®¤бзҐв Ё¤Ґв, Ґб«Ё
б ¬ п ¤«Ё­­ п Ї®б«Ґ¤®ў вҐм­®бвм Џ…ђ‚Ђџ, ­ ЇаЁбҐа 1 2 3 -4 3 4
в®Ј¤  ®вўҐв ­  1 ¬Ґ­миҐ, в.Є. ў ­ з «Ґ ip = false!
P.S.2
Ї®б«Ґ END. ¬®¦­® ЇЁб вм ‚‘…, —’Ћ “ѓЋ„ЌЋ, Є®¬ЇЁ«пв®а ­Ґ зЁв Ґв ¤ «миҐ,
  в Є зв® ­Ґ ЇгЈ ©вҐбм :-)

[fms]

2.
я так понимаю что для типа integer это число слишком большое.. поэтому можно так:

Код

program dva;
var s,kol,k:real;
fl:boolean;
begin
write('vvedyte: ');
read(s);
kol:=0;
while (trunc(s) div 10)<>0 do
begin
k:=trunc(s) mod 10;
if (k<>0) and (fl=false) then
fl:=true
else if (k=0) and (fl=true) then
kol:=kol+1;
s:=trunc(s) div 10;
end;
write(kol:5:0);
end.

так вроде работает правильно..

_____
а ты сам пробовал решить? хоть что нибудь? а?

[Atos]

6.
{Предполагаем, что введённые цифры a,b,c различны}

Код

var m,n,sum :longint;
    a,b,c,i,t,zero,tmp,tmp2,tmp3: byte;

function Stepen(p,q:byte):longint;
var i:byte;
    st:longint;
begin
st:=p;
if q=0 then st:=1 else for i:=1 to q-1 do st:=st*p;
Stepen:=st;
end;

begin
readln(a,b,c);
readln(n);
zero:=ord((a=0)or(b=0)or(c=0));
t:=0;
sum:=0;
tmp2:=1;
m:=n;
repeat  m:=m div 10; inc(t); until m=0;
for i:=t-1 downto 0 do
    begin
    tmp:=(n div stepen(10,i))mod 10;
    tmp3:=(ord(a<tmp)+ord(b<tmp)+ord(c<tmp)-ord(i=t-1)*zero);
    if not((a=tmp)or(b=tmp)or(c=tmp)) then
       begin
       sum:=sum+tmp2*tmp3*stepen(3,i);
       break;
       end;
    tmp2:=tmp2*(tmp3+1);
    if i=0 then sum:=sum+tmp2;
    end;
for i:=3 to t-1 do sum:=sum+stepen(3,i);
writeln(sum);
readln;
end.

Проверял на нескольких трёхзначных числах. На всякий случай надо ещё проверить.

[fms]

3.

Код

program tri;
var
a,s,s2,k,k2,i,sum,sum2,n:integer;
begin
write('vvedyte A: ');
read(a);
write('vvedyte n: ');
read(n);
for i:=2 to n do
begin
s:=i;
s2:=i;
while s<>0 do
begin
k:=s mod 10;
sum:=sum+k;
s:=s div 10;
end;
s2:=s2*a;
while s2<>0 do
begin
k2:=s2 mod 10;
sum2:=sum2+k2;
s2:=s2 div 10;
end;
if sum=sum2 then
write(i,'_');
sum:=0;
sum2:=0;
end;
end.

brut03, и в чем же именно у тебя возникали вопросы?

4 не проверяла, но скорее всего из за того, что я неправильно описала массив должно быть a: array [1..n] of integer; возможно, в этом.. ты бы еще писал какая конкретно ошибка.. ;)

[Spawn]

1.
Еще один вариант первой задачи:

Код

program one(input,output);
var i,y,max : integer;
begin
  i := 0; max := 0;
  while not eof do
  begin
    read(y);
    if (y>0) then i := i + 1
    else
    begin
      if (i>max) then max := i;
      i := 0;
    end;
  end;
  writeln(max);
end.

[Spawn]

4.

Код

program four(input,output);
var A : array[1..M,1..N] of integer;
  i,j,min : integer;
begin
  for i := 1 to M div 2 do
  begin
    min := A[2*i,1];
    for j := 1 to N do
      if (A[2*i,j]<min) then min := A[2*i,j];
    writeln('Минимальный элемент в ',2*i,'- ой строке равен ',min);
  end;
end.

Сообщение отредактировано: volvo - 9.11.2006 1:55

[Altair]

7.
(я же сказал, читаем FAQ!!!!!!!!!!!!!! )

Вот две процедуры. Одна переводит из любой системы счисления в
десятичную, вторая наоборот

Код

function FromDec(n, radix:longint):string;
{перевод числа n из radix c/c в 10-ую}
var
s: String;
const
digit: string[16]='0123456789ABCDEF';
begin
s:='';
repeat
s:=digit[(n mod radix)+1]+s;
n:=n div radix;
until n=0;
FromDec:=s;
end;

function ToDec(n:string; radix:longint):longint; {перевод числа n из
10-ной с/с в radix}
var
m, i: longint;
const
digit: string[16]='0123456789ABCDEF';
begin
m:=0;
while n[1]='0' do delete(n,1,1);
for i:=1 to length(n) do m:=m*radix+pos(n[i],digit)-1;
ToDec:=m;
end;

Как вставить в прогу надеюсь разберетесь?

[Александр]

помогите мне пожалуйста в решении следующих задач

1.Найти первую цифру числа.(While)
2.Найти количество чётных цифр числа(repeat)
3.В одномерном массиве найти минимальный элемент массива и его номер.
4.В одномерном массиве найти сумму положительных элементов массива.
5.В одномерном массиве определить есть ли в данном массиве 2 соседних положительных элемента.Нати индексы первой пары.
6.Дан массив целых чисел размерностью(N*M).Найти количество чётных и нечётных элементов массива.
7.Дан массив целых чисел размерностью(N*M).Отсортировать элементы массива в каждом столбце по возрастанию.

[Altair]

1.
(а это совпадение, что у вас тоже 7 задач, или вы не все написали? )

Код

var
i:integer;
begin
readln(i);
while i>10 do  i:=i div 10;
writeln(i);
end.

[Altair]

2.

Код

var
i,j,k:integer;
begin
readln(i);
repeat
J:=i mod 10;
I:= i DIV 10;
If j mod 2=0 then inc(k);
until i<10;
writeln(k);
end.

[Altair]

3.

Код

const MaxN=100;
var
a:array[1..MaxN] of integer;
i,ke,max,min,mn: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 max<a[i] then max:=a[i]; min:=max;
for i:=1 to ke do if min>a[i] then begin min:=a[i]; mn:=i end;
write('minimal element=',min);
write('nomer=',mn);
end;

P.S.
Я все проги пишу прямо в ответе, поэтому проверьте, могут быть синтакические ошибки (да избавит нас учебник от семантических!!!)

[Altair]

4.

Код

const MaxN=100;
var
a:array[1..MaxN] of integer;
i,ke,SUMM: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 then SUMM:=SUMM+a[i];
writeln(summ);
end.

---------
P.S.
Все проги конечно НЕ оптимизированны. Это не нужно на таких задачах.

[Guest]

спасибо за составленные задачи, просто мне тоже дали решать 7 задач.

[Guest]

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