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

EVenom

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

program prog2;
var M:Real;
x,S,n,code,i,a,k:Integer;
n_str:String;
begin
Write('Введите M: ');
Readln(M);
Write('Введите x: ');
Readln(x);
k:=0;
n:=1;
While n<M do
begin
Str(n,n_str);
S:=0;
For i:=1 to Length(n_str) do
begin
val(n_str[i],a,code);
S:=S+a; {подсчитывается сумма цифр}
end;
if sqr(S)=x then inc(k) {квадрат суммы цифр сравнивается с введенным числом x }
inc(n);
end;
Write('Количество искомых чисел=',k);
Readln;
end.

Здравия желаю.
Проблема в следующем. Надо написать прогу для курсовухи на паскале, отвечающей требованиям указанным ниже. Если кто в курсе манёвров с бинарными деревьями, то к вам есть вопросы.

1. Возможна ли обработка данных в деревьях, не применяя рекурсию. Понимание как пошагово действуют рекурсивные процедуры (для новичка), чуть затруднительно + к этому добавляются указатели. А хотелось бы конкретно разобраться, как работает дерево с кодом (сам принцип понятен).
2. Может кто даст ссылку на литер. с детальным описанием двоичных деревьев (с разборкой кода по шагам, для чайников так сказать). Или может уже, где нить обсуждалась такая тема? Прошу в темы о литер. не гнать, если не знаете просто ни чего не говорите. Я чел работающий и в бесполезных поисках по инету шариться времени не очень имею (да и задолбало).
3. Для начала, если кому не трудно может, выложите код считывания данных из файла в дерево, а там глядишь и сам допру до остального.
4. Так же, буду благодарен за предложенные алгоритмы действий к оной программуле.

Вот собсна и требования к программе и возникшие по ходу вопросы (не исключаю, что некоторые пункты попросту не корректно перевёл):
1. Создать составную структуру данных, которая состоит из:
1.1 одного уникального, неповторяющегося поля (что такое уникальное поле? разве любое поле ни есть уникально?)
1.2 не менее трёх текстовых полей
1.3 одного составного поля (что это значит?)
1.4 не менее одного числового поля
2. Записать данные в файл.
3. Считать данные из файла в двоичное дерево.
4. Исполнять обработку данных в двоичном дереве:
4.1 Добавить данные
4.2 Удалить данные
4.3 Редактировать данные
4.4 Отпечатать данные
4.5 Выполнять вычисление значения в числовом поле
4.6 Выполнять поиск по всем полям (наверно имеется ввиду по любому из полей)
5. Записать обработанные данные обратно в файл данных.

Хочу часть программы записать в процедуру. Должна читать из файла строку, проверяеть условия, и если все ОК выдавать эту строку программе. Не знаю как описать парметры. Часть программы:
begin
str:='*****'; {не обращайте внимания }
repeat
if (str<>#10'') and (str<>'') then { тут проверка условия на пустую строку}
ReadLn(f, str); {чтение из файла}
until pos(d[4],str)<>0; {проверка}
end;
str- переменная string
f- файловая переменная
d[1..4] массив из четырех строк
из всех переменных в процедуре должна меняться только str.

daMIR
Тебе нужна не процедура, а функция. Объяви f, d[1..4] глобальными переменными
Код:
function MyFunc: string;
var str: string;
begin
str:='*****';
repeat
if (str<>#10'') and (str<>'') then { тут проверка условия на пустую строку}
ReadLn(f, str); {чтение из файла}
until pos(d[4],str)<>0; {проверка}
Result:=str;
end;

gpi
т.е. str присвоить тип функция? проблема еще в том, что если выполняется проверка на условие то функция/процедура должна отправить значение обратно, я не знаю как это сделать. Использовать GOTO?

daMIR
str:=MyFunc - глобальной переменной str присваивается значение, возвращаемое MyFunc.
Result:=str; - эта строка присваивает результату функции значение локальной переменной str, объявленной в самой функции и вычисленной в ходе выполнения функции

gpi
Все сообразил, спасибо. Только теперь понял нельзя ее как функцию описывать Три раза код придеться повторять, все из-за проверок- в каждом случае он свой (d[1], d[2],d[3]).
З.Ы. если кому интересно, могу после выложить готовую программу- редактирует рассылку сайта anekdot.ru для печати

daMIR

Цитата:

Три раза код придеться повторять, все из-за проверок- в каждом случае он свой (d[1], d[2],d[3]).

Добавь параметр в вызов функции function MyFunc(i: integer): string; а в коде
until pos(d[i],str)<>0;

gpi
Спасибо! только я описал ее как процедуру, мне так понятнее А как сделать паузу в Паскале? Т.е. чтобы он выводил мессагу, а через пару секунд ее убирал?

daMIR

Цитата:

А как сделать паузу в Паскале? Т.е. чтобы он выводил мессагу, а через пару секунд ее убирал?

Delay(ms) только учти что зависит от проца, то есть на медленных работает как надо, а на быстрых надо цифирку в мс побольше ставить (если только я с бейсиком не путаю )

ShIvADeSt
Вроде путаешь "Неизвестный индефикатор" ну да ладно, обошелся ReadLn, лишний раз придеся кнопку нажать
Если кого интересует, могу выложить прогу/ехе-шник для редактрирования рассылки анедктов для печати, сделал наконец

Bacyla
Есть правило, которое гласит, что любую задачу, решенную с помощью рекурсии можно решить без нее.
В нете море примеров обхода дерева и рекурсивно и итеративно, в частности на Паскале (вот одна из первых попавшихся ссылок http://comp-science.narod.ru/Progr/BinTree.htm). Если для тебя все они слишком сложны, от извиняй, но сама тема не совсем чайниковская. Хочешь сам написать программу, прийдется пошевелить мозгами. Будут проблемы с кодом - задавай конкретные вопросы.

daMIR
Для использования Delay(ms) нужно добавить uses crt;

нужны Графические программы на Pascal
Анимации.. видео... Главное, чтобы запускались с одного PAS-файла. Буду очень признателен.

Очень нужно решить данную задачу!

число n <1.000.000.000 (милиарда) СКОЛЬКО цифр в числе,сумма цифр в числе,четно ли число?

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

ну так а в чем проблема?

Цитата:

СКОЛЬКО цифр в числе

Код:
count:int = 0;
n:longint;
...
while(n > 0)
begin
count :=count +1;
n= n div 10;
end

Haikojan

Цитата:

Очень нужно решить данную задачу!

число n <1.000.000.000 (милиарда) СКОЛЬКО цифр в числе,сумма цифр в числе,четно ли число?

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

Несколько вариантов:
1. см. выше
2.

Код: Uses Crt;
var Sum, C: Longint;
S : String;
N : Longint;
I : Longint;
E : Integer;
Begin
ClrScr;
Write( 'N =>' );
ReadLn( N );
Str( N, S );
WriteLn( 'Count = ', Length( S ) );
Sum := 0;
for I := 1 to Length( S ) do
Begin
Val( S[I], C, E );
Inc( Sum, C );
end;
WriteLn( 'Sum = ', Sum );
WriteLn( 'Mod ', N mod 2 ); {если ноль значит четно}
ReadLn;
end.

Задача из моего обучения, лотерея АВТОМОБИЛЬ, работает.
КОД:
program loto;
uses crt;
var sum2,sum1,sum,x,y,i,j:integer;
s:byte;
mm:array [1..4,1..4] of char;
c,key:char;
st:string ;
f,f1:text;
begin
assign(f,'c:\proigr.txt');
reset(f);
readln(f,sum);
close(f);
assign(f1,'c:\viigr.txt');
reset(f1);
readln(f1,sum2);
close(f1);
randomize;
sum1:=0;
clrscr;
st:='АВТОМОБИЛЬ';
gotoXY(1,4);
textcolor(red);
textBackGround(green);
writeln('Помощь нажать F1');
gotoXY(30,23);
textcolor(yellow);
textBackGround(green);
writeln('Счётчик проигрышей: ');
textcolor(yellow);
for i:=1 to 4 do
for j:=1 to 4 do
begin
textBackGround(red);
gotoXY(j*2+31,i+11);
write(' ');
gotoXY(j*2+32,i+11);
write('*');
mm[i,j]:='*';
end;
textBackGround(black);
gotoXY(34,12);
for s:=1 to length(st) do
begin
repeat
i:=random(4)+1;
j:=random(4)+1;
until mm[i,j]='*';
mm[i,j]:=st[s];
end;
i:=1;
j:=1;
repeat
textBackGround(black);
key:=readkey;
case key of
#59: begin
textcolor(yellow);
textBackGround(blue);
gotoXY(1,5);
for i:=1 to 4 do
begin
for j:=1 to 4 do
write(mm[i,j],' ');
writeln;
end;
end;

#72: begin
i:=i-1;
if i<1 then i:=1;
end;
#75: begin
j:=j-1;
if j<1 then j:=1;
end;
#77: begin
j:=j+1;
if j>4 then j:=1;
end;
#80: begin
i:=i+1;
if i>4 then i:=1;
end;
#13: begin
if mm[i,j]='*' then
begin
sound(500);
delay(500);
textcolor(blue);
write('Q');
nosound;
gotoXY(26,3);
textcolor(red);
textBackGround(white);
writeln('Продул, ХА, ХА, ХА !!!');
gotoXY(31,4);
writeln('Нажми ESC !!!');
sum:=sum+1;
gotoXY(50,23);
textcolor(yellow);
textBackGround(green);
rewrite(f);
writeln(sum);
write(f,sum);
close(f);
end else
begin
textcolor(yellow);
write(mm[i,j]);
textcolor(red);
textBackGround(white);
gotoxy(32+pos(mm[i,j],st),1);
if mm[i,j]='О' then
begin
delete(st,4,1);
insert(' ',st,4);
end;
write(mm[i,j]);
sum1:=sum1+1;
textcolor(red);
textBackGround(white);
gotoxy(60,12);
writeln('Открыто букв:',sum1);
end;
end;
end;
gotoXY(j*2+32,i+11)
until (key=#27) or (length(st)=sum1);
if length(st)=sum1 then
begin
sum2:=sum2+1;
clrscr;
textBackGround(black);
gotoXY(30,12);
textcolor(red);
textBackGround(white);
writeln('Поздравляю! Вы Выиграли!');
gotoXY(48,24);
textcolor(yellow);
textBackGround(green);
rewrite(f1);
writeln(sum2);
write(f1,sum2);
gotoXY(30,24);
writeln('Счётчик выигрышей:');
close(f1);
readln;
end;
end.

Добрый день. Помогите решить

===
Задача 1.
Составить процедуру на языке Паскаль для реализации в среде Делфи, которая для массива типа array[1..20, 1..15] of integer определит наибольший элемент с парными индексами и наименьший элемент с непарными индексами. Значение элементов массива предварительно вводятся с помощью компонента на имя sg типа StringGrid.
===

Я никак не пойму, что такое парные/непарные индексы. Бросте в меня кодом, буду признателен!

Помогите решить.
Написать программу, в которой задача вычисления суммы N-слагаемых ряда оформлена через функцию и процидуру :
Дан ряд :
S=1-(x2/2)+(x4/4)-(x6/6)+…..
Обратиться к function и procedure дважды для вычисления :
1) S1, полагая X1=1,9 n1=5
2) S2, полагая X1=3,4 n2=7
Вывести результат на экран.

Если кто может помогите пожалуйста .............. Заранее спасибо.

mazafakermazafaka
Может парные имются в виду одинаковые? Т.е. 1.1, 5.5 и т.п? Что значит в среде Делфи??? И что это за тип StringGrid? А просто задача с поиском наибольшего/наименьшего простая.
Mihey88
Тебе нужны две раздные задачи через процедуру и функцию?

Добавлено:
Что это за выражение?
S=1-(x2/2)+(x4/4)-(x6/6)+…..
ведь х*2/2=х? Между втрой и третьей скобой должен быть минус или это опечатка? Приведи не сокращенное выражение.
X1= равен 3.4 или сначала 3, потом 4?
Примерная программка, нужно доработать.

program mixey;
const
n1=5; n2=7;
x1=1.9; x2=3.4;
var
n:LongInt;
s,x:real;
procedure sum_n;
var
i,m:longInt;
begin
m:=0;
s:=0;
for i:= 1 to n do
begin
m:=m+2;
s:=s+x*m/m;
end;
s:=1-s;
end;

begin
x:=x1; n:=n1;
sum_n;
WriteLn('V pervom sluchae s=',s);
x:=x2; n:=n2;
WriteLn('Vo vtorom sluchae s=',s);
WriteLn('Press <ENTER>');
ReadLn;
end.

Цитата:

Тебе нужны две раздные задачи через процедуру и функцию?

Добавлено:
Что это за выражение?
S=1-(x2/2)+(x4/4)-(x6/6)+…..
ведь х*2/2=х? Между втрой и третьей скобой должен быть минус или это опечатка? Приведи не сокращенное выражение.
X1= равен 3.4 или сначала 3, потом 4?
Примерная программка, нужно доработать.

Спасибо за пример!
ту значит X во второй. четвертой степени и т. д. (как на етом форуме степень записывать, а то я из ворда вставил и всё перепуталось?) Выражение может иметь бесконечное кол-во членов и знак чередуется. прикол в том что надо посчитать (как я сегодня узнал) не сумму до N значения, а Именно только N-ое значение с учётом знака + или - (к примеру -x в восьмой степени /8). Сделать через фукцию или процедуру
А X1=3,4
Спасибо за помощь!!!!!!!!!!!!!

Mihey88
Незачто... если тебе это помогло.
Просто у тебя два случая было, поэтому я предоложил что значений n- всего два.
В таком случае тоже ничего трудного- если тебе нужно подсчитать именно n-ый член а не все уравнение, то система, наверно, такая:
вводиться число n, Х умножается на Х n раз -1, т.е.:
for i:= 1 to n-1 do
X:=X*X;
узнать знак (-или+) тоже не трудно n/10 и если остаток четный то +, если нечетный, то минус (из условия выходит, что степенеи кратны 2).
То что получиться поделить на n. Вот и все вроде... Задачу писать неохота, но думаю тут ничего сложного нет

daMIR


Цитата:

думаю тут ничего сложного нет

Конечно не сложно, когда тебе всё на блюдце приподносят! Щас сяду и доведу эту лабу до ума! Спасибо за помощь!
Как степень на этом форуме записать, уж больно интересно?

Цитата:

Как степень на этом форуме записать, уж больно интересно?

Пиши x^y - все программеры поймут.

Здравствуйте. Нужна помощь.
Есть задача
---
найти У= сумма 1/((2*n+1)*x^(2*n+1)) при n от 0 до бесконечности, с точностью е=10^(-5)
для х на интервале от 1,5 до 2,5 с шагом 0,1
решить используя рекуррентную формулу
для проверки использовать
y=ln((x+1)/(x-1))
---
задачку я решил

Код:
program a;

const
eps=1e-5;
var
x,a,y,y2,y3,t:real;
n:integer;
begin
y:=0;
x:=1.5;
for n:=0 to 38 do
write('-');
writeln;
writeln('| X | Y1 | Y2 |');
for n:=0 to 38 do
write('-');
writeln;

repeat
y2:=0;
n:=0;
a:=1/x;
while abs(a)>eps do
begin
y2:=y2+a;
a:=(a*(2*n+1))/((2*n+3)*x*x);
n:=n+1;
end;
y:=0.5*(ln((x+1)/(x-1))); { prowerka }
writeln('| ',x:3:1,' | ',y:8:5,' | ',y2:8:5,' |');
x:=x+0.1;
until x>2.5;

for n:=0 to 38 do
write('-');
writeln;
end.

Всем Привет, срочно нужна прога...

Нарисовть в Turbo ПАСКАЛЕ фигуру (прикольную какуюто) минимум - из 5ти примитивов, внизу справа на экране...Плз очень горит....

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

AddMen, Ну ты даешь! ГДЕ ТЫ УВИДЕЛ РЕКУРСИЮ? Обычные циклы....

Однака стоит поучить матчасть.

Здрасте всем... Помогите решить задачи в паскале....
============================================================
Даны целые числа M и N (0<M<=12, 0<=N<=60), указывающие момент времени: «M часов, N минут». Определить наименьшее время (число полных минут), которое должно пройти до того момента, когда часовая и минутная стрелки совпадут.
============================================================
Дана строка символов. Группы символов, разделенные пробелами (одним или несколькими) и не содержащие пробелы внутри себя, будем называть словами. Удалить из каждой группы идущих подряд более двух цифр, которой предшествует точка, все цифры начиная с третьей (например, 5+0.1234-98.54+123.4 преобразуется в 5+0.12-98.54+123.4).
============================================================
Изобразить на экране N кривых-эвольвент, образованных точкой, лежащей на прямой, обкатывающейся по окружности без скольжения. Каждая эвольвента строится при обкатывании по дуге в 2pi/N угловых градусов.
============================================================
Дан файл F, содержащий сведения о кубиках: размер (длина его ребра), его цвет и материал. Найти количество кубиков данного цвета и их суммарный объем.
============================================================
Помогите кто чем может... за ранее спасибо =))

mad0max

Цитата:

Однака стоит поучить матчасть.

Кому? Прочитал несколько раз пост AddMen но не нашел в нем слова рекурсия. Так для справки, рекурентное выражение это выражение типа y2:=y2+a; где новое значение переменной присваивается исходя из его старого значения.