Перейти к содержанию

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


Рекомендуемые сообщения


var
i, j: integer;
s1: string;
begin
Result := '';
while (s <> '') do
begin
i := Pos(' ', s);
if (i > 0) then
begin
s1 := Copy(s, 1, i - 1);
Delete(s, 1, i);
end
else
begin
s1 := s;
s := '';
end;
j := Length(s1);
if (j > 1) then
Result := Result + Copy(s1, j div 2 + 1, Length(s1)) + Copy(s1, 1, j div 2)
else
Result := s1;
if (i > 0) then
Result := Result + ' ';
end;
end;
function myF(s: string): string;

это для дельфи

Чот пробовал подогнать, под паскль, но что то видимо пропустил, не работает.

Спс bayarookie.

Ссылка на комментарий

Помогите плиз срочно решить задачку, матрицу вообще забыл(

Дана действительная матрица размера M*N. Определить числа Х1,Х2,...,Хm, равные соответственно суммам наибольших и наименьших значений элементов строк.

Ссылка на комментарий


var
i, j: integer;
s1: string;
begin
Result := '';
while (s <> '') do
begin
i := Pos(' ', s);
if (i > 0) then
begin
s1 := Copy(s, 1, i - 1);
Delete(s, 1, i);
end
else
begin
s1 := s;
s := '';
end;
j := Length(s1);
if (j > 1) then
Result := Result + Copy(s1, j div 2 + 1, Length(s1)) + Copy(s1, 1, j div 2)
else
Result := s1;
if (i > 0) then
Result := Result + ' ';
end;
end;
function myF(s: string): string;

это для дельфи

Чот пробовал подогнать, под паскль, но что то видимо пропустил, не работает.

Спс bayarookie.

Паскаль:

program stroka;
uses crt;
var
i, j: integer;
s1,s,result: string;
begin
clrscr;
writeln('vvedite stroky');
readln(s);
Result := '';
while (s <> '') do
begin
i := Pos(' ', s);
if (i > 0) then
begin
s1 := Copy(s, 1, i - 1);
Delete(s, 1, i);
end
else
begin
s1 := s;
s := '';
end;
j := Length(s1);
if (j > 1) then
Result := Result + Copy(s1, j div 2 + 1, Length(s1)) + Copy(s1, 1, j div 2)
else
Result := s1;
if (i > 0) then
Result := Result + ' ';
end;
writeln(result);
readkey;
end.

Ссылка на комментарий

SxLvn

uses crt;

var i,j,n,m:integer;

a:array[1..20,1..20]of integer;

function min(i:integer):integer;

var j,w:integer;

begin

w:=a[i,1];

for j:=2 to m do if a[i,j]

min:=w;

end;

function max(i:integer):integer;

var j,w:integer;

begin

w:=a[i,1];

for j:=2 to m do if a[i,j]>w then w:=a[i,j];

max:=w;

end;

begin

clrscr;

write('N= ');readln(n);

write('M= ');readln(m);

randomize;

for i:=1 to n do

for j:=1 to m do

a[i,j]:=random(100);

for i:=1 to n do begin

for j:=1 to m do

write(a[i,j]:4);

writeln;

end;

for i:=1 to n do begin

writeln(min(i)+max(i));

end;

readkey;

end.

Добавлено спустя 16 минут 20 секунд:

Скиф

program D_Andre;

type Pere=array [1..10] of byte;

var N,i,j:byte;

X:Pere;

Yes:boolean;

procedure Next(var X:Pere;var Yes:boolean);

var i:byte;

procedure Swap(var a,b:byte); {обмен переменных}

var c:byte;

begin c:=a;a:=b;b:=c end;

begin

i:=N-1;

while (i>0)and(X>X[i+1]) do dec(i);

if i>0 then

begin

j:=i+1;

while (jX) do inc(j);

Swap(X,X[j]);

for j:=i+1 to (N+i) div 2 do Swap(X[j],X[N-j+i+1]);

Yes:=true

end

else Yes:=false

end;

function pro:boolean;

var i:integer;

f:boolean;

begin

f:=true;

for i:=1 to n-1 do

begin

if i mod 2=1 then

begin

if x>x[i+1] then f:=false;

end

else

begin

if x

end;

end;

pro:=f;

end;

begin

assign(input,'p.txt');

reset(input);

assign(output,'p_OUT.txt');

rewrite(output);

readln(n);

for i:=1 to N do X:=i;

repeat

if pro then begin for i:=1 to N do write(X);writeln;end;

Next(X,Yes)

until not Yes;

close(output);

end.

создаш файл "p.txt" туда запишеш 7.

Ссылка на комментарий


var
x, y, z: real;
i, j: integer;

begin
x := 0;
while x < 0.99998 do
begin
x := x + 0.00001;
y := x;
i := 1;
j := 1;
while true do
begin
i := i + 2;
j := j * -1;
z := Power(x, i) / i;
if z < 0.00001 then Break;
y := y + j * z;
end;
writeln(' x = ', x:1:5, ' y = ', y:6:4, ' = ', ArcTan(x):6:4);
end;
end.

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

спс за решение но мне надо для блок схемы,мб переделаешь?

Ссылка на комментарий

bayarookie

это кароче где в прямоугольничках да в овальчиках пишется алгоритм программы.

просто напиши решение мне на паскале но без функций там всяких и процедур. чтоб были простые условия да присваяивания

Ссылка на комментарий

PapiruS

вообщето она вот так решается=)

uses crt;

const e=0.00001;

var x,y,m:real;

i,k,l:integer;

begin

clrscr;

write('vvedite x= ');readln(x);

k:=1;

y:=0;

l:=0;

m:=x;

while m>e do begin

inc(l);

m:=x;

for i:=1 to k-1 do m:=m*x;

m:=m/k;

if l mod 2 =0 then y:=y+m else y:=y-m;

k:=k+2;

end;

writeln('Y= ',y:0:5);

writeln('arctan= ',arctan(x):0:6);

readkey;

end.

Ссылка на комментарий

Пожалуйста помогите мне решить задачу на паскале

Задача. День рождения.

заданы день и месяц рождения, а также текущие день, месяц и год. Определите, сколько дней осталось до дня рождения.

Примечание. Високосные годы - это те, которые делятся на 400, а также те, номер которых делится на 4, но не делится на 100.

Ограничения: год от 1920 до 3000, месяц - от 1 до 12, день - от 1 до числа дней в месяце.

Ссылка на комментарий

для дельфи просто:

var
y, m, d: word;
begin
DecodeDate(Now, y, m, d);
writeln('enter day and month');
readln(d, m);
writeln(Trunc(EncodeDate(y, m, d)) - Trunc(Now));

или нужно разработать код низкоуровневый?

Ссылка на комментарий

вот фигня же этот паскаль:



uses WinCrt;

var
d1, m1, y1, d2, m2, i, j, d3: word;
m3: array [1..12] of word;

begin
writeln('Enter current day month year');
readln(d1, m1, y1);
writeln('enter day and month of birthday');
readln(d2, m2);
m3[1] := 31;
if (m1 > m2) or ((m1 = m2) and (d1 > d2)) then
y1 := y1 + 1;
if (y1 div 4) = (y1 / 4) then
m3[2] := 29
else
m3[2] := 28;
m3[3] := 31;
m3[4] := 30;
m3[5] := 31;
m3[6] := 30;
m3[7] := 31;
m3[8] := 31;
m3[9] := 30;
m3[10] := 31;
m3[11] := 30;
m3[12] := 31;
if (m1 = m2) and (d1 <= d2) then
d3 := d2 - d1
else
begin
d3 := m3[m1] - d1;
for i := 1 to 12 do
begin
j := m1 + i;
if (j > 12) then
j := j - 12;
if (j = m2) then Break;
d3 := d3 + m3[j];
end;
d3 := d3 + d2;
end;
writeln('remaining days: ', d3);
end.
program den_r;

Добавлено спустя 4 минуты 55 секунд:

и не забудь проверить, так как материально не заинтересован, то могу и неправильно сделать

Ссылка на комментарий


var
i, j: integer;
s1: string;
begin
Result := '';
while (s <> '') do
begin
i := Pos(' ', s);
if (i > 0) then
begin
s1 := Copy(s, 1, i - 1);
Delete(s, 1, i);
end
else
begin
s1 := s;
s := '';
end;
j := Length(s1);
if (j > 1) then
Result := Result + Copy(s1, j div 2 + 1, Length(s1)) + Copy(s1, 1, j div 2)
else
Result := s1;
if (i > 0) then
Result := Result + ' ';
end;
end;
function myF(s: string): string;

это для дельфи

А в паскале тоже можеш, если нетрудно???

Ссылка на комментарий

SaS



uses WinCrt;

var
i, j: integer;
s, s1, Result: string;

begin
writeln('enter string:');
readln(s);
Result := '';
while (s <> '') do
begin
i := Pos(' ', s);
if (i > 0) then
begin
s1 := Copy(s, 1, i - 1);
Delete(s, 1, i);
end
else
begin
s1 := s;
s := '';
end;
for j := 1 to Length(s1) do
begin
i := Pos(s1[j], s1);
i := Pos(s1[j], Copy(s1, i + 1, Length(s1)));
if (i = 0) then
Break;
end;
if (i > 0) then
Result := Result + s1 + ' ';
end;
writeln(Result);
end.
program two_char;


uses WinCrt;
var
A: array [1..2] of word;
X: array [1..2] of word;
am, x1, x2, i, Y: word;
begin
A[1] := 1;
A[2] := 2;
X[1] := 3;
X[2] := 4;
am := 0;
for i := 1 to 2 do
if am < A[i] then
am := A[i];
x1 := 0;
x2 := 0;
for i := 1 to 2 do
if Odd(i) then
begin
if x1 < X[i] then
x1 := X[i];
end
else
if x2 < X[i] then
x2 := X[i];
Y := am + sqr(x1 - x2);
writeln('Y=', Y);
end.
program max_1;

Ссылка на комментарий

помогите решить задачи плз.Надо написать блок-схему или код на паскале чтобы можно было переделать под блок-схему

%C1%E5%E7%FB%EC%FF%ED%ED%FB%E9.71e81fe8384c01d4e92ba628ef42484c.JPG

Дано натуральное число k. Напечатать k-ую цифру последовательности: 12345678910111213..., в которой выписаны подряд все натуральные числа.

Дана последовательность из целых чисел, которые вводятся по одному. За последним числом вводится нуль. Найти два наименьших числа последовательности.

Ссылка на комментарий

Lakers Respect!

А можете такую задачку посмотреть:

Сказали через процедуру сделать, ваще не получатся:

Даны вещественные массивы А(16) В(20) вычислить:

у=((а1+а3+а5+...+а15)^2 - (b2+b4+b6+...+b20)^2)\((a2+a4+a6+...+a16)^2 + (b1+b3+b5+...+b10)^2)

:)

Ссылка на комментарий

через функцию наверно а не процедуру.

Добавлено спустя 2 минуты 23 секунды:

ет че такое?

у=((а1+а3+а5+...+а15)^2 - (b2+b4+b6+...+b20)^2)\((a2+a4+a6+...+a20)^2 + (b1+b3+b5+...+b10)^2)

в то время как А(16)

Добавлено спустя 10 минут 23 секунды:

uses crt;

var a,b:array[1..20]of real;

i:integer;

function f:real;

var i:integer;

s1,s2,s3,s4:real;

begin

s1:=0;

for i:=1 to 15 do s1:=s1+a;

s2:=0;

for i:=1 to 20 do s2:=s2+b;

s3:=0;

for i:=2 to 16 do s3:=s3+a;

s4:=0;

for i:=1 to 10 do s4:=s4+b;

f:=(s1*s1-s2*s2)/(s3*s3+s4*s4);

end;

begin

clrscr;

randomize;

for i:=1 to 16 do a:=random(10);

for i:=1 to 20 do b:=random(10);

writeln(f:0:3);

readkey;

end.

Добавлено спустя 21 минуту 33 секунды:

PapiruS

uses crt;

var x,y,p,k:integer;

s:longint;

begin

clrscr;

write('N= ');readln(k);

x:=1;

y:=1;

p:=1;

s:=0;

while x<=k do

begin

s:=s+x;

x:=y+p;

p:=y;

y:=x;

end;

writeln('SUM= ',s);

readkey;

end.

uses crt;

var k,i,j,n,c:integer;

a:array[1..10]of byte;

begin

clrscr;

write('K= ');readln(k);

j:=0;

while k>0 do

begin

j:=j+1;

i:=j;

n:=0;

while i>0 do

begin

n:=n+1;

a[n]:=i mod 10;

i:=i div 10;

end;

if k-n>0 then

begin

k:=k-n

end

else

begin

c:=a[n-k+1];

k:=-1;

end;

end;

writeln©;

readkey;

end.

uses crt;

var x,m1,m2:integer;

begin

clrscr;

read(x);

m1:=x;

m2:=x;

while x<>0 do

begin

if (xm1) then m2:=x;

if (x

begin

m2:=m1;

m1:=x;

end;

read(x);

end;

writeln('MIN1: ',m1);

writeln('MIN2: ',m2);

readkey;

end.

Ссылка на комментарий

Lakers

спс за решение , но 2-ую нужно без масива, для блок-схемы

а в первой почему та там на единицу ошибается

Добавлено спустя 6 минут 28 секунд:

uses crt;

var x,y,p,k:integer;

s:longint;

begin

clrscr;

write('N= ');readln(k);

x:=2;

y:=1;

p:=1;

s:=0;

while x<=k do

begin

s:=s+x;

x:=y+p;

p:=y;

y:=x;

end;

writeln('SUM= ',s);

readkey;

end.

Ссылка на комментарий

Пожалуйста, войдите, чтобы комментировать

Вы сможете оставить комментарий после входа в



Войти
  • Последние посетители   0 пользователей онлайн

    • Ни одного зарегистрированного пользователя не просматривает данную страницу
×
×
  • Создать...