» Задачи на Turbo Pascal 7.0

Ну ты хоть бодскажи!!!

AnTul
У меня времени нет

found

Цитата:

Народ подскажите пожалуйста как в Pascale можно описать переменую содержащую в себе 11 цифр. И эта переменная участвует в цикле For.

Описать никак, можно воспользоваться помощью длинной арифметики, где то здесь была отдельная тема, в любом случае в цикле for ее нельзя использовать .
AnTul

Цитата:

Что-то народ не подсказывает... Наверное, уже не изучают Паскаль нигде. А те, кто изучал - забыли.

Возможно, чем ждать помощи лучше самим взять и разобраться.

found
Есть специальный 64-битный тип comp для хранения очень больших целых чисел (-9.2e18..9.2e18) на 19-20 цифр. А вместо for можно while использовать:

Код: {$N+} { включение аппаратной поддержки операций с плавающей точкой }
var i : comp;
Begin
i:=1;
while i<=1e12 do {то бишь до 1'000'000'000'000}
Begin
{чего-нибудь}
i := i+1;
End;
End.

Помогите пожайлусто написать пару программ. Они не сложные, но разобраться самостоятельно не успею. Катастрофически не хватает времени!
1)вывести на печать значение функции z= sin(x)+cos(x), находящемся в интервале (0,2;0,8) для Х , изменяющегося на отрезке [-4,6]с шагом 0.91 (долно быть решено с использованием цикла с предусловием).
2)Найти ср.арифметическое отрицательных чисел, введённых с Клавы. Всего ввести N различных чисел(цикл с постусловием). Заранее спасибо

kanogen
Надеюсь, правильно понял условие
[more=Решение обеих задач]
1.
Код:
var x,y:single;
begin
x:=-4;
while (x<6) do
begin
y:=sin(x)+cos(x);
if (y>=0.2) or (y<=0.8) then
writeln('pri x=',x:2:2,' y=',y:2:2);
x:=x+0.91;
end;
readln;
end.

Хорошая задача

Дан массив размером N x N.
N задаётся произвольно, но не больше к примеру 50, (т.е. N <= 50)

Массив надо заполнить, числами, начиная с 1 заканчивая N^2 в порядке (как бы это выразиться?) спирали, направленной по часовой стрелке. Затем массив вывести на экран

Примеры:
для N=3 должно получиться следующее:

1 2 3
8 9 4
7 6 5

для N=4 должно получиться следующее:

1 2 3 4
12 13 14 5
11 16 15 6
10 9 8 7

Две задачи на паскале -- наполовину решенные Требуется помощь


Код:
uses crt;
const
n=5;

var
a:array[1..n,1..n+1] of real;
i,j,t,i1,j1:integer;
k:real;
begin
clrscr;
randomize;
for i:=1 to n do
begin
for j:=1 to n+1 do
begin
a[i,j]:=random(40)+1;
write(a[i,j]:5:1);
end;
writeln;
end;

for t:=1 to n-1 do
begin
for i:=t+1 to n do
begin
k:=-1/a[i,t]*a[t,t];
for j:=t to n+1 do
begin
a[i,j]:=a[i,j]*k+a[t,t];
end;
end;
end;

writeln;

for i:=1 to n do
begin
for j:=1 to n+1 do
begin
write(a[i,j]:7:1);
end;
writeln;
end;
writeln;

for t:=n downto 1 do
begin
for i:=n-1 downto 1 do
begin
k:=-1/a[i,t]*a[t,t];
{writeln(k);readln;}
for j:=n downto t-n+i do
begin
{ writeln(' I:',i,' J:',j,' A:',a[i,j]);readln; }
a[i,j]:=a[i,j]*k+a[t,t];
{ writeln(a[i,j]);readln; }
end;

for i2:=1 to n do
begin
for j2:=1 to n+1 do
begin
write(a[i2,j2]:7:1);
end;
writeln;


end; readln

end;
end;

writeln;

for i:=1 to n do
begin
for j:=1 to n+1 do
begin
write(a[i,j]:7:1);
end;
writeln;
end;

readln;
end.

jONES1979

Цитата:

Массив надо заполнить, числами, начиная с 1 заканчивая N^2 в порядке (как бы это выразиться?) спирали, направленной по часовой стрелке.

Решил

[more]

Код: uses crt;
const n=5;
type t_d = array [0..3] of record
x: shortint;
y: shortint;
end;
const d: t_d = ((x:1; y:0), (x:0; y:1), (x:-1; y:0), (x:0; y:-1));
var mas: array [0..n-1,0..n-1] of integer;
len,R,x,y,i,j,p,k,step:integer;
begin
len:=trunc(ln(n*n)/ln(10))+1;
{len-skolko cifr otvoditsia pod kajdoe choslo pri vivode na ekran}
clrscr;
x:=0; y:=0;
i:=1;
R:=n-1;
for k:=0 to trunc(n/2)-1 do {k-nomer kolca, k=0-samoe vneshnee}
begin
{x:=k; y:=k; mas[k,k]:=i}
step:=0;
mas[x,y]:=i;
i:=i+1;
p:=4*R-1; {skolko elementov esche ostalos na etom kolce}
for j:=1 to p do
begin
x:=x+d[step].x;
y:=y+d[step].y;
mas[x,y]:=i; {x-stolbec, y-stroka}
i:=i+1;
if (j mod R=0) then
step:=step+1;
end;
x:=x+d[0].x;
y:=y+d[0].y;
R:=R-2;
end;
if (R=0) then mas[x,y]:=i; {R budet=0 esli 'n' bilo nechetnoe=>
poslednee kolco sostoit iz odnogo elementa;
vmesto etogo 'if' mojno izmenit' cikl na
for k:=0 to trunc(n/2)-1+(n mod 2) }

for x:=0 to n-1 do
begin
for y:=0 to n-1 do
write(mas[y,x] :len,' ');
writeln;
end;
readln;
end.

sonicp

Прикольна!
Напоминает мой вариант решения №2. Только вместа расчета кол-ва колец и элементов в нём я использовал другой принцип. В какой-то книжеке давным-давно читал про низкоуровневый алгоритм того как в 2d-графике заливают области, анализируя соседние пиксели...
А про шаги (их направление) похоже!

[more=Код...]

Код: program z3_v2;
{$B-} {because $B+ will generate error in NeedTurn function}
uses Crt;
const nmax=100;

var a:array [1..nmax,1..nmax] of integer;
yy,xx, i ,n, ax, ay : integer;
mode : 0..3;

procedure set_Ax_Ay;
begin
case mode of
0: begin ax:=1 ; ay:=0 ; end;
1: begin ax:=0 ; ay:=1 ; end;
2: begin ax:=-1 ; ay:=0 ; end;
3: begin ax:=0 ; ay:=-1 ; end;
end;
end;

procedure Turn;
begin
mode := (mode+1) mod 4;
set_Ax_Ay;
end;

function NeedTurn: boolean;
begin
NeedTurn:= ((xx+ax) > n) or ((xx+ax) < 1) or
((yy+ay) > n) or ((yy+ay) < 1) or
(a[xx+ax,yy+ay]>0) ;
end;

begin
clrscr;
write('give me N: ');
readln(n);

{set initial values}
for yy:=1 to n do
for xx:=1 to n do a[xx,yy] := 0;

mode:=0;
xx:=0; yy:=1;
set_Ax_Ay;

{computation}
for i:= 1 to sqr(n) do
begin
if NeedTurn then Turn;

xx:= xx + ax;
yy:= yy + ay;
a[xx,yy] := i;
end;

{output}
for yy:=1 to n do
for xx:=1 to n do
begin
GotoXY(1+4*xx,3+yy);
Write(a[xx,yy]:2);
end;

writeln;
writeln;
writeln('press Enter');
readln;
end.

болъшое спасибо

Мой вариант решения №1.

Массив заполняется "в лоб"

[more=Код1]

Код:
program z3;
uses Crt;
const nmax=50;

var a:array [1..nmax,1..nmax] of integer;
yy,xx,y, n, v: integer;

function Next_n: integer;
begin
inc(v);
Next_n:= v;
end;

begin
clrscr;
write('give me N: ');
readln(n);

{computation}
v:=0;
for xx:=1 to n do
begin
inc(v); a[xx,1]:=v;
end;

for YY:= 2 to n do
if (YY mod 2)= 0 then
begin
for Y:= YY to n do
a[ n - (yy div 2 -1), y - (yy div 2 -1)]:=Next_n;
for Y:= n downto YY do
a[ y - (yy div 2), n - (yy div 2 -1)]:=Next_n;
end
else
begin
for Y:= n downto YY do
a[ (yy div 2), y - (yy div 2) ]:=Next_n;
for Y:= YY to n do
a[ y - (yy div 2), (yy div 2) + 1 ]:=Next_n;
end;

{output}
for yy:=1 to n do
for xx:=1 to n do
begin
GotoXY(1+4*xx,3+yy);
Write(a[xx,yy]:2);
end;
readln;
end.

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

Вот такая ситуация:
Через два дня экзамен по инфе, препод дал задачку и если я ее сделаю то экзамен автоматом она поставит!!! Помогите, я примерно половину задачи знаю как делать а половину нет!
Описание:
Неоходимо вывести на экран прямоугольники следующие друг за другом в шахматном порядке( препод назвал это "змейкой"). еще нужно сделать так чтобы эта "змейка" двигалась,т.е. например появляется 4 прямоугольник, а первый исчезает и т.д.
модуль GRAPH нельзя использовать только CRT; параметры window(x1,y1,x2,y2) нужно сделать через переменные.
желательно успеть до четверга. заранее огромное спасибо.
если что кидайте на мыло Zeriiick@yandex.ru

подскажите где ошибка...

program summa;
uses crt;
const i=1; n=30; e=2.7;
var f,t,h,x: real;
begin
clrscr;
writeln('Vvedite x');
readln(x);
f :=t/h;
t :=((exp(x/i)*ln(e))+(exp((-x)/i)*ln(e)));
h :=(exp(4)*ln(i+2));
writeln('otvet:f= ,f');
readln;
while KeyPressed do ReadKey;
ReadKey;
end.

Напишите плиз прожку кому не сложно до затра нужно:

Дана последовательность pазличающихся между собой слов, составленных
из символов английских букв и цифp. В пеpвом слове последовательности
цифpы отсутствуют. Слова в последовательности pазделены несколькими
пpобелами. Последовательность завеpшается сочетанием ' *'.
Длина отдельного слова не пpевосходит 5 символов.
Постpоить сбалансиpованное деpево и pаспечатать его. Напечатать,
начиная с главного коpня деpева до листьев все пути по веpшинам, котоpые
не содеpжат символов цифp.

Пpимеp:
последовательность: АА ВТ НТА 7АВ С5РА РАТ МСВ ТА *
деpево:
ТА
7АВ пути:
ВТ АА ВТ РАТ
РАТ АА НТА МСВ
АА
С5РА
НТА
МСВ

DmitryV

Код: f :=t/h;
t :=((exp(x/i)*ln(e))+(exp((-x)/i)*ln(e)));
h :=(exp(4)*ln(i+2));
writeln('otvet:f= ,f');

...посмотрите может кто-поможет...заранее спасмбо
============================================================
Даны три вещественных числа. Используя только два неполных условных оператора, определить:
а) максимальное значение заданных чисел;
б) минимальное значение заданных чисел.

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

uses crt; var a,b,c,max,x:integer;
begin clrscr;
writeln('vvedite a,b,c'); readln(a,b,c);

if (a>b) and (a>c) then writeln ('max=',a);
if (b>c) and (b>a) then writeln ('max=',b)

readln;
end.
============================================================
11.7. Заполнить массив из двадцати элементов следующим образом:
20    19    …    1

var m:array [1..20] of integer; i:integer;
begin
for i:=20 downto 1 do begin

во тут я незнаю как....

end;
readln;
end.
============================================================
Дан двухмерный массив. Найти:
б) сумму элементов каждого столбца


const n=5; m=5;
var a:array[1..50,1..50]of integer; s1,s2,s3,s4,s5,i,j:integer;
begin randomize;
for i:=1 to n do
for j:=1 to m do
a[i,j]:=random(50);
for i:=1 to n do begin
for j:=1 to m do
write(a[i,j]:3);
writeln;end; writeln('**************');
for i:=1 to n do
s1:=s1+a[i,1];
s2:=s2+a[i,2];
s3:=s3+a[i,3]; .....короче из этого тоже надо сделать цикл
s4:=s4+a[i,4]; чтоб не пришлось вот так каждый раз вводит S......
s5:=s5+a[i,5];
writeln('сумма первого столбца=',s1);
writeln('сумма второго столбца=',s2);
writeln('сумма третьего столбца=',s3);
writeln('сумма четвёртого столбца=',s4);
writeln('сумма пятого столбца=',s5);
readln;
end.
===========================================================
Дано предложение. Удалить из него все буквы о, стоящие на нечетных местах

А эта прога у меня че то не работает.....
USES crt;
VAR p,s:string; i,k:integer;
Begin clrscr;
WRITELN('Введите предложение');
readln(p);
FOR i:=1 to length(p) do
if not length(p) mod 2=0 then
if p[i]='o' then delete(p,i,1);
writeln(p);
readln
end.
====================


ЗАРАНЕЕ СПАСИБО !!!!!!

1. А нельзя таким образом:
max:=c;
if (a>b) and (a>c) then max:=a;
if (b>c) and (b>a) then max:=b;
writeln ('max=',max);

Добавлено:
2.
for i:=20 downto 1 do
m[21-i]:=i;

Добавлено:
Суммы элементов каждого столбца нужно описать в виде массива:
S: array[1..m] of Integer;

Код нахождения сумм:
For i:=1 to m do
begin
For j:=1 to n do
S[i]:=S[i]+a[j,i];
Writeln('Сумма ', i, '-го столбца=', S[i]);
end;

ratmi

Цитата:

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

FOR i:=length(p) downto 1 do
if i mod 2 = 0 then
if p[i]='o' then delete(p,i,1);
writeln(p);

Спасибо!! Rainm спасибо minos14...проги работают...просто замечательно!!!!

...но вот еще прога ...она неправильно работает..

Дано число а (1 < а 1,5). Найти такое наименьшее n, что в последовательности чисел 1+1/2,1+1/3, ..., 1+1/n последнее число будет меньше а.

var S,a:real; n:integer;
begin
writeln('введите числ А');
readln(a);
n:=0;
s:=0;
While S<a do
begin
n:=n+1;
s:=s+1/n;
end;
writeln(n, '-ое число меньше числа ',a:5:4);
writeln('при n = ',n,' S= ',S:5:4);
readln;
end.

ratmi

var S,a:real; n:integer;
begin
writeln('введите числ А');
readln(a);
n:=0;
Repeat
n:=n+1;
S:=1+1/(n+1);
Until S<a;
writeln(n, '-ое число меньше числа ',a:5:4);
writeln('при n = ',n,' S= ',S:5:4);
readln;
end.

вот тут я интересовался тем, что за формат используется для хранения даты и времени у Микрософта:
http://forum.ru-board.com/topic.cgi?forum=33&topic=7017
как было подсказано, используется 64-битовый FILETIME.
а теперь вопрос - как в паскале можно перевести 64-битное время во что-то более удобное для чтения?

написал в Virtual Pascal так:
var co: Comp;
tts:TTimeStamp;
tdt:TDateTime;

...
tts:=MSecsToTimeStamp(co);
tdt:=TimeStampToDateTime(tts);
write(FormatDateTime('d/m/yyyy hh:nn',tdt));

но выводит упорно какие-то 55-тысячные года

1.    Треугольник задан величинами его углов и радиусом описанной окружности. Найти стороны треугольника.
2.    Треугольник задан длинами сторон. Найти длины медиан.

эээммм....можете кто нибудь сделать....киньте хотя бы все формулы

ratmi

На счет окружности - не знаю, да и с медианами мне на ум пришел не слишком простой вариант.

1. Находим площадь треугольника (S) по формуе Герона - через длины сторон и посчитанный полупериметр.

2. Делим одну сторону пополам (например, сторону а) и проводим медиану. Что получаем? Два треугольника с той же высотой, что и у исходного, но с уполовиненным основанием. Это значит, что их площадь ровно в два раза меньше, чем у исходного - S/2.

3. Теперь пишем формулу Герона для одного из половинных треугольников - в него входят медиана к стороне а, а/2 и оставшаяся целой сторона, например, b. Это все (в смысле площадь) равно S/2. Теперь возводим в квадрат и получаем уравнение 4-й степени относительно длины медианы. Очень мило. Но не все так страшно: если сгруппировать множители по два, с расчетом получить разности квадратов, все сводится к биквадратному уравнению (т.е. у него степени при медиане 4, 2 и 0), которое вполне решается. В общем, надо самому эту формулу Герона расписать, и станет понятно, что к чему.


ЗЫ: Тут до меня доперло: надо такую же формулу Герона написать для второго половинного треугольника, тоже возвести в квадрат, раскрыть скобки и вычесть одно из другого. Четвертые степени медианы сократятся, площади исходного треугольника сократятся, останется не такая уж жирная формула - корень из дроби.

Возможно ли в Паскале сделать задачу- чтение имен файлов (по условиям/либо все) из определенной категории? Я так понимаю что нет, так как в процедуре assign reset нужно указать имя файла, к тому же мне нужно не содержимое файла, а его имя.

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

Program lab;
Uses crt;
Var
n,m:Integtr;
fi,s,x,a,b,i:Real;
Otvet:Char;
Begin
Repeat
Writeln('Введите a,b,n,m,x');
Readln(a,b,n,m,x);
S:=0;
i:=m;
While i>=n do
begin
fi:=(exp(i*(ln(-1))))*((a+x*i)/(b+x*i));
i:=m+1;
end;
S:=b*fi+a;
Writeln('S=',S:5:2);
Writeln('Продолжить? y-если да, n-если нет');
Otvet:=Readkey;
Until otvet <> 'y'
End.

Плиз подскажите,я знаю что ln(-1) не существует,но как тогда возвести (-1) в степень i ?? а может ещё где не правельно...ПЛИЗ ПОМОГИТЕ!!!!!

Oleg87
Степень если я не ошибаюсь пишется ^n

daMIR
а как записать?? плиз пожскажи!

Oleg87
Чего ты за глупости разводишь? (-1) в степени i (i - целое судя по твоей программе) будет либо 1 если i - четное, либо -1 если i нечетное. Это ж элементарная математика. Просто проверь остаток от деления i на 2 на равенство нулю (i mod 2) - так выяснишь четное оно или нет. И пиши соответственно 1 или -1.