Нужно доделать задачу на цыкл... Опции

[Димас]

Модеры извините если что не так я новичёк,на форуме первый ра з, Школьник 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. 


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

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 надо
Общем помогите пожалуйста!
Я могу вам сказать человеческое спасибо.... и отдать всё что уменя есть на вебмани колельке, а это 97 центов...
Заранее СПасиБо!

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

Сообщение отредактировано: Димас - 24.12.2006 12:07

[volvo]

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

...
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 числа...

[Димас]

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

[Димас]

Тогда поехали дальше:
Задача 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.

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

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

Сообщение отредактировано: Димас - 24.12.2006 13:56

[mamont001]

Каждая буква ,цифра ,символ ,клавиша на клавиатуре имеет свой код. Так например у буквы А он равен 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.

Сообщение отредактировано: mamont001 - 24.12.2006 14:13

[Димас]

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

[мисс_граффити]

нафиг здесь извращения с 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.

Сообщение отредактировано: мисс_граффити - 24.12.2006 14:09

[volvo]

Как вариант:

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.

[Димас]

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

Задача 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. 

Но опять же учитель информатики сказал передалать как нибуть эту задачу, но не так как сделал это не могк понять что ему не нравится
Я подругому не могу разрулить эту задачку

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



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

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

[Димас]

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

[мисс_граффити]

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

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