Решаем не сложные задачи на разные темы., задачи на циклы, массивы, строки. |
1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!
Решаем не сложные задачи на разные темы., задачи на циклы, массивы, строки. |
brut03 |
Сообщение
#1
|
Группа: Пользователи Сообщений: 9 Репутация: 0 |
Вот они:
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 - -------------------- Бывает в жизни так хреново
Что даже чай не лезит в глотку А лезит в глотку только пиво Которым запиваеш водку |
Poison |
Сообщение
#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]; -------------------- Смотри ушами, а слушай глазами
--------------------------------------- Делай добро там, где оно принесет больше пользы Кен Кизи |
Altair |
Сообщение
#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. -------------------- Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С) |
fms |
Сообщение
#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. что то вроде. могут быть ошибки. -------------------- непонимающая..
|
fms |
Сообщение
#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. вроде так.. -------------------- непонимающая..
|
fms |
Сообщение
#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. что то вроде.. -------------------- непонимающая..
|
Altair |
Сообщение
#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. ¬®¦® ЇЁб вм ‚‘…, —’Ћ “ѓЋ„ЌЋ, Є®¬ЇЁ«пв®а Ґ зЁв Ґв ¤ «миҐ, в Є зв® Ґ ЇгЈ ©вҐбм :-) -------------------- Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С) |
fms |
Сообщение
#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. так вроде работает правильно.. _____ а ты сам пробовал решить? хоть что нибудь? а? -------------------- непонимающая..
|
Atos |
Сообщение
#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. Проверял на нескольких трёхзначных числах. На всякий случай надо ещё проверить. |
fms |
Сообщение
#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; возможно, в этом.. ты бы еще писал какая конкретно ошибка.. ;) -------------------- непонимающая..
|
Spawn |
Сообщение
#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. |
Spawn |
Сообщение
#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 - |
Altair |
Сообщение
#13
|
Ищущий истину Группа: Пользователи Сообщений: 4 825 Пол: Мужской Реальное имя: Олег Репутация: 45 |
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; Как вставить в прогу надеюсь разберетесь? -------------------- Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С) |
Александр |
Сообщение
#14
|
Гость |
помогите мне пожалуйста в решении следующих задач
1.Найти первую цифру числа.(While) 2.Найти количество чётных цифр числа(repeat) 3.В одномерном массиве найти минимальный элемент массива и его номер. 4.В одномерном массиве найти сумму положительных элементов массива. 5.В одномерном массиве определить есть ли в данном массиве 2 соседних положительных элемента.Нати индексы первой пары. 6.Дан массив целых чисел размерностью(N*M).Найти количество чётных и нечётных элементов массива. 7.Дан массив целых чисел размерностью(N*M).Отсортировать элементы массива в каждом столбце по возрастанию. |
Altair |
Сообщение
#15
|
Ищущий истину Группа: Пользователи Сообщений: 4 825 Пол: Мужской Реальное имя: Олег Репутация: 45 |
1.
(а это совпадение, что у вас тоже 7 задач, или вы не все написали? ) Код var i:integer; begin readln(i); while i>10 do i:=i div 10; writeln(i); end. -------------------- Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С) |
Altair |
Сообщение
#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. -------------------- Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С) |
Altair |
Сообщение
#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. Я все проги пишу прямо в ответе, поэтому проверьте, могут быть синтакические ошибки (да избавит нас учебник от семантических!!!) -------------------- Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С) |
Altair |
Сообщение
#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. Все проги конечно НЕ оптимизированны. Это не нужно на таких задачах. -------------------- Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С) |
Guest |
Сообщение
#19
|
Гость |
спасибо за составленные задачи, просто мне тоже дали решать 7 задач.
|
Guest |
Сообщение
#20
|
Гость |
а остальные сможете решить?
|
Текстовая версия | 19.05.2024 21:54 |