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

Digma · 26 мая, 2009

День добрый. Прошу помощи, а точнее решите пожалуйсто 2 задачки.

Составти пожалуйсто программу.

1. Среди элементов квадратной матрицы 3х3 определить количество отрицательных элементов, а положительные увеличить на 2!!!

2. В массиве из 10 вещественных чисел найти наибольший элемент и поменять его местами с первым элементом.

ПОЖАЛЙСТО НАПИШИТЕ СРАЗУ ПРОГРАММУ, БУДУ ОЧЕНЬ БЛАГОДАРЕН! РЕШИВШЕМУ ЗАКИНУ ДЕНЕГ НА МОБИЛУ!!! ПЛИЗ!!!

martinges · 26 мая, 2009

пока свободное время буду прикалываться

Apocalipsis

раздел переменных

а,b: массив[1..const]действительных чисел;

count,i:целое число;

начало блока кода

цикл с параметром i

занести данные в массив a;

конец цикла с параметром;

цикл с параметром i

занести 0 в массив b;

конец цикла с параметром;

цикл с параметром i до const-1 элемента массива

если (i элемент а)*(i+1 элемент а)<0 тогда

начало

I+1 элемент массива b =1;

увеличиваем count на 1;

конец цикла с параметром;

цикл с параметром i

если I элемент массива b не равен 0 то вывести на экран: ‘мужик на ‘,I,’ месте знак поменялсо караул ’;

конец цикла с параметром;

вывести на экран: ‘капитан, за время вашего отсутствия выявлено ‘,count,’ чередований знаков ’;

конец блока кода.

Baimer · 26 мая, 2009

Digma

var
a:array [1..3,1..3]of integer;
i,j,n:integer;
begin
for i:=1 to 3 do
for j:=1 to 3 do
begin
readln(a[i,j]);
if a[i,j]<0 then n:=n+1
else a[i,j]:=a[i,j]+2;
end;
for i:=1 to 3 do begin
writeln;
for j:=1 to 3 do write(a[i,j],' ');
end;
writeln('отрицательных элементов ',n);
end.
program zadacha1;

var
a:array[1..10]of real;
i,n:integer;
x:real;
begin
for i:=1 to 10 do readln(a[i]);
x:=a[1];
n:=1;
for i:=2 to 10 do if x x:=a[i];
n:=i;
end;
a[n]:=a[1];
a[1]:=x;
for i:=1 to 10 do writeln(a[i]);
end.
program zadacha2;

Apocalipsis · 27 мая, 2009

Кто умеет создавать отчеты в делфи отпишите в личку.

Exclusive · 27 мая, 2009

Уважаемые программисты. Пожалуйсто напишите программу для решения этих двух задачек.

1. Определить, является ли заданное натуральное число N совершенным, т.е. равным сумме всех своих (положительных) делителей, кроме самого себя.

2. Вычислить значение выражения: y=5!/(4в степени5+4!/(4в степени4+3!/(4в степени3+2!/(4в степени2+1/(4+х)))))

Не смог понять как написать число в степени, поэтому написал словами. Пожалуйсто помогите, напишите программу...

ght · 27 мая, 2009

спасибо за решение задач!!! Решите пожалуйста еще 2 задачи до пятницы срочно надо(скоро сессия )

1. Найти все двухзначные числа , сумма квадратов цифр которых делится на 13

2. Даны действительное a и натуральное n . Вычислить

p=a*(1+2)*(1+2+3)*...*(1+2+...+n)

SxLvn · 28 мая, 2009

Написал прогу, тока чёт она тупит, помогите исправить, пожалуйста:

Даны сведения о сотрудниках учреждения: фамилия, инициалы, номер телефона.

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

program zad;
uses crt;
const y=3;
type stud=record
fam,fio:string[30];
nomer:longint;
end;
var st:stud;
a:array[1..y] of stud;
i,j,k,n:integer;
x:longint;
begin
clrscr;
for i:=1 to y do
begin
writeln ('vvedite familiyu'); readln (a[i].fam);
writeln ('vvedite iniczial'); readln (a[i].fio);
writeln ('vvedite nomer'); readln (a[i].nomer);
end;
for i:=1 to y do
if a[i].fam[1]='o' then x:=a[i].nomer;
n:=i;
for j:=1 to y do
if a[j].nomer>x then
begin
x:=a[j].nomer;
n:=j;
end;
for i:=n to y do
a[i]:=a[i+1];
for i:=1 to y do
writeln (a[i].fam, a[i].fio:4, a[i].nomer:12);
readkey
end.

martinges · 28 мая, 2009

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

FunlOvEe · 28 мая, 2009

ght

var i:integer;
begin
clrscr;
for i:= 10 to 99 do
if ( ( sqr( i div 10 ) + sqr( i mod 10 ) ) mod 13 = 0 ) then
write( i:3 );
readkey;
end.
uses crt;

var n,i:integer;
a,p:real;
function sum(n:integer):integer;
begin
if n = 0 then sum := 0
else
sum := n+sum(n-1);
end;
begin
clrscr;
write('a = ');
readln(a);
write('n = ');
readln(n);
p := a;
for i:=2 to n do
begin
p := p * sum(i);
end;
write('Ответ: ',p:5:2);
readkey;
end.
uses crt;

genemy · 28 мая, 2009

SxLvn, у вас в коде полная каша

где сортировка то ?

примерно должно быть так

писал прямо тут, не проверял )

var
tmp_stud : stud;
// ....
for i:=1 to y
do if a[i].fam[1]='o'
then begin
		x := 0;
		for j := i to у
		do if a[j].fam[1]='o' and a[j].nomer > x
		then begin
			x := a[j].nomer;
			k := j;
		end;
	if k <> i
	then begin
		tmp_stud := a[i];
		a[i] := a[k];
		a[k] := tmp_stud;
		end;
end;
// тут вывод

$h|{et · 28 мая, 2009

Уважаемые программисты. Пожалуйсто напишите программу для решения этих задач.

1.Дана последовательность действительных чисел A1,

2.Даны действительные числа A1,A2,...An. Требуется умножить все члены последовательности A1,A2,...An на квадрат ее наименьшего члена, если Ак>0,и на квадрат ее наибольшего члена, если Ак<0(1

3.Дана последовательность целых чисел.Найти кол-во различных чисел в этой последовательности.

4.Дана последовательность целых чисел A1,A2,...An.Выяснить, какое число встречается раньше-положительное или отрицательное.

Галсан · 28 мая, 2009

все уже не надо

Digma · 28 мая, 2009

Уважаемые программисты. Пожалуйсто напишите программу для решения этих двух задачек.

1. Определить, является ли заданное натуральное число N совершенным, т.е. равным сумме всех своих (положительных) делителей, кроме самого себя.

2. Вычислить значение выражения: y=5!/(4в степени5+4!/(4в степени4+3!/(4в степени3+2!/(4в степени2+1/(4+х)))))

Не смог понять как написать число в степени, поэтому написал словами. Пожалуйсто помогите, напишите программу...

SxLvn · 28 мая, 2009

genemy а можешь всю прогу написать, а то у мну не получается.

У меня так получилось

uses crt;
const y=3;
type stud=record
fam,fio:string[30];
nomer:longint;
end;
var tmp_stud:stud;
a:array[1..y] of stud;
i,j,k,n:integer;
x:longint;
begin
clrscr;
for i:=1 to y do
begin
writeln ('vvedite familiyu'); readln (a[i].fam);
writeln ('vvedite iniczial'); readln (a[i].fio);
writeln ('vvedite nomer'); readln (a[i].nomer);
end;
for i:=1 to y
do if a[i].fam[1]='o'
then begin
x := 0;
for j := i to ó
do if a[j].fam[1]='o' and a[j].nomer > x
then begin
x := a[j].nomer;
k := j;
end;
if k <> i
then begin
tmp_stud := a[i];
a[i] := a[k];
a[k] := tmp_stud;
end;
end;
for i:=n to y do
a[i]:=a[i+1];
for i:=1 to y do
writeln (a[i].fam, a[i].fio:4, a[i].nomer:12);
readkey
end.
program zad;

genemy · 28 мая, 2009

for i:=n to y do
a:=a[i+1];

вот это зачем ?

у меня ни дельфи ни паскаля нету

ght · 28 мая, 2009

FunlOvEe

спасибо огромное! Завтро покажу задачи и все ок)))

FunlOvEe · 28 мая, 2009

Digma

var i,n,sum:integer;
begin
clrscr;
write(' N = ' );
readln(n);
for i:=1 to n div 2 do
if n mod i = 0 then
sum:= sum + i;
if ( sum = n) then
writeln(' Число ',n, ' совершенное')
else
writeln(' Число ',n, ' несовершенное');
readkey;
end.
uses crt;

var n,i:integer;
x,y:real;
function f(n:integer):integer;
begin
if n = 0 then f := 1
else
f := n*f(n-1);
end;
function s(x,n:real):real;
var t:real;
begin
t := Abs(x);
if x < 0 then
s:= (-1)*exp(n*Ln(t))
else
s:= exp(n*Ln(t));
end;
begin
clrscr;
x := 0;
y := f(5)/( s(4,5)+f(4) /
( s(4,4)+f(3) /
( s(4,3)+f(2) /
(s(4,2)+1/(4+x))
)
)
);
write(y:1:8);
readkey;
end.
uses crt;

SxLvn

const y = 4;
type stud = record
fam,fio:string[30];
nomer:longint;
end;
var tmp_stud:stud;
a:array[1..y] of stud;
i,j,k,n:integer;
x:longint;

procedure swap(var e1, e2: stud);
var
e: stud;
begin
e := e1; e1 := e2; e2 := e;
end;

procedure qsort(l, r: integer);
var
i, j, x: integer;
begin
i := l;
j := r;
x := a[l+random(r-l+1)].nomer;
repeat
while ( x > a[i].nomer ) do inc(i);
while ( x < a[j].nomer ) do dec(j);
if (i <= j) and ((a[i].fam[1] = 'o') or ( a[j].fam[1] = 'o')) then
begin
swap(a[i], a[j]);
inc(i);
dec(j);
end
else
begin
inc(i);
dec(j);
end;
until i > j;
if l < j then qsort(l, j);
if i < r then qsort(i, r);
end;

begin
clrscr;
for i:=1 to y do
begin
write('vvedite familiyu: ');
readln(a[i].fam);
write('vvedite iniczial: ');
readln(a[i].fio);
write('vvedite nomer: ');
readln(a[i].nomer);
end;
for i:=1 to y do
if ( a[i].fam[1] = 'o' ) then
qsort(1,y);
for i:=1 to y do
writeln (a[i].fam, a[i].fio:4, a[i].nomer:12);
readkey;
end.
uses crt;

SxLvn · 28 мая, 2009

SxLvn
const y = 4;
type stud = record
fam,fio:string[30];
nomer:longint;
end;
var tmp_stud:stud;
a:array[1..y] of stud;
i,j,k,n:integer;
x:longint;

procedure swap(var e1, e2: stud);
var
e: stud;
begin
e := e1; e1 := e2; e2 := e;
end;

procedure qsort(l, r: integer);
var
i, j, x: integer;
begin
i := l;
j := r;
x := a[l+random(r-l+1)].nomer;
repeat
while ( x > a[i].nomer ) do inc(i);
while ( x < a[j].nomer ) do dec(j);
if (i <= j) and ((a[i].fam[1] = 'o') or ( a[j].fam[1] = 'o')) then
begin
swap(a[i], a[j]);
inc(i);
dec(j);
end
else
begin
inc(i);
dec(j);
end;
until i > j;
if l < j then qsort(l, j);
if i < r then qsort(i, r);
end;

begin
clrscr;
for i:=1 to y do
begin
write('vvedite familiyu: ');
readln(a[i].fam);
write('vvedite iniczial: ');
readln(a[i].fio);
write('vvedite nomer: ');
readln(a[i].nomer);
end;
for i:=1 to y do
if ( a[i].fam[1] = 'o' ) then
qsort(1,y);
for i:=1 to y do
writeln (a[i].fam, a[i].fio:4, a[i].nomer:12);
readkey;
end.
uses crt;

Спс за попытку, но прога не сортирует

SaS · 31 мая, 2009

Помогите написать.

Среди N четырехугольников с заданными сторонами подсчитать количество параллелограммов, из которых найти один с наибольшим периметром.

Lakers · 31 мая, 2009

Экспромт.....

max,i,n,k:integer;
function pro(i:integer):boolean;
begin
if ((a[i][1]=a[i][2])and(a[i][3]=a[i][4]))or
((a[i][3]=a[i][2])and(a[i][1]=a[i][4]))then pro:=true
else pro:=false;
end;

begin
clrscr;
write('Введите кол-во четырехугольников');
readln(n);
for i:=1 to n do
begin
write('сторона 1: ');readln(a[i][1]);
write('сторона 2: ');readln(a[i][2]);
write('сторона 3: ');readln(a[i][3]);
write('сторона 4: ');readln(a[i][4]);
end;
max:=-1;
for i:=1 to n do
begin
if pro(i) then
begin
k:=k+1;
if a[i][1]+a[i][2]+a[i][3]+a[i][4]>max then
max:=a[i][1]+a[i][2]+a[i][3]+a[i][4];
end;
end;
writeln('количество прямоугольников: ',k);
writeln('максимальный периметр: ',max);
readkey;
end.
var a[1..100][1..4]of integer;

Скиф · 3 июня, 2009

Скиф
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.

Спасибо огромное!!!!!!

SaS · 7 июня, 2009

Lakers спс.

Вот ещо помогите)))

Pascal/Записи.

Даны сведения о сотрудниках учреждения: фамилия, инициалы, номер телефона (если телефона нет, то 0).
а) Выдать на экран сведения о сотрудниках, номер телефона которых заканчивается на  “10”, и подсчитать их количество.
б) Упорядочить все сведения о сотрудниках в алфавитном порядке фамилий.

Помогите)

martinges · 7 июня, 2009

а в чем именно помочь? с функцией ввода? с процедурой сортировки? если просто тупо написать прогу, то это неинтересно

SaS · 7 июня, 2009

Lakers спс.

Вот ещо помогите)))

Pascal/Записи.

Даны сведения о сотрудниках учреждения: фамилия, инициалы, номер телефона (если телефона нет, то 0).
а) Выдать на экран сведения о сотрудниках, номер телефона которых заканчивается на  “10”, и подсчитать их количество.
б) Упорядочить все сведения о сотрудниках в алфавитном порядке фамилий.

HeLp)))

ght · 8 июня, 2009

решите еще эти плз)))

1) Вычислить произведение элементов массива С [7] целых чисел, и если это произведение отрицательное , то вывести его абсолютное значение.

2) Дана последовательность n различных целых чисел. Найти сумму ее членов , расположенных между максимальным и минимальным значениями(в сумму включить и оба этих числа)

меня уже в группе за гения считают =))))

Войти

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

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

Digma

martinges

Baimer

Apocalipsis

Exclusive

ght

SxLvn

martinges

FunlOvEe

genemy

$h|{et

Галсан

Digma

SxLvn

genemy

ght

FunlOvEe

SxLvn

SaS

Lakers

Скиф

SaS

martinges

SaS

ght

Присоединяйтесь к обсуждению

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

Обзор

Активность