Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ Нужно доделать задачу на цыкл...

Автор: Димас 24.12.2006 16:10

Модеры извините если что не так я новичёк,на форуме первый ра wink.gif з, Школьник 11 клас..... общем проблемка такая:
Задача: Проверить существует ли четырех значное натуральное число, сума пятых степеней цифр которого ровна самому числу

Исходный код решения задачи:



Program z349;
uses crt;
var s:string;
i,kod,r:integer;
a1,a2,a3,a4:integer;
begin
ClrScr;
writeln('Begin...');
writeln;
for i:=1000 to 9999 do
begin
str(i,s);
val(s[1],a1,kod);
val(s[2],a2,kod);
val(s[3],a3,kod);
val(s[4],a4,kod);
r:=sqr(sqr(a1))*a1+sqr(sqr(a2))*a2+sqr(sqr(a3))*a3+sqr(sqr(a4))*a4;
if i=r then writeln(s);
end;
writeln;
write('End.');
readln;
end.



Но учитель информатики сказал что это правильно, но он не поставить мне за эту задачу оценку mad.gif , пока я не переделаю эти строки:


str(i,s);
val(s[1],a1,kod);
val(s[2],a2,kod);
val(s[3],a3,kod);
val(s[4],a4,kod);



Командами mod и div
Я знаю как найти первую цыфру: a1:=i div 1000;
а ещё 3 надоsad.gif
Общем помогите пожалуйста! smile.gif
Я могу вам сказать человеческое спасибо.... и отдать всё что уменя есть на вебмани колельке, а это 97 центов...
Заранее СПасиБо! smile.gif

А ксати мне все (21 задачи) задачи надо сделать до завтраsad.gif(( Кто поможет век не забуду good.gif ещё есть вопросы по 2 задачам но сперва помогите 1ю решить..... rolleyes.gif

Автор: volvo 24.12.2006 16:11

Проще было бы подойти к проблеме с обратной стороны:

...
for i1 := 1 to 9 do
for i2 := 0 to 9 do
for i3 := 0 to 9 do
for i4 := 0 to 9 do
if 1000*i1 + 100*i2 + 10*i3 + i4 = sqr(sqr(i1))*i1 + sqr(sqr(i2))*i2 + sqr(sqr(i3))*i3 + sqr(sqr(i4))*i4
then writeln(1000*i1 + 100*i2 + 10*i3 + i4);
...

Итого получим 2 числа...

Автор: Димас 24.12.2006 16:44

Спасиба!!!!!!!!!!!! Работает как часы и проще код чем мой, со строками...... good.gif

Автор: Димас 24.12.2006 17:28

Тогда поехали дальше:
Задача 1095:
Имеется строка, содержащая буквы латинского алфавита и цифры. Вывести на экран длину наибольшей последовательности цифр, идущих подряд.



Я написал так:


Program z1095;
uses crt;
type
rec = record
r1:string;
r2:integer;
end;
var s,s1:string;
r:rec;
x,i,a,kod,y:integer;
flag:boolean;
begin
r.r1:='';
r.r2:=0;
y:=0;
s1:='';
flag:=false;
ClrScr;
write('Vvedite stroky : ');
read(s);
x:=length(s);
for i:=1 to x do
begin
val(s[i],a,kod);
if kod=0 then
begin
flag:=true;
y:=y+1;
s1:=s1+s[i];
if i=x then
if y>r.r2 then
begin
r.r1:=s1;
r.r2:=y;
end;
end
else
if flag then
begin
if y>r.r2 then
begin
r.r1:=s1;
r.r2:=y;
end;
flag:=false;
y:=0;
s1:='';
end;
end;
write('Rezyltat : ',r.r1);
readln;
readln;
end.



Но опять же, учитель информатики сказал переделать задачу вообще всюsad.gif(( blink.gif
но из какой то функцией chr связано из таблицей ASCII Как бы это сделать? dry.gif

volvo. Куда центы слать за задачу?

Автор: mamont001 24.12.2006 18:02

Каждая буква ,цифра ,символ ,клавиша на клавиатуре имеет свой код. Так например у буквы А он равен 97.
CHR возвращает символ клавишы по номеру chr(n:byte):char;

вот прога для узнаваниея ascii-кода клавиши:


uses crt;
var b:integer;
e:char;
begin
clrscr;
b:=ord(readkey);
if b=0 then b:=ord(readkey);
writeln(b);
readln;
end.




uses crt;
var
s:string;
x,i,j,a,max:integer;
begin
max:=0;
write('iput string:'); readln(s);
x:=lenght(s);
for i:= 1 to lenght(s) do
begin
for j:=48 to 57 do
begin
if chr(j)=s[i] then inc(a);
if a>max then a:=max;
end;
for j:=97 to 122 do
if chr(j)=s[i] then a:=0;
end;
write(max);
readln
end.



Автор: Димас 24.12.2006 18:07

Да вот и я о том же сижу голову ламаю blink.gif , но пока глухо.... книжку листаю ..... надо задачу вообще переделать smile.gif но как это вопрос слождный во всяком случаи для меня....

Автор: мисс_граффити 24.12.2006 18:07

нафиг здесь извращения с char?
конечно, приделать его не проблема:

program cifry;
var i,max,tek:integer;
s:string;
begin
writeln('stroka?');
readln(s);
i:=1;
max:=0;
while i<=length(s) do
begin
tek:=0;
while (s[i]>chr(47)) and (s[i]<chr(58)) and (i<=length(s)) do {с тем же успехом можно было написать s[i]>'0'}
begin
inc(tek);
inc(i);
end;
if max<tek then
max:=tek;
while (s[i]<=chr(47)) or (s[i]>=chr(58)) and (i<=length(s)) do
inc(i);
end;
writeln(max);
end.

Автор: volvo 24.12.2006 18:28

Как вариант:

var
i, max, curr: integer;
s: string;
begin
write('stroka?'); readln(s);

s := s + ' ';
i :=1 ; max := 0; curr := 0;
while i <= length(s) do begin

if (s[i] in ['0' .. '9']) then inc(curr)
else begin
if max < curr then max := curr;
curr := 0;
end;
inc(i);

end;
writeln(max);
end.

Автор: Димас 24.12.2006 20:35

Спасибо Мужики!!!!! smile.gif и ещё на закуску и засыпку последняя задача:

Задача 986

Дано двух мерный массив целых чисел, модифицировать его элементы, как описано ниже, и вывести на экран по строкам.
а.) Ко всем четным элементам массива прибавить первый элемент соответствующей строки.
б.) Все элементы массива , оканчиваются цифрой 2, умножить на последний элемент соответствующего столбца.
в.) Ко всем положительным элементам массива прибавить последний элемент соответствующей строки, а к остальным – первый элемент такой же строки..
г.) Все элементы массива, индексов которых кратна пяти, заменить нулями.


Я таписал так:

Program z986;
uses crt;
var mas1,mas2:array[1..5,1..5] of integer;
i,j,a:integer;
s:string;
begin
ClrScr;
randomize;
for i:=1 to 5 do

for j:=1 to 5 do
mas1[i,j]:=random(100)-50;
mas2:=mas1;

for i:=1 to 5 do
begin

for j:=1 to 5 do
write(mas1[i,j],',');
writeln;
end;

writeln;
writeln('-----A-----');
for i:=1 to 5 do
begin
for j:=1 to 5 do
begin
if (mas2[i,j] mod 2)=0 then mas2[i,j]:=mas2[i,j]+mas2[i,1];
write(mas2[i,j],',');
end;
writeln;
end;
readln;
writeln('-----B-----');
mas2:=mas1;
for i:=1 to 5 do
begin
for j:=1 to 5 do
begin
str(mas2[i,j],s);
a:=length(s);
if s[a] = '2' then mas2[i,j]:=mas2[i,j]*mas2[5,j];
write(mas2[i,j],',');
end;
writeln;
end;
readln;
writeln('-----V-----');
mas2:=mas1;
for i:=1 to 5 do
begin
for j:=1 to 5 do
begin
if mas2[i,j]>=0 then mas2[i,j]:=mas2[i,j]+mas2[i,5]
else mas2[i,j]:=mas2[i,j]+mas2[i,1];
write(mas2[i,j],',');
end;
writeln;
end;
readln;
writeln('-----G-----');
mas2:=mas1;
for i:=1 to 5 do
begin
for j:=1 to 5 do
begin
if ((i mod 5)=0)or((j mod 5) =0) then mas2[i,j]:=0;
write(mas2[i,j],',');
end;
writeln;
end;
readln;
end.
Но опять же учитель информатики сказал передалать как нибуть эту задачу, но не так как сделал это wink.gif не могк понять что ему не нравится mad.gif
Я подругому не могу разрулить эту задачкуsad.gif

Помогайте в последний раз, добрые люди good.gif



Вся надежда только на вас уважаемые форумцы smile.gif smile.gif smile.gif

Потому что если я завтра не здам эту последнюю задачу он мне не поставит оценку, и табель соотвествено я не получу.....


Автор: Димас 24.12.2006 22:06

Мда, как говорится надежда умерает последней rolleyes.gif


Автор: мисс_граффити 24.12.2006 22:48

Цитата
Спасибо Мужики!!!!!

dry.gif

З.Ы. Сорри за флуд/оффтоп или как это классифицировать.