Модеры извините если что не так я новичёк,на форуме первый ра з, Школьник 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);
Проще было бы подойти к проблеме с обратной стороны:
...
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);
...
Спасиба!!!!!!!!!!!! Работает как часы и проще код чем мой, со строками......
Тогда поехали дальше:
Задача 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.
Каждая буква ,цифра ,символ ,клавиша на клавиатуре имеет свой код. Так например у буквы А он равен 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.
Да вот и я о том же сижу голову ламаю , но пока глухо.... книжку листаю ..... надо задачу вообще переделать но как это вопрос слождный во всяком случаи для меня....
нафиг здесь извращения с 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.
Как вариант:
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.
Спасибо Мужики!!!!! и ещё на закуску и засыпку последняя задача:
Дано двух мерный массив целых чисел, модифицировать его элементы, как описано ниже, и вывести на экран по строкам.
а.) Ко всем четным элементам массива прибавить первый элемент соответствующей строки.
б.) Все элементы массива , оканчиваются цифрой 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.
Мда, как говорится надежда умерает последней