Программирование

Помощь с pascal`ем

,

решение задач

Дата публикации:

main, 11.11.2006 - 20:34

Люди мне надо решить восемь задач в паскале, если есть кто в нем рулит помогите, а то я сам не успею.

de1ay, 11.11.2006 - 21:29

QUOTE
Люди мне надо решить восемь задач в паскале, если есть кто в нем рулит помогите, а то я сам не успею.

Тексты задач?

scorpio, 12.11.2006 - 0:45

QUOTE(main @ 11.11.2006 - 19:34)
Люди мне надо решить восемь задач в паскале, если есть кто в нем рулит помогите, а то я сам не успею.
*



Выкладывай задания, сейчас всё порешаем wink.gif

main, 13.11.2006 - 20:45

275. Даны действительные числюююч10бн1юююн10.Получить х1*y1+x2*y…x10*y10. как упростить решение если исходные данные имеют следующий порядок x1,y1,…x10,y10.

252. Дана строка символов, подсчитать общее число вхождений символов +,-,* в заданную строку.

86. Дано натуральное число n сколько цифр в числе n.

56. Даны действительные положительные числа a,b,c,x,y. Выяснить пройдет ли кирпич с ребрами a,b,c в прямоугольное отверстие со сторонами x,y. Просовывать кирпич разрешается только так, чтобы каждое из ребер было параллельно или перпендикулярно каждой из сторон отверстия.

323. дано натуральное число n. Получить все натуральные числа, меньше n и взаимно простые с ним.

507. Сведения об ученике состоят из его имени и фамилии и названии класса (года обучения и буквы), в котором он учится: выяснить, имеются ли в школе однофамильцы.

AquaTour, 14.11.2006 - 2:11

Задача 252 (Дана строка символов, подсчитать общее число вхождений символов +,-,* в заданную строку.)
var
s : String;
i, z : integer;
begin
Write('Input string: ');
ReadLn(s);
z := 0;
for i := 1 to Length(s) do
begin
if (s[i] = '-') or (s[i] = '+') or (s[i] = '*') then
Inc(z);
end;
WriteLn(z);
ReadLn;
end.

AquaTour, 14.11.2006 - 2:26

Вот 2 способа решения задачи № 86 (Дано натуральное число n сколько цифр в числе n.)
Первый способ
var
i, z : LongInt;
begin
Write('Введите число: ');
ReadLn(z);
i := 1;
while z >= 10 do
begin
z := z div 10;
Inc(i);
end;
Write('Число цифр: ', i);
ReadLn;
end.

и второй, немного читерский
var
s : String;
z : LongInt;
begin
Write('Введите число: ');
ReadLn(z);
Str(z, s);
Write('Число цифр: ', Length(s));
ReadLn;
end.

AquaTour, 14.11.2006 - 3:37

Задача №56 (Даны действительные положительные числа a,b,c,x,y...)
var
a, b, c, x, y : integer;
procedure Swap(var z1, z2 : integer);
var
tmp : integer;
begin
tmp := z1;
z1 := z2;
z2 := tmp;
end;
begin
Write('Введите размеры кирпича (a, b, c): ');
ReadLn(a, b, c);
Write('Введите размеры отверстия (x, y): ');
ReadLn(x, y);
if a > b then
Swap(a, B);
if b > c then
Swap(b, c);
if a > b then
Swap(a, B);
if x > y then
Swap(x, y);
if (x >= a) and (y >= B) then
Write('Кирпич пройдет через отверстие')
else
Write('Кирпич не пройдет через отверстие');
ReadLn;
end.

main, 14.11.2006 - 20:55

и еще у меня одна задвча н графику, надо танк на рисовать, как мнне сюда рисунок выложить?

ZaHack, 14.11.2006 - 21:28

QUOTE(main @ 14.11.2006 - 21:55)
и еще у меня одна задвча н графику, надо танк на рисовать, как мнне сюда рисунок выложить?
*



А зенитку тебе в трех проекциях нарисовать, случайно, не надо? laugh.gif
PS Рисунок можно запостить кнопкой "IMG"....

AquaTour, 15.11.2006 - 0:03

Уточни условия заданий 507, 323, 275 и выкладывай рисунок танка - ща порешаем!

Quim2005, 15.11.2006 - 9:49

Давненько я на паскале не писал.
Задание №275.
Даны действительные числюююч10бн1юююн10.Получить х1*y1+x2*y…x10*y10.
как упростить решение если исходные данные имеют
следующий порядок x1,y1,…x10,y10.

Решение:

var
x, y: array [1..10] of real;
i: integer;
s: string;
result: real;
begin
for i:=1 to 10 do
begin
Str(i, s);
Write('Введите X['+s+'] ');
ReadLn(x[i]);
Write('Введите Y['+s+'] ');
ReadLn(y[i]);
end;

result:=0;
for i:=1 to 10 do
begin
result:=result+x[i]*y[i];
end;

Write('Ответ = ');
WriteLn(result);
end.

Попозже остальные сделаю

Quim2005, 15.11.2006 - 10:31

Задание №323
Дано натуральное число n. Получить все натуральные числа, меньше n и взаимно простые с ним.

Решение:
var
i, n: Integer;
begin
write('Введит действительное число N ');
readln(n);
writeln('Простые числа');
for i:=n downto 1 do
begin
If (n mod i)=0 Then
writeln(i);
end;
end.

main, 15.11.2006 - 18:19

я IMG могу только ссылку на рисунок выложить, а как быть если рисунок на компе?

de1ay, 15.11.2006 - 18:33

QUOTE
я IMG могу только ссылку на рисунок выложить, а как быть если рисунок на компе?

Читай здесь.

AquaTour, 16.11.2006 - 3:00

Да выкладывай ссылку уже, давно написали бы...

507. Сведения об ученике состоят из его имени и фамилии и названии класса (года обучения и буквы), в котором он учится: выяснить, имеются ли в школе однофамильцы.

type
rec = record
sn : string[30];
n : string[30];
kl : string[5];
end;
var
m : array[1..20] of rec;
i, c, j : integer;
begin
Write('Введите количество учеников: ');
ReadLn©;
for i := 1 to c do
begin
Write('Введите фамилию: ');
ReadLn(m[i].sn);
Write('Введите имя: ');
ReadLn(m[i].n);
Write('Введите класс: ');
ReadLn(m[i].kl)
end;
for i := 1 to c do
for j := 1 to c do
if (m[i].sn = m[j].sn) and (i <> j) then
WriteLn(m[i].sn, ' ', m[i].n, ' ', m[i].kl);
ReadLn;
end.

main, 16.11.2006 - 9:32

вот танк:
http://xs.to/xs.php?h...f=DSC00502.JPG

и восьмая задача:
http://xs.to/xs.php?h...f=DSC00505.JPG

AquaTour, 16.11.2006 - 14:09

Вот танк, вторую может позже решу.

uses
Graph;
var
grDriver : Integer;
grMode : Integer;
ErrCode : Integer;
begin
grDriver:=Detect;
InitGraph(grDriver, grMode, 'D:\Language\BPascal\BGI');
Line(200, 100, 230, 100);
Line(230, 100, 230, 110);
Line(210, 110, 230, 110);
Line(200, 100, 200, 130);
Line(210, 110, 210, 130);
Line(180, 130, 270, 130);
Line(180, 130, 180, 160);
Line(180, 160, 270, 160);
Line(270, 130, 270, 160);
Line(140, 160, 310, 160);
Line(140, 190, 310, 190);
Arc(140, 175, 90, 270, 15);
Arc(310, 175, 270, 90, 15);
Circle(155, 175, 10);
Circle(190, 175, 10);
Circle(225, 175, 10);
Circle(260, 175, 10);
Circle(295, 175, 10);
ReadLn;
CloseGraph;
end.

Slow motion, 21.11.2006 - 6:48

помогите решить 7 задач.

Slow motion, 25.11.2006 - 6:25

ну так что мне кто нить поможет???

yah, 25.11.2006 - 7:49

Ты бы лучше выложил их, а там видно будет...

FOX, 28.11.2006 - 23:36

Помогите решить 3 задачи. Времени нету, а с паскалем Давно не работал sad.gif
1(Матрицы).Дана матрица размера 5х10. Вывести номер ее последней строки, содержащей только положительные элементы. Если таких строк нет, то вывести 0.
2(Строки).Дана строка. Преобразовать все строчные латинские буквы в прописные.
3(Множества).Дан текст из строчных латинских букв, за которыми следует точка. Напечатать первые вхождения букв в текст, сохраняя их исходный взаимный порядок.
Заранее спасибо.

AquaTour, 29.11.2006 - 3:38

C Паскалем надо работать smile.gif

1)
const
maxY = 5;
maxX = 3;
var
mas : array[1..maxY, 1..maxX] of Integer;
i, j : Integer;
f : Boolean;
begin
for i := 1 to maxY do
begin
for j := 1 to maxX do
Read(mas[i, j]);
ReadLn;
end;
i := maxY;
f := true;
while (i > 0) and (f) do
begin
f := false;
for j := 1 to maxX do
if mas[i, j] < 0 then
f := true;
i := i - 1;
end;
if not f then
i := i + 1;
WriteLn(i);
ReadLn;
end.

2)
var
s : string;
i : integer;
begin
ReadLn(s);
for i := 1 to Length(s) do
if (Ord(s[i]) >= 97 ) and (Ord(s[i]) <= 122) then
s[i] := Char(Byte(s[i]) - 32); //приведение типов
WriteLn(s);
ReadLn;
end.

3)
var
d : set of 'a'..'z';
s : String;
i : Integer;
begin
ReadLn(s);
for i := 1 to Length(s) do
if (Ord(s[i]) >= 97 ) and (Ord(s[i]) <= 122) and not(s[i] in d) then
begin
Write(s[i]);
Include(d, s[i]);
end;
ReadLn;
end.

Протестируй получше, а то я ночью писал мог чего и перепутать. ph34r.gif

Slow motion, 29.11.2006 - 8:10

вот задачки:
1 Даны натуральное число n, действительные числа a, b, x1, y1, ..., xn, yn. Пара a, b - координаты
школы микрорайона, а пары xi, yi (i = 1, ..., n) - соответственно координаты домов этого микрорайона.
Найти расстояния от домов до школы и среднее арифметическое этих расстояний.

2 Дано натуральное число n. Получить сумму тех чисел вида , которые являются утроенными нечетными.

3 Дана строка символов S1,...,Sn. Выяснить, имеются ли в последовательности S1,...,Sn такие члены последовательности
Si , Si+1 , что Si - это запятая, а Si+1 - тире.

4 Даны действительные числа A1,..., A28, B1,..., B28. Члены последовательности C1,..., C29 связаны с членами данных последовательностей соотношениями C29=0, C29-i=A29-i/B29-i -C29-i+1 (i=1, ..., 28). Получить: C1,..., C29.

5 Натуральное число называется совершенным, если оно равно сумме всех своих делителей, за исключением себя самого . Число 6 - совершенное, так как 6=1+2+3. Число 8 - не совершенное, т.к. как 8 1+2+4. Дано натуральное число n. Получить все совершенные числа, меньше n.

6 Дано натуральное число n. Выяснить, имеются ли среди чисел n, n+1, ..., 2n близнецы, т.е. простые числа, разность между которыми равна 2. (Определить процедуру, позволяющую распознавать простые числа).

7 Сведения об ученике состоят из его имени и фамилии и названии класса (года обучения и буквы), в котором он учится.
Дан файл f, содержащий сведения об учениках школы. Выяснить, имеются ли однофамильцы в каких-либо параллельных классах.

AquaTour, 29.11.2006 - 15:57

1)
const
max = 5;
var
i : Integer; a, b, p, s : real;
x : array[1..max] of real;
y : array[1..max] of real;
function f(j : integer) : real;//вычисление расстояния между 2-мя точками
begin
f := Sqrt(Sqr(a - x[j]) + Sqr(b - y[j]));
end;
begin
ReadLn(a, cool.gif;
for i := 1 to max do
ReadLn(x[i], y[i]);
s := 0;
for i := 1 to max do
begin
p := f(i);
WriteLn(p);
s := s + p;
end;
WriteLn('****');
WriteLn(s / max);
ReadLn;
end.

4)
const
max = 28;
var
i : integer; a, b : array[1..max] of real;
c : array[1..max + 1] of real;
begin
for i := 1 to max do
Read(a[i]);
for i := 1 to max do
Read(b[i]);
c[max + 1] := 0;
for i := max downto 1 do
c[i] := a[i] / b[i] + c[i + 1];
for i := 1 to max + 1 do
Write(c[i] : 2 : 1, ' ');
ReadLn;
end.

5)
var
n, i : integer;
function F(inp : integer) : boolean;
var
tmp, j : integer;
begin
tmp := 0;
for j := 1 to (inp div 2) do
if inp mod j = 0 then
tmp := tmp + j;
if tmp = inp then
F := true
else
F := false;
end;
begin
ReadLn(n);
for i := 1 to n do
if F(i) then
Writeln(i);
ReadLn;
end.

AquaTour, 30.11.2006 - 0:09

6)
var
i, n : Integer;
function F(v : integer) : boolean;
var
r, d : integer;
begin
d := 2;
repeat
r := v mod d;
if r <> 0 then
Inc(d);
until r = 0;
if d = v then
F := true
else
F := false;
end;

begin
ReadLn(n);
for i := n to n * 2 - 2 do
if F(i) then
if F(i + 2) then
WriteLn(i, ' - ', i + 2);
ReadLn;
end.

7)
type
rec = record
sn : string[30];{фамилия}
n : string[30];{имя}
y : string[2];{год обучения}
b : string[1];{буква класса}
end; { rec }
var
m : array[1..100] of rec;
i, n, j : integer;
f : file of rec;
begin
n := 0;
Assign(f, 'input.txt');
Reset(f);
while not EOF(f) do
begin
Read(f, m[i]);
n := n + 1;
end;
Close(f);
for i := 1 to n do
for j := 1 to n do
if (m[i].sn = m[j].sn) {проверяем одинаковые ли фамилии}
and (m[i].y = m[j].B ){проверяем год обучения}
and (i <> j) then {и проверяем что это не один и тот же ученик}
WriteLn(m[i].sn, ' ', m[i].n, ' ', m[i].y, ' ', m[i].B );
ReadLn;
end.

2)
var
i, n, z : Integer;
begin
ReadLn(n);
z := 0;
for i := 1 to n do
if Odd(i * 3) then
z := z + i;
Write(z);
ReadLn;
end.

Slow motion, 30.11.2006 - 12:08

В 3 обчная строка

AquaTour, 30.11.2006 - 21:46

3)
var
s, s1 : String;
begin
ReadLn(s);
s1 := ',-';
if Pos(s1, s) <> 0 then
Write('Присутствует')
else
Write('Подстроки не существует');
ReadLn;
end.

Alex Ander, 14.03.2007 - 10:59

1. Змей Горыныч и Добрыня Никитич
У n-голового Змея Горыныча заболело k голов. Змей Горыныч обратился за помощью к Добрыне Никитичу. Добрыня Никитич одним ударом меча срубает подряд не менее двух голов Змея Горыныча. При этом на месте срубленной больной головы вырастает здоровая. Однако вместо срубленной здоровой у Змея Горыныча вырастает больная. Какое минимальное количество ударов должен нанести Добрыня Никитич, чтобы вылечить Змея Горыныча?
Формат входного файла
В первой строке содержатся числа n и k, разделенные пробелом. Вторая строка состоит из k нулей и n-k единиц. Нуль означает больную голову, а единица – здоровую.
Формат выходного файла
Содержит минимальное число ударов которыми Добрыня Никитич вылечил Змея Горыныча.


2. Шахматный турнир
Несколько лет назад был проведен шахматный турнир, замечательный тем, что в нем ни в одной партии не была зафиксирована ничья. Журналисты решили напечатать таблицу результатов этого уникального турнира. Так как документальных свидетельств этого турнира не оказалось, было решено сделать опрос участников турнира. В результате опроса выяснилось, что каждый участник смог вспомнить только количество очков которые он набрал в этом турнире. Сколько вариантов таблицы результатов могут составит журналисты по результатам этого опроса? (Таблица результатов – эта таблица по которой можно выяснить как сыграли p-й и q-й игроки. Если p-й выиграл, то в p-й строке в q-м столбце стоит 1, в противном случае – 0).
Формат входного файла.
В первой строке находится число n. (4<=n<=14). Где n – количество участников турнира.
В каждой из n следующих строк вначале находится фамилия участника турнира, а затем после пробела – количество очков которые набрал этот шахматист.
Формат выходного файла.
Выходной файл содержит количество вариантов таблицы результатов.



3 Театр
Марья Ивановна с Марьей Михайловной привели школьников в театр. Чтобы не было никаких обид, Марья Ивановна построила всех школьников по алфавиту и рассадила их: сначала в первый ряд слева направо, затем второй ряд слева направо и т.д., заполнив весь зал из n рядов по m кресел. Тут пришла Марья Михайловна и сказала, что ребята сели неправильно – надо пересесть. Она предложила сначала заполнить все первые места от первого ряда к последнему, затем вторые места и т.д.
Определите, сколько школьников после такой пересадки останется на своем месте. Например, если n=3 и m=3, то в первом случае дети сядут так:
1 2 3
4 5 6
7 8 9
а во втором – так:
1 4 7
2 5 8
3 6 9
Таким образом, три школьника: 1, 5 и 9 останутся на своих местах.
Формат входного файла
Входной файл содержит два целых числа n и m (1<=n,m<=109 )
Формат выходного файла
Выведите количество школьников, которые останутся на своих местах

4 Три отрезка
Петя и Ваня живут в домах, которые расположены на пересекающихся улицах. Однажды Петя пошел в гости Ване. Сначала он шел по своей улице к перекрестку, но, не дойдя до перекрестка пошел напрямик к улице Вани. Вышел на улицу Вани, и оказалось, что вышел между перекрестком и домом Вани. Дойдя до дома Вани, Петя заметил, что все три отрезка его пути равны между собой. Подскажите Пете какой путь он прошел (длину пути).
Формат входного файла
Входной файл содержит 3 пары чисел – координаты домов Пети, Вани и координаты перекрестка
Формат выходного файла
Выведите длину пути Пети c точностью до 4 знаков после запятой



scorpio, 14.03.2007 - 13:48

Напиши алгоритмы, а код напишем wink.gif

Alex Ander, 14.03.2007 - 15:21

Знал бы алгоритмы - код бы я сам написал.

scorpio, 14.03.2007 - 15:52

QUOTE(alex_p25 @ 14.03.2007 - 14:27)
Знал бы алгоритмы - код бы я сам написал.
*



Задачки уровня школьной олимпиады... не столько программирование, сколько посидеть подумать... cool.gif

Это срочно? Или есть время подумать?

ЭЖД, 14.03.2007 - 16:06

ph34r.gif 1 задача
program odin;
var i,n,k,udar:byte;
begin
udar:=0;
for i:=1 to n do begin k:=k-2; udar:=udar+1; if k<1 Then udar:=udar+1 end;
writeln('n k');
for i:=1 to n do write('0');
for i:=1 to n-k do write('1');
assign(f,exit.txt);
write(f,udar);
close(f)
end.

Alex Ander, 14.03.2007 - 16:08

Время есть. Пара дней как минимум.

_Dimas_, 15.03.2007 - 4:56

Первая задачка
я так понял за раз отрубаются как минимум 2 головы, а максимум не ограничен.

CODE

program Gorynych;
var
 n, k, Udar: Integer;
 Golovy: string; { Ограничение на 255 голов }
 i, j, l: Integer;
 f: Text;
begin
 Assign(f, 'Input.txt'); Reset(f);
 ReadLn(f, n, k); ReadLn(f, Golovy);
 Close(f);
 if (Length(Golovy) < n) and (n > 2) then halt
 else Golovy := Copy(Golovy, 1, n);
 Assign(f, 'Output.txt'); Rewrite(f);
 Udar := 0; i := 1;
 WriteLn(f, Udar:3, '  ', Golovy);
 while i <= n do begin
   j := 1;
   if Golovy[i] = '0' then begin {Если встретилась больная голова}
     Golovy[i] := '1';           {Текущая отрубается в любом случае}
     {Считаем больные головы}
     while (i + j <= n) and (Golovy[i + j] = '0') do j := j + 1;
     {Если следующая(ие) больные, все отрубаются }
     if j > 1 then for l := i + 1 to i + j do Golovy[l] := '1';
     {Если следующая здоровая или эта последняя}
     if j = 1 then begin
       if i + 1 <= n then begin  {Если эта не последняя}
         Golovy[i + 1] := '0';   {то следующая отрубается}
         if i + 1 < n then       {Если следующая не последняя}
           if Golovy[i + 2] = '1' then {Если послеследующая здоровая}
             Golovy[i + 2] := '0'      {тоже отрубается}
       end else begin            {Если эта все-таки последняя голова}
         Golovy[i - 1] := '0';         {две предыдущие отрубаются}
         Golovy[i - 2] := '0';
         j := -2;
       end;
     end;
     Udar := Udar + 1;
     WriteLn(f, Udar:3, '  ', Golovy);
   end;
   i := i + j;
 end;
 Close(f);
end.

_Dimas_, 15.03.2007 - 9:11

Третья
Если получается квадрат, диагональ остается на месте, в остальных случаях на месте остаются вроде тока первый да последний
CODE

program Teatr;
var
 n, m: Integer;
 f: Text
begin
 Assign(f, 'Input.txt'); Reset(f);
 ReadLn(f, n, m); Close(f);
 if (n < 1) or (n > 109) or (m < 1) or m > 109) then halt;
 Assign(f, 'Output.txt'); Rewrite(f);
 if m = n then Write(f, n) else Write(f, 2)
 Close(f);
end.

_Dimas_, 15.03.2007 - 17:41

Четвертая задача читая геометрия, школьная программа.
Присоединённое изображение
AN = NM = MC по условию
Стороны AB и BC расчитываются из условия задачи.
По сторонам AB BC и углу между ними находишь AC.
Если не ошибаюсь, то по трем сторонам можно узнать углы треугольника (CAB и ACB).
Дальше составляешь систему.
AN = NM = MC = X
CN = Y
1 уравнение
По двум сторонам AC, AN(X) и углу между ними находишь CN(Y)
2 Уравнение
По двум сторонам CB, NB(AB-X) и углу между ними находишь CN(Y)
Вроде должно срабротать.


Вторая На бумажке вручную вроде понял как решать, а вот алгоритм в голову не приходит

ЭЖД, 15.03.2007 - 18:58

ph34r.gif AC можно найти без углов smile.gif координаты A и С мы знаем smile.gif
AC=sqrt(sqr(XC-XA)+sqr(YC-YA))

_Dimas_, 15.03.2007 - 20:36

Возможно, не силен в геометрии, написал то что помнил.
Видать хорошо вдалбивали знания smile.gif (класс 5 - 6 был)


По второй задаче
Здесь вроде как комбинаторика
Если входной файл такой
aaa 2
bbb 1
ccc 2
ddd 1

то для первого игрока здесь возможны 3 варианта
- 0 1 1
1 - х х
0 х - х
0 х х -

- 1 0 1
0 - х х
1 х - х
0 х х -

- 1 1 0
0 - х х
0 х - х
1 х х -

далее аналогично делается для второго игрока, отталкиваясь от каждого варианта выигрышей первого игрока

- 0 1 1
1 - 0 0
0 1 - х
0 1 х -
в даном случае 1 вариант

- 1 0 1
0 - 1 0
1 0 - х
0 1 х -

- 1 0 1
0 - 0 1
1 1 - х
1 0 х -
дальше два варианта

И так далее, а потом все и подсчитывается

Только может можно сразу все посчитать без всяких переборов?
Если нет то пытаться програмно описать весь этот перебор.

main, 31.05.2007 - 18:39

народ, вот прошло пол года, а точнее один семестр и мне снова нужна ваша помощь:). На этот раз програмки простые, надеюсь не оставите без внимания.
5 заданий в прикрепленом вордовском файле.

hanka, 6.10.2007 - 21:14

Твой софтовый форум

Название: Захват 2:Темная территория

Оригинальное название: Under siege 2. Dark Territory
Год выхода: 1995
Жанр: Боевик
Режиссер: Джефф Мерфи /Geoff Murphy/

Группа террористов-профессионалов, вместе с безумным изобретателем, уволенным из Пентагона, захватила поезд для того, чтобы развернуть на нем передвижной пункт управления засекреченным военным спутником США, на котором установлено лучевое оружие огромной разрушительной силы, и грозят взрывом на Восточном побережье США. Случайно оказавшийся среди пассажиров морской пехотинец Кейси Рейбек изменил их планы.
В ролях: Стивен Сигал /Steven Seagal/, Эрик Богосян /Eric Bogosian/, Кэтрин Хайгл /Katherine Heigl/, Эверетт МакГилл /Everett McGill/, Моррис Честнат /Morris Chestnut/, Ник Манкузо /Nick Mancuso/
Выпущено: Warner Bros.
Продолжительность: 1:34
Язык: Русский перевод

Формат: DivX
Качество: DVDRip
Видео: 656x400 (1.64:1), 25 fps, DivX ;-) MPEG-4 Fast-Motion ~900 kbps avg, 0.14 bit/pixel
Звук: 48 kHz, MPEG Layer 3, 2 ch, ~128.00 kbps avg
Размер: 697 MB
Партов: 8

jkalamari, 6.02.2008 - 14:13

Помогите решить три задачи на паскале,...сессия:

1) Текстовые файлы.
Написать программу, которая выделяет раздел операторов Паскаль - программы и записывает его в текстовый файл.

2) Указатели
Написать процедуру или функцию, которая находит среднее арифметическое непустого списка L.

3) массив
Создать и обработать массив с данными о студентах (например, успеваемость, или общежитие, кто где расселен. Вобщем-то задание просто на обработку массива, запись, изменение, дополнение)

Заранее спасибо.

ZaHack, 8.02.2008 - 22:25

Цитата | Quote(jkalamari @ 6.02.2008 - 15:16)


3) массив
Создать и обработать массив с данными о студентах (например, успеваемость, или общежитие, кто где расселен. Вобщем-то задание просто на обработку массива, запись, изменение, дополнение)
*



Массив одномерный или двумерный?

Цитата | Quote
Написать программу, которая выделяет раздел операторов Паскаль - программы и записывает его в текстовый файл.


Чего выделяет??! Выражайся ясней.

Alex Ander, 9.02.2008 - 2:30

Цитата | Quote(ZaHack @ 9.02.2008 - 6:28)
Цитата | Quote
Написать программу, которая выделяет раздел операторов Паскаль - программы и записывает его в текстовый файл.

Чего выделяет??! Выражайся ясней.
*


По-моему человек ясно выразился - выводит на экран содержимое раздела операторов: от первого begin до последнего end.

jkalamari, 11.02.2008 - 10:28

2 ZaHack

>Массив одномерный или двумерный?

Двумерный

>Чего выделяет??! Выражайся ясней.

Я бы с радостью, но именно такое задание дала нам наш гениальный преподаватель....
Как я понял - эта программа должна открывать файл с исходником любой программы на паскале и копировать от туда блок, начиная с "begin" и заканчивая "end."....

jkalamari, 15.02.2008 - 14:26

первые две сделал - срочно нужна третья задача. плз.

3) массив
Создать и обработать массив с данными о студентах (например, успеваемость, или общежитие, кто где расселен. Вобщем-то задание просто на обработку массива, запись, изменение, дополнение)

заранее спасибо.

Expelled, 24.02.2008 - 15:32

Начал учить паскаль по книге Окулова.
Появилась задача
Program My1_2;
Var a : Integer;
Begin

WriteLn ('Введите целое число');
ReadLn (а) ;
WriteLn ( ' ???????? ', Abs (a) );
WriteLn ( ' Нажмите ' );
ReadLn
End.

Выясните, что вычисляет Abs. Выполните аналогичное исследование для выражений sqr (a), Ord (a) , Succ (a) , pred (a).

Sqr это умножение числа А самого на себя (возведение в квадрат)
Succ это а+1
pred это а-1

а что делает Abs и Ord?

drod, 24.02.2008 - 16:01

Функция ord(x) возвращает порядковый номер значения переменной x (относительно того типа, к которому принадлежит переменная х).
Функция pred(x) возвращает значение, предшествующее х (к первому элементу типа неприменима).
Функция succ(x) возвращает значение, следующее за х (к последнему элементу типа неприменима).
Функция abs(x) возвращает абсолютную величину x (модуль)

Expelled, 24.02.2008 - 16:52

Спасибо оО ))

AsPiD001, 30.04.2008 - 4:57

Народ может кто поможет решить пару простых задач?

Alex Ander, 30.04.2008 - 7:44

Выкладывай условия задач сразу - мы подумаем.

Djavik91, 9.10.2008 - 17:23

Народ! помогите решить задачу!
2. Дан массив десяти чисел. Исключить из массива 5-ое и 6-ое числа. Вывести на экран дисплея сумму трехзначных чисел и их количество.

de1ay, 9.10.2008 - 17:58

Накатал на скорую руку, если что - пиши, дополним. smile.gif

Code
uses crt;
    var mas:array[1..10] of integer;
        i,p,sum: integer;
        q: char;
    begin
     repeat;

     clrscr;

     sum:=0;
     p:=0;

     randomize;

     for i:=1 to 10 do
     mas[i]:=random(10000);  // заполняем массив

     for i:=1 to 10 do
     write(mas[i],' ');  // выводи массив

     mas[5]:=0;
     mas[6]:=0;     // обнуляем 5 и 6 элемент

     sum:=0;

     for i:=1 to 10 do

     begin

     if (mas[i]>99) and (mas[i]<1000) then // если трехзначное то
     begin
     p:=p+1;                          //   увеличиваем счетчик чисел
     sum:=sum+mas[i];  //  увеличиваем сумму на только что полученное число
     end;

     end;

     writeln;

     writeln(sum,' ',p); // выводим результат: сумма - количество трехзнаков

     q:=readkey;

     until q='q';

     end.

ЭЖД, 9.10.2008 - 19:07

Цитата | Quote
repeat;


ph34r.gif ; не нужна, на сколько я помню.

de1ay, 9.10.2008 - 19:10

Цитата | Quote(ЭЖД @ 9.10.2008 - 19:10)
; не нужна, на сколько я помню.
*

FPC и с ней, и без неё собирает. smile.gif

Djavik91, 10.10.2008 - 20:06

СПС!!!

Djavik91, 22.10.2008 - 19:52

Люди, помогите решить несколько задач, а то не получается...=(

5. *Дан файл, компонентами которого являются целые числа. Каждый четный десяток чисел расположить по возрастанию, а каждый нечетный – по убыванию. Количество компонент файла не обязательно равно 10.

6. Даны действительные числа a0, a1,…,a6. Получить для x=1,2,3,4 значения P(x+1)-P(x), где P(y)=a0*y6+a1*y5+…+a5*y+a6


10. Реализовать процедуры “Вывести элементы списка на экран” и “Добавить новый элемент в конец списка” для динамической структуры данных Список. Элемент списка является записью с двумя полями: символьного типа и типа указатель на элемент списка. Элементы списка располагаются в динамической памяти. Список задается указателем на первый элемент списка.

Fat Pancho, 23.11.2008 - 1:33

Здравствуйте, если не сложно, помогите пожалуйста с задачей для Pascal:

Сведения об ученике состоят их его фамилии, имени, названия класса (года обучения и буквы), оценок обучения за последнюю четверть (возможно отсутствие некоторых оценок). Дан файл, содержащий сведения об учениках школы. Найти всех учеников по нескольким первым буквам имени. Рассортировать их по успеваемости и в алфавитном порядке.

Nattttt, 22.12.2008 - 15:57

Помогите пожалуйста решить задачу на языке паскаль. Заранее ОГРОМНОЕ СПАСИБО!

Вот задание:
Вычислить значение f(x)=x+lnx в заданной точке. Вывести на печать таблицу из 5 значений функции.

huh.gif sad.gif

programmer, 8.01.2009 - 11:35

помогите plz

1. Заполнить файл последовательного доступа f целыми числами. Получить в файле g все компоненты файла f, исключая повторные вхождения чисел. Вывести файл g на печать

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

kaMMarik, 11.01.2009 - 13:00

Цитата | Quote(Nattttt @ 22.12.2008 - 20:57)
Помогите пожалуйста решить задачу на языке паскаль. Заранее ОГРОМНОЕ СПАСИБО!

Вот задание:
Вычислить значение f(x)=x+lnx в заданной точке. Вывести на печать таблицу из 5 значений функции.


*



Code
var
a:real;
x,y : array[1..5] of real;
i : integer;

begin
for i:=1 to 5 do
begin
writeln('Vvedite x',i);
readln(x[i]);
a:=ln(x[i]);
y[i]:=x[i]+a;
end;

writeln('    x     f(x)   ln(x)');
for i:=1 to 5 do
writeln(x[i]:7:3,y[i]:7:3,(ln(x[i])):7:3);

readln;
end.


должна работать =)

kaMMarik, 11.01.2009 - 13:25

ОЁ чё я намутил!!! ну короче в тему только последняя читата, и после неё...код...


просто я ещё не разобрался куда тут на этом форуме тыкать =)

i Уведомление:
Уже поправил, а разобраться поможет этот раздел нашего форума.

SPiRiT, 26.02.2009 - 5:38

приветы!
по учебе не могу справиться с двумя задачами по Turbo Pascal.! может кто-нить может помоч мне, вообще никак задачи не пойму, уж больно сложно все это для меня, да так, что я ваще нулевой чета в них sad.gif

Решение задач с использованием индексированных переменных: МАССИВЫ И ВЕКТОРЫ.

Цитата | Quote
1. В Е К Т О Р Ы

1.11. CONST N=40;
            VAR X:ARRAY[1..N] OF INTEGER;
                Y,K:INTEGER; T:BOOLEAN;
            Переменной T присвоить значение TRUE, если в массиве
            Х нет нулевых элементов и при этом положительные эле-
            менты чередуются с отрицательными, и значение FALSE
            иначе.


Цитата | Quote
2. М А Т Р И Ц Ы

2.11. VAR A:ARRAY[1..8,1..10] OF INTEGER;
                B:ARRAY[1..8] OF BOOLEAN;
            по массиву А получить массив В, присвоив его k-му эле-
            менту значение TRUE, если выполнено указанное ниже ус-
            ловие, и значение FALSE - иначе: k-я строка массива А
            симметрична.



Заранее приогромнейшая благодарность! Если можно плиз, то и блок-схемы с меня тоже требуют sleep.gif

charodey_mag, 26.02.2009 - 9:18

Если все правильно понял то вот:
Code

//Задание 1.11
function Check111:boolean;
const N=40;
VAR X:ARRAY[1..N] OF INTEGER;
   Y,K:INTEGER; T:BOOLEAN;
begin
T:=true;
K:=0;
for Y:=1 to N do
 begin
 if X[N]=0 then
   begin
   T:=false;
   break;
   end;
 case k of
   0:if X[Y]>0 then K:=1 else K:=-1;
   1:if X[Y]<0 then K:=-1 else begin T:=false; break; end;
  -1:if X[Y]>0 then K:=1 else begin T:=false; break; end;
   end;
 end;
result:=T;
end;
//Задание 2.11
procedure Check211;
VAR A:ARRAY[1..8,1..10] OF INTEGER;
   B:ARRAY[1..8] OF BOOLEAN;
   i,k:integer;
   tb:boolean;
begin
for i:=1 to 8 do
 begin
 tb:=true;
 for k:=1 to 5 do
   if A[i,k]<>A[i,11-k] then
     begin
     tb:=false;
     break;
     end;
 B[i]:=tb;
 end;
end;


Блок схеиы рисовать ненавижу и поэтому не умею(((

SPiRiT, 26.02.2009 - 16:57

charodey_mag, вау! спасибо тебе огромное, щас оформлю все и попробую сдать!
Еще раз спасиба тебе!!!

SPiRiT, 5.03.2009 - 19:36

приветы!
вот на сдаче сессии не могу разобраться с лабораторной по Pascal на тему Массивы и индексированные переменные.

P.S отдельное спасибо charodey_mag за помощь в этой лабораторной!!!

Само задание выглядит так:
Цитата | Quote
{2.11. VAR A:ARRAY[1..8,1..10] OF INTEGER;
          B:ARRAY[1..8] OF BOOLEAN;
      по массиву А получить массив В, присвоив его k-му эле-
      менту значение TRUE, если выполнено указанное ниже ус-
      ловие, и значение FALSE - иначе: k-я строка массива А
      симметрична.}



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

сначала я сделал как процедуру, но это не вписалось в задание:
Code
procedure Check211;
VAR A:ARRAY[1..8,1..10] OF INTEGER;
  B:ARRAY[1..8] OF BOOLEAN;
  i,k:integer;
  tb:boolean;
begin
for i:=1 to 8 do
begin
tb:=true;
for k:=1 to 5 do
  if A[i,k]<>A[i,11-k] then
    begin
    tb:=false;
    break;
    end;
B[i]:=tb;
end;
end;


...потом из эту же процедуру переписал как программу, чтобы был вывод результата, но это опять не понравилось преподавателю и я так понял вывод результата не тут и не такой:
Code
program lab62;
uses crt;
VAR A:ARRAY[1..8,1..10] OF INTEGER;
  B:ARRAY[1..8] OF BOOLEAN;
  i,k:integer;
  tb:boolean;
begin
clrscr;
for i:=1 to 8 do
begin
tb:=true;
for k:=1 to 5 do
  if A[i,k]<>A[i,11-k] then
    begin
    tb:=false;
    break;
    end;
B[i]:=tb;
end;
writeln(tb);
end.


вот последний вариант переделанный мною уже получше, но тут не указана симметричность (k-я строка массива А симметрична):
Code
program lab62;
uses crt;
VAR A:ARRAY[1..8,1..10] OF INTEGER;
  B:ARRAY[1..8] OF BOOLEAN;
  i,k:integer;
  tb:boolean;
begin
clrscr;
for i:=1 to 8 do
begin
tb:=true;
for k:=1 to 5 do
  if A[i,k]<>A[i,11-k] then
    begin
    tb:=false;
    break;
    end;
B[i]:=tb;
end;
writeln(tb);
end.

charodey_mag, 5.03.2009 - 20:57

Может такой вариант пойдет
PS. От tb лучше вообще изавиться заменив его везде на B[i], это я чето не отом подумал
Code

program lab62;
uses crt;
VAR A:ARRAY[1..8,1..10] OF INTEGER;
 B:ARRAY[1..8] OF BOOLEAN;
 i,k:integer;
begin
clrscr;
for i:=1 to 8 do
begin
B[i]:=true;
for k:=1 to 5 do
 if A[i,k]<>A[i,11-k] then
   begin
   B[i]:=false;
   break;
   end;
if B[i] then
 writeln(i,' строка симметрична')
else
 writeln(i,' строка асимметрична');
end;
readln;
end.


SPiRiT, 6.03.2009 - 11:31

Еще раз большое тебе спасибо за помощь!
я там по-другому сделал, просто для проверки 5-ую строку симметричной!

SPiRiT, 6.04.2009 - 16:56

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

СТАНДАРТНЫЙ ТИП STRING
МОДУЛЬ STRINGS

Цитата | Quote
11.Дана последовательность, состоящая из 10 слов. Напечатать
все слова последовательности, удалив из каждого слова
нечётные буквы, если слово имеет нечётное количество
символов.



М Н О Ж Е С Т В А
Цитата | Quote
11. TYPE пpодукт = (хлеб, масло, мясо, pыба, соль, сыp,
                              колбаса, сахаp, чай, кофе);
            ассоpтимент = set of пpодукт;
            магазины = array [1..20] of ассоpтимент;
Описать пpоцедуpу "Наличие(Маг,А,В,С)", котоpая по инфоp-
мации из массива Маг типа магазины ( Маг[i] - это множес-
тво пpодуктов, имеющихся в i-м магазине ) пpисваивает
паpаметpам А,В и С типа ассоpтимент следующие значения:
А - множество пpодуктов, котоpые есть во всех магазинах;
В - множество пpодуктов, каждый из котоpых есть хотя бы в
одном магазине;
С - множество пpодуктов, котоpых нет ни в одном магазине.

charodey_mag, 7.04.2009 - 8:59

Первая
Code

function ParseStr(source:string):string;
var i,j,k,len:integer;
   ts:string;
begin
result:='';
for i:=1 to 10 do //10 ñëîâ
 begin
 k:=pos(' ',source);
 if k<>0 then
   begin
   ts:=copy(source,1,k-1);
   Delete(source,1,k);
   end
 else
   if i=10 then
     ts:=source
   else
     begin
     //меньше 10 слов !!!
     exit;
     end;
 len:=Length(ts);
 if (len and $01)<>0 then
   begin
   for j:=1 to len do
     if (j and $01)=0 then
       result:=result+ts[j];
   result:=result+' ';
   end
 else
   result:=result+ts+' ';
 end;
end;

Вторая
Code

procedure Presence(Mag: TMagazin;var A,B,C:TAssortiment);
var i:integer;
begin
A:=[pHleb,pMaslo,pMyaso,pSol,pSir,pKolbasa,pSahar,pChay,pKofe];
C:=A;
for i:=1 to 20 do
 begin
 A:=A*Mag[i];
 B:=B+Mag[i];
 C:=C-Mag[i];
 end;
end;


PS.
(len and $01)<>0
В двоичной системе число заканчивающееся на 1 всегда не четное. Хотя я думаю это и так понятно.

SPiRiT, 8.04.2009 - 11:41

О, огромное спасибо! Тока нужно было чуточку без функций и процедур - попроще =)))

charodey_mag, 8.04.2009 - 12:24

Во-первых во второй задаче указано:
Цитата | Quote
Описать пpоцедуpу "Наличие(Маг,А,В,С)"

Во-вторых у меня нет паскаля уже лет 10, поэтом пишу в Delphi, и соответственно писать процедурами гораздо удобнее

mamedov, 19.07.2009 - 15:15

Помогите, плз, с задачей.

Переписать многострочный текстовый файл удалив из него
строки, в которых повторяющееся слово (подстрока), например,
xyz, встречается n раз. Разделитель между словами - один или
более пробелов, текст - символы русских и латинских букв и
цифр. Программу написать на Pascal.
Заранее признателен.

malova, 28.08.2009 - 22:32

Задача1!!!!!
...что то не выходит...выдает математическую ошибку при проверке...

найти сумму n элементов бесконечного ряда с
y=-4+8-16+32-64.....
вот код:
var i,j,zn,n:integer;
s:real;
begin
clrscr;
writeln;
writeln('naiti summy elementov riada: y=-4+8-16+32-64...');
writeln('');
writeln('vvedite kolichestvo elementov ryada');
write('N=');
readln(n);
s:=1;
for i:=1 to n do begin
zn:=1;
for j:=1 to i+1 do begin
zn:=zn*(-1);
end;
s:=s+(-zn*(exp(1+i)*ln(2)));
end;
writeln('summa ryada s=',s:3:0);
readln;
end.

Добавлено:

Задача2!!!!!
Имеется массив, ответить на вопрос правда ли что среди чисел имеются отрицательные, ответ должен быть да или нет...

program z7;
uses crt;
type t=array[1..50] of real;
var n,i:integer;
a:t;
begin
writeln('vvedite n');
readln(n);
for i:=1 to n do readln(a[1]);
writeln('est li credi elementov otricat');
if (a[i]<0) then writeln('da') else writeln ('net');

readln;
end.

Добавлено:

Задача3!!!!!
Используя оператор цикла с параметром составить программу для вычисления значений функции
f(x)=tg(x) на отрезке [a,b] в точках
x(i)=a+ih, где h=(b-a)/m, a,b,m- заданые числа.

charodey_mag, 29.08.2009 - 14:16

Если ряд указан верно, то зачем такая сложная формула, ведь достаточно умножения на -2?
Code

var strt, i, N, sum:integer;
begin
strt:=2; //начало последовательности
write('N=');
readln(N);
sum:=0;
for I := 1 to N do
 begin
 strt:=strt*-2;
 sum:=sum+strt;
 end;
writeln('summa ryada sum=',sum);
readln;
end.


Во второй задаче вроде все правильно.

Про треью я что-то не совсем понял, может есть более полное условие?

fantnk, 29.08.2009 - 16:50

Цитата | Quote
Задача1!!!!!
...что то не выходит...выдает математическую ошибку при проверке...

найти сумму n элементов бесконечного ряда с
y=-4+8-16+32-64.....
вот код:
var i,j,zn,n:integer;
s:real;
begin
......
for j:=1 to i+1 do begin
zn:=zn*(-1);
......
end.

integer у нас - только положительные числа. Когда положительный zn*(-1), то будет отрицательное число. Вот и ошибка. Выберите другой тип для переменной zn. Надеюсь, понятно объяснил...

yah, 29.08.2009 - 17:01

Цитата | Quote(charodey_mag @ 29.08.2009 - 15:16)
найти сумму n элементов бесконечного ряда с
y=-4+8-16+32-64.....
*


Если я не ошибаюсь, то этот ряд - обычная арифметическая прогрессия, с первым элементом "-4" и разностью "-2". Поэтому можно либо по формуле суммы N-членов арифмет. прогрессии (если мне память не изменяет - (первый + последний) разделить пополам и умножить на кол-во членов).

de1ay, 29.08.2009 - 17:02

fantnk,

Pascal Variables and Data Types
Цитата | Quote
Data Type Minimum Value Maximum Value
Integer        -32,768              32,767

http://cs.nyu.edu/cou...variables.html

yah, 29.08.2009 - 17:05

Цитата | Quote(yah @ 29.08.2009 - 18:01)
integer у нас - только положительные числа.
*


Тип Integer - целое число, размер которого не гарантируется. Это - основной целочисленный тип в Delphi, и в настоящее время имеет ту же самую ёмкость как LongInt тип - 1 бит на знак, и 31 бит на значение.

Min значение integer = -32,768
Max значение integer = -32,767

*Поправка на ветер...

fantnk, 29.08.2009 - 17:12

Охх... Извиняюсь.
yah +1. Обычная арифметическая прогрессия.

Laryx, 30.08.2009 - 7:40

Уточнение - прогрессия не арифметическая, а геометрическая. Там другая формула.

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

mlvzevgen, 7.11.2009 - 9:19

Помогите решить задачи
Задача 1: Составить на языке Паскаль программу: Ввести значения четырех углов в градусах. Вывести на печать tg этих углов по образцу:
tg(45)=1.00 tg(30)=......
********
tg(10)=..... tg(60)=......

Задача 2:Составить на языке Паскаль программу: Найти сумму положительных элементов массива В размерности N и подсчитать их количество. Предоставить схему алгоритма.

Задача 3: Составить на языке Паскаль программу: Найти два наибольших числа среди отрицательных чисел массива и место их расположения в массиве. Предоставить схему алгоритма.

yah, 7.11.2009 - 10:21

Задача №2
Code

program Project2;

{$APPTYPE CONSOLE}

uses
 SysUtils;

var
B: array[1..10] of integer=(5,-1,0,8,-7,7,5,-7,-3,2);
i, sum, kol:integer;
begin
sum:=0; kol:=0;
for i:=1 to 10 do
 begin
 write(B[i],' ');
 if(B[i]>0) then
   begin
     sum:=sum+B[i];
     kol:=kol+1;
   end;
 end;
Writeln;
Writeln('CYMMA = ',sum,' Kolichestvo = ',kol);
readln;


end.

kot003, 23.11.2009 - 1:13

Доброе время суток, господа.
Учеба, мать её...

Попалась вот такая задача:
Определить d (день), m (месяц) – дату k-го по счету дня високосного года.
Т.е. есть високосный год. 366 дней. Дается цифра из диапазона 1..366, надо из этой цифры изъять информацию о номере месяца и номере числа в этом месяце

Надо написать прогу на паскале используя выбор варианта по ключу
Сама структура ключа выглядит так, если кому-то более привычно видеть её в таком виде
Code
case K of
k1: d1;
..
kn: dn;
End;


Сам сидел голову ломал - на if понимаю как построить, а на выборе варианта по ключу - что-то проблематично.
Причем нельзя использовать массивы и подобные вещи. if для контроля вводимых данных и выбор по ключу для самого алгоритма

Огромное спасибо за внимание!

HoKi, 24.11.2009 - 15:44

Хм,можно вопрос?Можно ли на паскале написать прогу,чтобы когда вставляешь флешку в чужой комп,открываешь на флешке программу,нажимаешь кнопочку,и с компьютера на флешку незаметно копируются к примеру "Мои рисунки"?

charodey_mag, 24.11.2009 - 15:47

Можно. Такие программы называются троянцы. Поищи, в инете их много...

de1ay, 25.11.2009 - 3:45

HoKi, можно.


charodey_mag, такие программы называются копировальщиками файлов. smile.gif Никак не "троянцами".

yah, 25.11.2009 - 10:01

Цитата | Quote(kot003 @ 23.11.2009 - 2:13)
Попалась вот такая задача:
Определить d (день), m (месяц) – дату k-го по счету дня високосного года.
Т.е. есть високосный год. 366 дней. Дается цифра из диапазона 1..366, надо из этой цифры изъять информацию о номере месяца и номере числа в этом месяце

*



Цитата | Quote
program Project2;

{$APPTYPE CONSOLE}

uses
 SysUtils;
var k:integer;
begin

Write('Vvedite nomer dnya: ');
Readln(k);

 case k of

 1..31: Writeln('Yanvar, ', k);
 32..60: Writeln('Fevral, ', k-31);
 61..91: Writeln('Mart, ', k-60);
 92..121: Writeln('Aprel, ', k-91);
 122..152: Writeln('Mai, ', k-121);
 153..182: Writeln('Iyun, ', k-152);
 183..213: Writeln('Iyul, ', k-182);
 214..244: Writeln('Avgust, ', k-213);
 245..274: Writeln('Sentyabr, ', k-244);
 275..305: Writeln('Oktyabr, ', k-274);
 306..335: Writeln('Noyabr, ', k-305);
 336..366: Writeln('Dekabr, ', k-335);
 end;

ReadLn;
end.

HoKi, 25.11.2009 - 10:11

de1ay,ой там всё сложно и не по-русски..но всё равно спасибо,может разберусь =)

kot003, 25.11.2009 - 11:01

yah,

Благодарю. А я решил эту задачу более гуманным способом biggrin.gif
Не слишком в лоб )

Цитата | Quote
Program date; {
Определить d (день), m (месяц) – дату  k-го по счету дня високосного года.
Входные данные: k - номер по счету дня
                          d,m - дата и месяц}
var k,d: Real;
    mth,a: byte;
    m: string;
Begin
    Writeln('Введите порядковый номер дня в году: ');
    Readln(k);
    if (k < 1) AND (k > 366) then
          Begin
          writeln('Число задано неверно!'); halt;
          End;
    d:=k;
    for mth:=1 to 12 do
        Begin
              case mth of
                  1,3,5,7,8,10,12: a:=31;
                  2: a:=29;
                  4,6,9,11: a:=31;
              end;
              if d > a then d:=d-a else break;
        end;

    case mth of
          1: m:='Января';
          2: m:='Февраля';
          3: m:='Марта';
          4: m:='Апреля';
          5: m:='Мая';
          6: m:='Июня';
          7: m:='Июля';
          8: m:='Августа';
          9: m:='Сентября';
          10: m:='Октября';
          11: m:='Ноября';
          12: m:='Декабря';
    End;
    Writeln(k,'-й день в году - ',d,'-е ',m);
End.

serega1313, 12.12.2009 - 21:24

Помогите решить две задачи,ко вторнику надо,а врубится никак не могу:
Цитата | Quote
1. Дано арифметическое выражение, операндами которого являются целые положительные числа, а разрешенные операции "+" и "*". Требуется расставить знаки так, чтобы результат вычисления был максимальным.

и вторая:
Цитата | Quote
2. Заполнить массив А размером 6х4 следующим способом (смотри картинку)

charodey_mag, 14.12.2009 - 13:50

На счет первой не совсем понятно откуда берутся операнды и операторы.

А по второй:
Code


var a:array [0..5,0..3] of byte;
 i,j:integer;
begin
for i:=0 to 5 do
 for j:=0 to 3 do
   a[i,j]:=24-i-i*-2*(j mod 2)-j-10*((j+1) div 2);

//вывод
for i:=0 to 5 do
begin
 for j:=0 to 3 do
 Write(a[i,j],' ');
Writeln('');
end;
readln;
end.

kos1993, 23.11.2010 - 19:51

1)Дан текст . Подсчитать общее число вхождений в него символов "+" и "-".

2)Дано слово, оканчивающее символом "-".Составить программу, которая вставляет некоторую заднюю букву с заданным номером.

3)Получить все шестизначные счастливые номера. Счастливым называют такое шестизначное число, в котором сумма его
первых трёх цифр равна сумме его последних трёх цифр. (Определить функцию для расёта суммы цифр трёхзначного числа).

4)Составить программу для нахождения общего количества заданной буквы в трёх заданных предложениях. (Определить функцию
для расчёта количества некоторой буквы в предложении).

5)Известен рост каждого ученика класса. Рост мальчиков условно задан отрицательными числами. Верно ли, что средний
рост мальчиков превышает средний рост девочек более чем на 10 см?

6)Дан двумерный массив из двух строк и двадцати двух столбцов. В его первой строке записано количество мячей, забитых
футбольной командой в той или иной игре, во второй - количество пропущеных мячей в этой же игре.
В) Определить количество выйгрышей и количество проигрышей данной команды.
Г) Определить количество выйгрышей, количество ничьих и количество проигрышей данной команды.

7)Имеется текстовый файл. Переписать в другой файл те его строки, в которых имеется более 30-ти символов.

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

sanya-dikiy, 17.12.2010 - 23:18

Здравствуйте, уважаемые smile.gif
Очень нужна ваша помощь - как разобраться с задачей такого плана:

[HIDE]https://softoroom.org/...php/i6289_.png


Буду благодарен за любую помощь.[/HIDE]

Все, сам разобрался smile.gif


версия для печати -> Полная версия

SoftoRooM © 2004-2024