IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

2 страниц V  1 2 >  
 Ответить  Открыть новую тему 
> Решаем не сложные задачи на разные темы., задачи на циклы, массивы, строки.
сообщение
Сообщение #1





Группа: Пользователи
Сообщений: 9

Репутация: -  0  +


Вот они: unsure.gif

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)


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

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


--------------------
Бывает в жизни так хреново
Что даже чай не лезит в глотку
А лезит в глотку только пиво
Которым запиваеш водку
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Новичок
*

Группа: Пользователи
Сообщений: 18
Пол: Женский

Репутация: -  0  +


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];


--------------------
Смотри ушами, а слушай глазами
---------------------------------------
Делай добро там, где оно принесет больше пользы
Кен Кизи
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Ищущий истину
******

Группа: Пользователи
Сообщений: 4 825
Пол: Мужской
Реальное имя: Олег

Репутация: -  45  +


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.


--------------------
Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Бывалый
***

Группа: Пользователи
Сообщений: 195
Пол: Женский

Репутация: -  0  +


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.


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


--------------------
непонимающая..
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Бывалый
***

Группа: Пользователи
Сообщений: 195
Пол: Женский

Репутация: -  0  +


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.


вроде так..


--------------------
непонимающая..
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Бывалый
***

Группа: Пользователи
Сообщений: 195
Пол: Женский

Репутация: -  0  +


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.


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


--------------------
непонимающая..
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Ищущий истину
******

Группа: Пользователи
Сообщений: 4 825
Пол: Мужской
Реальное имя: Олег

Репутация: -  45  +


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. ¬®¦­® ЇЁб вм ‚‘…, —’Ћ “ѓЋ„ЌЋ, Є®¬ЇЁ«пв®а ­Ґ зЁв Ґв ¤ «миҐ,
  в Є зв® ­Ґ ЇгЈ ©вҐбм :-)


--------------------
Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Бывалый
***

Группа: Пользователи
Сообщений: 195
Пол: Женский

Репутация: -  0  +


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.


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

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


--------------------
непонимающая..
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Прогрессор
****

Группа: Пользователи
Сообщений: 602
Пол: Мужской
Реальное имя: Михаил

Репутация: -  9  +


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.

Проверял на нескольких трёхзначных числах. На всякий случай надо ещё проверить.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


Бывалый
***

Группа: Пользователи
Сообщений: 195
Пол: Женский

Репутация: -  0  +


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; возможно, в этом.. ты бы еще писал какая конкретно ошибка.. ;)


--------------------
непонимающая..
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #11





Группа: Пользователи
Сообщений: 9

Репутация: -  0  +


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.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #12





Группа: Пользователи
Сообщений: 9

Репутация: -  0  +


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 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #13


Ищущий истину
******

Группа: Пользователи
Сообщений: 4 825
Пол: Мужской
Реальное имя: Олег

Репутация: -  45  +


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

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

Код
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;

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


--------------------
Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #14


Гость






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

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


Ищущий истину
******

Группа: Пользователи
Сообщений: 4 825
Пол: Мужской
Реальное имя: Олег

Репутация: -  45  +


1.
(а это совпадение, что у вас тоже 7 задач, или вы не все написали? )
Код
var
i:integer;
begin
readln(i);
while i>10 do  i:=i div 10;
writeln(i);
end.


--------------------
Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #16


Ищущий истину
******

Группа: Пользователи
Сообщений: 4 825
Пол: Мужской
Реальное имя: Олег

Репутация: -  45  +


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.


--------------------
Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #17


Ищущий истину
******

Группа: Пользователи
Сообщений: 4 825
Пол: Мужской
Реальное имя: Олег

Репутация: -  45  +


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.
Я все проги пишу прямо в ответе, поэтому проверьте, могут быть синтакические ошибки (да избавит нас учебник от семантических!!!)


--------------------
Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #18


Ищущий истину
******

Группа: Пользователи
Сообщений: 4 825
Пол: Мужской
Реальное имя: Олег

Репутация: -  45  +


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.
Все проги конечно НЕ оптимизированны. Это не нужно на таких задачах.


--------------------
Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #19


Гость






спасибо за составленные задачи, просто мне тоже дали решать 7 задач.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #20


Гость






а остальные сможете решить?
 К началу страницы 
+ Ответить 

2 страниц V  1 2 >
 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 20.09.2020 3:06
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name