Задачи на Pascal/Delphi (РЕШЕНИЕ)

[X-tender]

PapiruS

Во-первых, зачем? А во-вторых, что тяжело код из функции перенести в основной?

[PapiruS]

X-tender

просто мне нужна блок-схема, а функцию не надо тут испоьзовать

[X-tender]

PapiruS, ну перенеси код из функции в основной код и все...

[PapiruS]

PapiruS

что-то типа того(синтаксис паскаля не очень помню):

function dec_cnt(t:integer):integer;
var i:integer;
begin
i=1;
while (t>=10) do
begin
t:=t div 10;
inc(i);
end
result:=i;
end;

function n_dec(t,i:integer):integer;
var
j:integer;
begin
j=dec_cnt(t)+1-i;
while (j>=0)
begin
t:=t div 10;
dec(j);
end;
result:=t mod 10;
end;

var
i,k:integer;
begin
readln(k);
i=1;
while (k>dec_cnt(i)) do
begin
k:=k-dec_cnt(i);
inc(i);
end;

writeln("Result = ",n_dec(i,k));

ps. Написал для теста на перле и попытался перевести в паскаль, сорри если что-то не так. на перле:

use strict;

sub dec_cnt{
my $t=shift;
my $i=1;
while ($t>=10)
{
$t/=10;
$i++;
}
return $i;
}

sub n_dec
{
my $t=shift;
my $i=shift;
my $j=dec_cnt($t)+1-$i;
while (--$j)
{ $t/=10;}
return $t%10;
}

my $k=<>;
my $i=1;
while ($k>dec_cnt($i))
{
$k-=dec_cnt($i);
$i++;
}
print "Result=".n_dec($i,$k);

чета я набрал и нето он маленько находит:ввожу 4 выдает 21187

[X-tender]

PapiruS

покажи что набрал-то

[PapiruS]

X-tender

4

Result = 21188

[X-tender]

PapiruS, я код просил, а не вывод.

Вот абсолютно рабочий код:

function dec_cnt(t:integer):integer;
var i:integer;
begin
i:=1;
while (t>=10) do
begin
t:=t div 10;
inc(i);
end;
result:=i;
end;

function n_dec(t,i:integer):integer;
var
j:integer;
begin
j:=dec_cnt(t)+1-i;
while (j>1) do
begin
t:=t div 10;
dec(j);
end;
result:=t mod 10;
end;

var
i,k:integer;

begin
readln(k);
i:=1;
while (k>dec_cnt(i)) do
begin
k:=k-dec_cnt(i);
inc(i);
end;
writeln('Result = ',n_dec(i,k));
end.

[PapiruS]

PapiruS, я код просил, а не вывод.

Вот абсолютно рабочий код:

function dec_cnt(t:integer):integer;
var i:integer;
begin
i:=1;
while (t>=10) do
begin
t:=t div 10;
inc(i);
end;
result:=i;
end;

function n_dec(t,i:integer):integer;
var
j:integer;
begin
j:=dec_cnt(t)+1-i;
while (j>1) do
begin
t:=t div 10;
dec(j);
end;
result:=t mod 10;
end;

var
i,k:integer;

begin
readln(k);
i:=1;
while (k>dec_cnt(i)) do
begin
k:=k-dec_cnt(i);
inc(i);
end;
writeln('Result = ',n_dec(i,k));
end.

ты здесь result не объявил)

вот исправил но не работает

function dec_cnt(t:integer):integer;

var i,result:integer;

begin

i:=1;

while (t>=10) do

begin

t:=t div 10;

inc(i);

end;

result:=i;

end;

function n_dec(t,i:integer):integer;

var

j,result:integer;

begin

j:=dec_cnt(t)+1-i;

while (j>1) do

begin

t:=t div 10;

dec(j);

end;

result:=t mod 10;

end;

var

i,k:integer;

begin

readln(k);

i:=1;

while (k>dec_cnt(i)) do

begin

k:=k-dec_cnt(i);

inc(i);

end;

writeln('Result = ',n_dec(i,k));

end.

[X-tender]

PapiruS, у тебя турбопаскаль видимо. в дельфи result - это возвращаемое значение функцией. если так то замени result:= на название_функции:=. Вообще немного то хоть включай мозг.

[Vol89]

Помогите составить прогу которая бы:

Дан двумерный массив А[5;6], найти максимальный элемент массива, если таких элементов несколько, то выдать на экран местоположеие всех максимальных элементов.

Номер строки и столбца матрицы =- или -= номер в строке.

На основании этого кода: (хотя я его не правильно срисовал, поправлю).

var a:array[1..4,1..5] of integer; i,j:integer;

min; ns,nst:integer;

begin

for i:=1 to 4 do

for i:=1 to 5 do read(a[i,j]);

min:=a[1,1]; ns:=1; nst:=1;

for i:=1 to 4 do

for i:=1 to 5 do if a[i,j]

begin min:=a[i,j]; ns:=i; nst:=j;

end;

writeln('min=',min,'Stroka-',ns,'Stolbech-',nst);

end.

[X-tender]

Vol89

const m=5;n=6;
var a:array[1..m,1..n] of integer;
i,j,max:integer;
begin
max:=-32565;
for i:=1 to m do
	for i:=1 to n do
	 begin read(a[i,j]); if (maxwriteln('max=',max,':');

for i:=1 to m do
	for i:=1 to n do if (a[i,j]=max) then writeln(i,':',j);
end.

[Vol89]

X-tender

const m=5;n=6;

var a:array[1..5,1..6] of integer;

i,j,max:integer;

begin

max:=-32565;

for i:=1 to 5 do

for j:=1 to 6 do begin read(a[i,j]); if (max

writeln('max=',max,':');

for i:=1 to m do

for j:=1 to n do if (a[i,j]=max) then writeln('Stroka=',i,', ','Stolbech-',j);

end.

[X-tender]

Vol89

все конечно хорошо только зачем по твоему я const m=5;n=6; вставлял?

[Vol89]

Предположение, чтобы:

Автоматически строить таблицу? или для обнаружения требуемого числа.

[X-tender]

Vol89, эхъ... чтобы, если вдруг тебе понадобится изменить размеры массива, не менять везде 5 и 6 на новые размеры, а просто изменить эти константы...

[Vol89]

Оооо... Спасиб.

А мне чего же, сегодня сказал декан. Что значение max:=-32565, не до конца, вообщем, он сказал, что: - Я могу такие данные ввести с которыми твоя программа не справиться, из-за этой строки.

[X-tender]

Vol89, посмотри размерность integer и введи его минимальное значение вместо -32656. (вообще что-то я ошибся хотел по идее -32768 указать, т.к. там он кажется 16битный)

[Vol89]

Спасибо за ваши знания.

var s,s1,s2:string; i:byte;

begin

writeln('Введите строку');

readln(s);

s1:='Путин'; s2:='Медведев';

while pos('Путин',s)>0 do begin

i:=pos(s1,s);

delete(s,i,5);

insert(s2,s,i);

end;

writeln(s);

end.

А лозунг такой дал:

Путин жил, Путин жив, Путин будет жить.

Теперь другая задача стоит.

type stud=record

FIO,addres:string[30];

G_r,group:longint; Pol:char;

Phone:string[12];

end;

var st:stud; a:array[1..3] of stud;

i:integer;

Begin for i:=1 to 3 do Begin

writeln('Введите ФИО'); readln(a.FIO);

writeln('Введите Адрес');readln(a.addres);

writeln('Введите пол');readln(a.Pol);

writeln('Введите телефон');readln(a.Phone);

writeln('Введите год рождения, группу'); readln(a.G_r, a.group);

end;

writeln('Список студентов в ВУC');

for i:=1 to 3 do

if (a.Pol='м') and (2009-a.G_r<27) then

writeln(a.FIO:20,a.Addres:20,a.Phone:12);

End.

Дана строка символов, является ли она палиндромом, пример:

аргентина манит негра - что с права на лево, что лево-на право, одно и тоже.

Буква А - уже и есть палиндром.

На тему записи:

Данные о трёх студентах, выдать на экран, студентов женского рода старше 30-и лет.

Хотя я думаю можно и 5-х записать.

[Baimer]

дана строка символов, является ли она палиндромом, пример:

аргентина манит негра - что с права на лево, что лево-на право, одно и тоже.

Буква А - уже и есть палиндром

program palindrom;
var
 a:string;
 i,b:integer;
begin
b:=1;
readln(a);
for i:=1 to length(a) do
 if a[i]<>a[length(a) - i +1] then b:=0;
if b=0 then writeln ('net')
else writeln ('da');
end.

[Vol89]

Baimer

О большое спасибо.

[Baimer]

Vol89

program palindrom;
var
 a,c:string;
 i,b,n:integer;
begin
b:=1;
readln(a);
c:=a;
n:=0;
for i:=1 to length(a) do
 if a[i]=' ' then n:=n+1
 else c[i-n]:=a[i];
for i:=1 to length(c)-n do
 if c[i]<>c[length(с)-n -i +1] then b:=0;
if b=0 then writeln ('net')
else writeln ('da');
end.

Вот исправил, предыдущая программа с пробелами строки не определяла.

[Vol89]

Ва... Ва... Точно.

А я думаю что же ещё надо было добавить?

---

---

program Pioc;

type mas=array[1..5,1..7] of integer;

var a,b:mas; i,j,max:integer;

procedure vvod(var c:mas;k,l:integer);

begin for i:=1 to k do

for j:=1 to l do

c[i,j]:=random(99);

end;

procedure vyvod(c:mas;k,l:integer);

begin for i:=1 to k do Begin

for j:=1 to l do write(c[i,j]:4);

writeln;

end;

end;

procedure maximum(c:mas;k,l:integer);

begin max:=c[1,1];

for i:=1 to k do

for j:=1 to l do if a[i,j]>max then

begin max:=a[i,j];

end;

writeln('max=',max);

end;

begin

randomize;

vvod(A,4,7);

vvod(B,5,6);

writeln('Матрица А:');

vyvod(A,4,7);

writeln('Матрицу Б:');

Vyvod (B,5,6);

writeln;

writeln('max matr A');

maximum(A,4,7);

writeln('max matr B');

maximum(B,5,6);

end.

Написать программу для нахождения факториала числа.

|

> n!=1*2*3*4*5*...n;

5!=1*2*3*4*5=120

[SxLvn]

ак

[Галсан]

Помогите дорешить задачку:

Вставить в словах за каждой буквой "а" сочетание "мы"

вот код:

uses crt;
const y=1;
var a:array[1..y] of string;
i,j,z:integer;
begin
clrscr;
writeln('BBeguTe cJIoBo');
for i:=1 to y do
readln(a[i]);
clrscr;
for i:=1 to y do
write(a[i],' ');
writeln;
for i:=1 to y do
begin
z:=0;
repeat
z:=pos ('a',a[i]);
if z<>0 then
begin
insert ('MbI', a[i], z+1);
end;
until z>0;
end;
for i:=1 to y do
write(a[i],' ');
readkey;
end.

program zad;

[bayarookie]

Галсан

uses wincrt;
const y = 1;
var a: array[1..y] of string;
i, j: integer;
s: string;
begin
clrscr;
writeln('BBeguTe cJIoBo');
for i := 1 to y do
readln(a[i]);
for i := 1 to y do
begin
s := '';
for j := 1 to Length(a[i]) do
begin
s := s + a[i][j];
if a[i][j] = 'a' then
s := s + 'MbI';
end;
a[i] := s;
end;
for i := 1 to y do
write(a[i], ' ');
end.

program zad;