IPB

Здравствуйте, гость ( Вход | Регистрация )

 
Ответить в эту темуОткрыть новую тему
> Помогите написать процедурку (:, Чистло является полным квадратом
InFuz
сообщение 11.12.2009, 17:43
Сообщение #1


Студент
**

Группа: Продвинутые
Сообщений: 116
Регистрация: 13.10.2009
Город: Ульяновск
Учебное заведение: УлГУ
Вы: студент



Задача: Удалить из массива числа, которые являются полным квадратом и имеют нечетную сумму цифр.
Условие: Массив целоцисленный от -32000 до 32000. (ни каких real (IMG:style_emoticons/default/smile.gif) ). Массив вводится в другой процедуре и есть M:mas, N-длина массива.
Моя процедура которая чот не батрачит ))

procedure Work (var M:mas; N:integer);
var i,b,sym,ost:integer; f:boolean;
begin
for i:=1 to N do
begin f:=true; sym:=0; ost:=0;
b:=m[i];
while b=0 do
begin
ost:=b mod 10;
sym:=sym + ost;
b:=b div 10;
end;
if sym mod 2=0 then f:=false;
if (f=true) and (sqrt(m[i]) in integer) then m[i]:=m[i+1];
end;
end;
Пользователь в офлайнеКарточка пользователяОтправить личное сообщение
Вернуться в начало страницы
+Ответить с цитированием данного сообщения
InFuz
сообщение 12.12.2009, 18:51
Сообщение #2


Студент
**

Группа: Продвинутые
Сообщений: 116
Регистрация: 13.10.2009
Город: Ульяновск
Учебное заведение: УлГУ
Вы: студент



Ну чо слабо помочь что ли?
Пользователь в офлайнеКарточка пользователяОтправить личное сообщение
Вернуться в начало страницы
+Ответить с цитированием данного сообщения
Inspektor
сообщение 12.12.2009, 19:43
Сообщение #3


Аспирант
***

Группа: Активисты
Сообщений: 384
Регистрация: 11.6.2008
Город: Крыжополь
Учебное заведение: БГТУ
Вы: студент



Цитата(InFuz @ 12.12.2009, 21:51) *

Ну чо слабо помочь что ли?

А тебе слабо код нормально написать(с отступами и комментариями)? Такую помойку за "спасибо" никто разгребать не будет.
Пользователь в офлайнеКарточка пользователяОтправить личное сообщение
Вернуться в начало страницы
+Ответить с цитированием данного сообщения
InFuz
сообщение 12.12.2009, 21:28
Сообщение #4


Студент
**

Группа: Продвинутые
Сообщений: 116
Регистрация: 13.10.2009
Город: Ульяновск
Учебное заведение: УлГУ
Вы: студент



procedure Work (var M:mas; N:integer); {М-сам массив, N-длина массива(вычисляется в д.р. процед.)}
var i,b,sym,ost:integer; f:boolean; {i-кол. повторов для for, b-буфер для m[i], sym-сумма цифр числа m[i], ost-цифры числа, f-"флажок" четносли или нечотности sym}
begin {бэгин №1}
for i:=1 to N do {открывает цикл for}
begin f:=true; sym:=0; ost:=0; {бэгин №2,обнуляем все}
b:=m[i]; {b присваеваем значение m[i]}
while b=0 do {завадим "цикл внутри цикла" который считает сумму цифр в числе m[i]}
begin {бэгин №3}
ost:=b mod 10; {находим последнюю цифру в числе}
sym:=sym + ost; {добавляеь ее к сумме всех чисел}
b:=b div 10; {убираем эту цифру из числа}
end; {енд №3}
if sym mod 2=0 then f:=false; {если sym четное тогда флажок опустить}
if (f=true) and (sqrt(m[i]) in integer) then m[i]:=m[i+1]; {весь косяк тут, не знаю как записать "если число является полным квадратом то его удалить"}
end; {енд №2}
end; {енд №1}

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

ну, жду помощи?!

P.S. если кто то пришол на этот форум чтобы заработать (IMG:style_emoticons/default/thumbdown.gif) , а не "помочь за спасибо" я думаю он не туда пришол.
Пользователь в офлайнеКарточка пользователяОтправить личное сообщение
Вернуться в начало страницы
+Ответить с цитированием данного сообщения
Inspektor
сообщение 12.12.2009, 22:03
Сообщение #5


Аспирант
***

Группа: Активисты
Сообщений: 384
Регистрация: 11.6.2008
Город: Крыжополь
Учебное заведение: БГТУ
Вы: студент



Цитата(InFuz @ 13.12.2009, 0:28) *

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

А тег [cоde] для чего по-твоему?
Цитата(InFuz @ 13.12.2009, 0:28) *
P.S. если кто то пришол на этот форум чтобы заработать (IMG:style_emoticons/default/thumbdown.gif) , а не "помочь за спасибо" я думаю он не туда пришол.

А я думаю, что если кто-то обращается за помощью, особенно за безвозмездной, то этот кто-то должен сделать всё возможное, чтобы ему захотели помочь, а не качать права и не возмущаться "Ну чо слабо помочь что ли?". Кстати, что-то я не заметил, чтоб ты тут кому-то как-то помог, зато заметил что с русским языком у тебя не лучше чем с программированием.
Пользователь в офлайнеКарточка пользователяОтправить личное сообщение
Вернуться в начало страницы
+Ответить с цитированием данного сообщения
Julia
сообщение 13.12.2009, 2:35
Сообщение #6


Ассистент
****

Группа: Julia
Сообщений: 593
Регистрация: 23.2.2007
Город: Улан-Удэ
Учебное заведение: БГУ
Вы: преподаватель



1) while b=0 do
Это условие ПРОДОЛЖЕНИЯ цикла. У вас получилось, что пока число равно 0, вы получаете у него последнюю цифру. Нелогично.
2) Удаление элементов лучше делать в самой программе, а не в процедуре.
3) Чтобы определить является ли число полным квадратом можно, например, определить множество полных квадратов и проверять элементы массива на вхождение в это множество.
Пользователь в офлайнеКарточка пользователяОтправить личное сообщение
Вернуться в начало страницы
+Ответить с цитированием данного сообщения
InFuz
сообщение 14.12.2009, 15:24
Сообщение #7


Студент
**

Группа: Продвинутые
Сообщений: 116
Регистрация: 13.10.2009
Город: Ульяновск
Учебное заведение: УлГУ
Вы: студент



procedure Work (var M:mas; N:integer);
var i,b,sym,ost:integer; f:boolean;
begin
for i:=1 to N do
begin f:=true; sym:=0; ost:=0;
b:=m[i];
repeat
ost:=b mod 10;
sym:=sym + ost;
b:=b div 10;
until b=0;
if sym mod 2=0 then f:=false;
if (f=true) and (sqrt(m[i]) in kor) then m[i]:=m[i+1];
end;
end;

исправил while на repeat, на счет полн. квад. завел константу чисел kor=[1..178] который при возведении в квадрат <=32000 ток чот у меня не проверяет условие sqrt (m[i]) in kor выдает operand types do not match operator, и еще хотел спросить как оформить правильно удалении элемента из массива, как у меня или мож m[i]:=0.
Пользователь в офлайнеКарточка пользователяОтправить личное сообщение
Вернуться в начало страницы
+Ответить с цитированием данного сообщения
Julia
сообщение 16.12.2009, 4:30
Сообщение #8


Ассистент
****

Группа: Julia
Сообщений: 593
Регистрация: 23.2.2007
Город: Улан-Удэ
Учебное заведение: БГУ
Вы: преподаватель



Заведите множество ПОЛНЫХ квадратов. Это числа 1,4,9,16,...Только определите его программно, а не вручную.

Идея с удалением верна, но реализована неправильно. У вас получатся, что вы копируете следующий элемент, а не сдвигаете его. При этом все последующие числа остаются на месте.
Пользователь в офлайнеКарточка пользователяОтправить личное сообщение
Вернуться в начало страницы
+Ответить с цитированием данного сообщения
InFuz
сообщение 16.12.2009, 13:29
Сообщение #9


Студент
**

Группа: Продвинутые
Сообщений: 116
Регистрация: 13.10.2009
Город: Ульяновск
Учебное заведение: УлГУ
Вы: студент



procedure Work (var M:mas; var G:mas; N:integer);
var j,i,b,sym,ost:integer; f,q:boolean;
begin
for j:=1 to 178 do
G[j]:=j*j;
for i:=1 to N do
begin f:=true; sym:=0; ost:=0; q:=false;
b:=m[i];
for j:=1 to 178 do
begin
if g[j]=m[i] then
begin
q:=true; break;
end;
end;
repeat
ost:=b mod 10;
sym:=sym + ost;
b:=b div 10;
until b=0;
if sym mod 2=0 then f:=false;
if (f=true) and (q=true) then
begin
for i:=i to N do
begin
m[i]:=m[i+1];
N:=N-1;
end;
end;
end;
end;

сделал так вроде работает но почему то когда хочу распечатать массив M после обработки то выдает File not open for output в процедуре печати, вот она

procedure Print (var M:mas; N:integer);
var i:integer;
begin
for i:=1 to N do
write (M[i],'; ');
writeln;
end;
Пользователь в офлайнеКарточка пользователяОтправить личное сообщение
Вернуться в начало страницы
+Ответить с цитированием данного сообщения
Julia
сообщение 19.12.2009, 5:15
Сообщение #10


Ассистент
****

Группа: Julia
Сообщений: 593
Регистрация: 23.2.2007
Город: Улан-Удэ
Учебное заведение: БГУ
Вы: преподаватель



Если бы занесли i*i во множество, увеличили бы скорость работы программы.

Выложите полный текст программы.
Пользователь в офлайнеКарточка пользователяОтправить личное сообщение
Вернуться в начало страницы
+Ответить с цитированием данного сообщения
InFuz
сообщение 19.12.2009, 13:20
Сообщение #11


Студент
**

Группа: Продвинутые
Сообщений: 116
Регистрация: 13.10.2009
Город: Ульяновск
Учебное заведение: УлГУ
Вы: студент



program Masiv;
uses crt;
const Nmax=16;
type mas= array [1..Nmax] of integer;
var G,M:mas; var N:integer;

procedure Enter (var M:mas; Nmax:integer; var N:integer); {ввод массива}
var i,x:integer;
begin
N:=0;
for i:=1 to Nmax do
begin
write ('M[',i,']=');
readln (x);
if x=0 then break; {0 - индикатор окончания, он не обрабатывается}
inc (N); M[i]:=x;
end;
end;

procedure Print (var M:mas; N:integer); {печать}
var i:integer;
begin
for i:=1 to N do
write (M[i],'; '); {тут появляется ошибка File not open for output когда запускаешь ее и вводишь какие нибудь числа}
writeln;
end;


procedure Work (var M:mas; var G:mas; N:integer); {обраборка}
var j,i,b,sym,ost:integer; f,q:boolean;
begin
for j:=1 to 178 do
G[j]:=j*j; {создание мас. G - полные квадраты до <=32000}
for i:=1 to N do
begin f:=true; sym:=0; ost:=0; q:=false;
b:=m[i];
for j:=1 to 178 do
begin
if g[j]=m[i] then {проверка числа из мас. М, на наличие его в мас G}
begin
q:=true; break;
end;
end;
repeat
ost:=b mod 10;
sym:=sym + ost;
b:=b div 10;
until b=0;
if sym mod 2=0 then f:=false; {проверка нечотности суммы цифр}
if (f=true) and (q=true) then
begin
for i:=i to N do
begin
m[i]:=m[i+1]; {затерание искомого элем. и сдвиг всех справа на 1 шаг в лево}
N:=N-1; {обрезание последнего элем. т.к. он будет повторятся из за сдвига}
end;
end;
end;
end;

Begin clrscr; {нужно ввести мас., распечатать его до и распечатать его после}
Enter (M,Nmax,N);
Print (M,N);
Work (M,G,N);
Print (M,N);
readkey
End.
Пользователь в офлайнеКарточка пользователяОтправить личное сообщение
Вернуться в начало страницы
+Ответить с цитированием данного сообщения
Julia
сообщение 21.12.2009, 8:56
Сообщение #12


Ассистент
****

Группа: Julia
Сообщений: 593
Регистрация: 23.2.2007
Город: Улан-Удэ
Учебное заведение: БГУ
Вы: преподаватель



program Masiv;
uses crt;
const Nmax=16;
type mas= array [1..Nmax] of integer;
var G,M:mas; var N:integer;

procedure Enter (var M:mas; Nmax:integer; var N:integer); {ввод массива}
var i,x:integer;
begin
N:=0;
for i:=1 to Nmax do
begin
write ('M[',i,']=');
readln (x);
if x=0 then break; {0 - индикатор окончания, он не обрабатывается}
inc (N); M[i]:=x;
end;
end;

procedure Print (var M:mas; N:integer); {печать}
var i:integer;
begin
for i:=1 to N do
write (M[i],'; '); {тут появляется ошибка File not open for output когда запускаешь ее и вводишь какие нибудь числа}
writeln;
end;
procedure Work (var M:mas; var G:mas; N:integer); {обраборка}
var j,i,b,sym,ost:integer; f,q:boolean;
begin
for j:=1 to 178 do
G[j]:=j*j; {создание мас. G - полные квадраты до <=32000}
for i:=1 to N do
begin f:=true; sym:=0; ost:=0; q:=false;
b:=m[i];
for j:=1 to 178 do
begin
if g[j]=m[i] then {проверка числа из мас. М, на наличие его в мас G}
begin
q:=true; break;
end;
end;
repeat
ost:=b mod 10;
sym:=sym + ost;
b:=b div 10;
until b=0;
if sym mod 2=0 then f:=false; {проверка нечотности суммы цифр}
if (f=true) and (q=true) then
begin
for i:=i to N do
begin
m[i]:=m[i+1]; {затерание искомого элем. и сдвиг всех справа на 1 шаг в лево} {Сдвиг так и не исправили}
N:=N-1; {обрезание последнего элем. т.к. он будет повторятся из за сдвига}
end;
end;
end;
end;

Begin clrscr; {нужно ввести мас., распечатать его до и распечатать его после}
Enter (M,Nmax,N);
Print (M,N);
Work (M,G,N);
Print (M,N);
readkey
End.


Исправьте пока эти две ошибки.
Пользователь в офлайнеКарточка пользователяОтправить личное сообщение
Вернуться в начало страницы
+Ответить с цитированием данного сообщения
InFuz
сообщение 21.12.2009, 16:04
Сообщение #13


Студент
**

Группа: Продвинутые
Сообщений: 116
Регистрация: 13.10.2009
Город: Ульяновск
Учебное заведение: УлГУ
Вы: студент



Извиняюсь за тупость (IMG:style_emoticons/default/blush.gif) , но вроде for i:=i to N do правильно, при нахождении удаляемого элемента нет нужды заводить цикл со значениями i которые меньше его текушего значения.
В сдвиге вынес N:=N-1 за цикл for а то она массив обрезала N-i раз, а надо было только один.

Но ошибку все равно выдает.

program Masiv;
uses crt;
const Nmax=16;
type mas= array [1..Nmax] of integer;
var G,M:mas; var N:integer;

procedure Enter (var M:mas; Nmax:integer; var N:integer);
var i,x:integer;
begin
N:=0;
for i:=1 to Nmax do
begin
write ('M[',i,']=');
readln (x);
if x=0 then break;
inc (N); M[i]:=x;
end;
end;

procedure Print (var M:mas; N:integer);
var i:integer;
begin
for i:=1 to N do
write (M[i],'; ');
writeln;
end;


procedure Work (var M:mas; var G:mas; N:integer);
var j,i,b,sym,ost:integer; f,q:boolean;
begin
for j:=1 to 178 do
G[j]:=j*j;
for i:=1 to N do
begin f:=true; sym:=0; ost:=0; q:=false;
b:=m[i];
for j:=1 to 178 do
begin
if g[j]=m[i] then
begin
q:=true; break;
end;
end;
repeat
ost:=b mod 10;
sym:=sym + ost;
b:=b div 10;
until b=0;
if sym mod 2=0 then f:=false;
if (f=true) and (q=true) then
begin
for i:=i to N do
m[i]:=m[i+1];
N:=N-1;
end;
end;
end;

Begin clrscr;
Enter (M,Nmax,N);
Print (M,N);
Work (M,G,N);
Print (M,N);
readkey
End.

Помогите, а то в четверг уже надо сдавать. (IMG:style_emoticons/default/newconfus.gif)
Пользователь в офлайнеКарточка пользователяОтправить личное сообщение
Вернуться в начало страницы
+Ответить с цитированием данного сообщения
Julia
сообщение 22.12.2009, 16:54
Сообщение #14


Ассистент
****

Группа: Julia
Сообщений: 593
Регистрация: 23.2.2007
Город: Улан-Удэ
Учебное заведение: БГУ
Вы: преподаватель



1) Nmax=16 явно недостаточно для того, чтобы заполнить массив G.
2) Для внешнего цикла цикл с параметром не подходит (подумайте почему), лучше использовать цикл с предусловием.
3) for i:=i ... параметр цикла и его начальное значение - одна и та же переменная, а это нехорошо. К тому же i - параметр внешнего цикла. Так что меняйте параметр вложенного.
4) В процедуре Work сделайте параметр N - переменным.

Ну вот вроде бы и все (проверила - работает (IMG:style_emoticons/default/smile.gif)).
Пользователь в офлайнеКарточка пользователяОтправить личное сообщение
Вернуться в начало страницы
+Ответить с цитированием данного сообщения
InFuz
сообщение 22.12.2009, 19:27
Сообщение #15


Студент
**

Группа: Продвинутые
Сообщений: 116
Регистрация: 13.10.2009
Город: Ульяновск
Учебное заведение: УлГУ
Вы: студент



1) Но Nmax ни где не используется G-массивом. Nmax вообще ограничивает лишь длину цикла M и используется только в процедуре Enter. G же спокойно заполняется

for j:=1 to 178 do
G[j]:=j*j;

и ни как не касается Nmax. Я решил ее вообще убрать и маненько изменил Enter.

2) Внешний цикл вы имеете виду

......
for i:=1 to N do...
......
......
end;
.......

Если да, то честно говоря не вижу причин его не использовать разве может из за того что в конце может у N отнимется 1, а N уже внесена в услувие цикла? Но я все равно поменял (IMG:style_emoticons/default/smile.gif)

3) Поменял на

for w:=i .....

4) Поменял var N:integer;

program Masiv;
uses crt;
type mas= array [1..16] of integer;
var G,M:mas; var N:integer;

procedure Enter (var M:mas; var N:integer);
var i,x:integer;
begin
N:=0;
for i:=1 to 16 do
begin
write ('M[',i,']=');
readln (x);
if x=0 then break;
inc (N); M[i]:=x;
end;
end;

procedure Print (var M:mas; N:integer);
var i:integer;
begin
for i:=1 to N do
write (M[i],'; ');
writeln;
end;


procedure Work (var M:mas; var G:mas; var N:integer);
var j,i,w,b,sym,ost:integer; f,q:boolean;
begin
for j:=1 to 178 do
G[j]:=j*j;
while i>N do
begin
i:=1;
begin f:=true; sym:=0; ost:=0; q:=false;
b:=m[i];
for j:=1 to 178 do
begin
if g[j]=m[i] then
begin
q:=true; break;
end;
end;
repeat
ost:=b mod 10;
sym:=sym + ost;
b:=b div 10;
until b=0;
if sym mod 2=0 then f:=false;
if (f=true) and (q=true) then
begin
for w:=i to N do
m[i]:=m[i+1];
N:=N-1;
end;
inc(i);
end;
end;
end;

Begin clrscr;
Enter (M,N);
Print (M,N);
Work (M,G,N);
Print (M,N);
readkey
End.

По прежнему выдает ошибку тамже где и выдовала в Print.

Скиньте плиз ваш полный вариант, а то чую не успею отладить до четверга.
Пользователь в офлайнеКарточка пользователяОтправить личное сообщение
Вернуться в начало страницы
+Ответить с цитированием данного сообщения
Julia
сообщение 23.12.2009, 1:43
Сообщение #16


Ассистент
****

Группа: Julia
Сообщений: 593
Регистрация: 23.2.2007
Город: Улан-Удэ
Учебное заведение: БГУ
Вы: преподаватель



1) Nmax у вас использовалась при описании типа mas. Переменная G как раз к этому типу и относится. И задавайте цикл хоть до 10000000, больше, чем Nmax чисел, у вас в массиве не будет.
То, что при описании вы заменили константу на 16, ничего не исправило.
2) Плохо, что не видите причин. Оттого и цикл с предусловием используете неправильно. У меня нет сейчас времени объяснить почему, возможно вечером. А еще лучше если вы сами догадаетесь.

Текст программы тоже только вечером могу выложить.
Пользователь в офлайнеКарточка пользователяОтправить личное сообщение
Вернуться в начало страницы
+Ответить с цитированием данного сообщения
InFuz
сообщение 23.12.2009, 17:05
Сообщение #17


Студент
**

Группа: Продвинутые
Сообщений: 116
Регистрация: 13.10.2009
Город: Ульяновск
Учебное заведение: УлГУ
Вы: студент



Ну все вроде запахала (IMG:style_emoticons/default/beer.gif)

program Masiv;
uses crt;
const Nmax=16;
type mas= array [1..Nmax] of integer;
type mas2= array [1..178] of integer;
var M:mas; var G:mas2; var N:integer;

procedure Enter (var M:mas; Nmax:integer; var N:integer);
var i,x:integer;
begin
N:=0;
for i:=1 to Nmax do
begin
write ('M[',i,']=');
readln (x);
if x=0 then break;
inc (N); M[i]:=x;
end;
end;

procedure Print (var M:mas; N:integer);
var i:integer;
begin
for i:=1 to N do
write (M[i],'; ');
writeln;
end;


procedure Work (var M:mas; var G:mas2; var N:integer);
var j,i,w,b,sym,ost:integer; f,q:boolean;
begin
for j:=1 to 178 do
G[j]:=j*j;
for i:=1 to N do
begin f:=true; sym:=0; ost:=0; q:=false;
b:=m[i];
for j:=1 to 178 do
begin
if g[j]=m[i] then
begin
q:=true; break;
end;
end;
repeat
ost:=b mod 10;
sym:=sym + ost;
b:=b div 10;
until b=0;
if sym mod 2=0 then f:=false;
if (f=true) and (q=true) then
begin
for w:=i to N do
m[w]:=m[w+1];
N:=N-1;
end;
end;
end;

Begin clrscr;
Enter (M,Nmax,N);
Print (M,N);
Work (M,G,N);
Print (M,N);
readkey
End.

хотя внешний цикл я так и не поменял (IMG:style_emoticons/default/bang.gif)

Все завтра буду сдавать, эту и еще 4 лабы. Все вроде пашет должны зачет автоматом поставать (IMG:style_emoticons/default/umnik.gif)

Спасибо за помощь! (IMG:style_emoticons/default/worthy.gif)
Пользователь в офлайнеКарточка пользователяОтправить личное сообщение
Вернуться в начало страницы
+Ответить с цитированием данного сообщения
Julia
сообщение 24.12.2009, 5:53
Сообщение #18


Ассистент
****

Группа: Julia
Сообщений: 593
Регистрация: 23.2.2007
Город: Улан-Удэ
Учебное заведение: БГУ
Вы: преподаватель



Неправильно она у вас работает. Возьмите несколько подряд элементов, являющихся полными квадратами, и убедитесь в этом.
Пользователь в офлайнеКарточка пользователяОтправить личное сообщение
Вернуться в начало страницы
+Ответить с цитированием данного сообщения
InFuz
сообщение 24.12.2009, 11:24
Сообщение #19


Студент
**

Группа: Продвинутые
Сообщений: 116
Регистрация: 13.10.2009
Город: Ульяновск
Учебное заведение: УлГУ
Вы: студент



А уже все равно, уже сдал. Ни кто ни чего не заметил.
Пользователь в офлайнеКарточка пользователяОтправить личное сообщение
Вернуться в начало страницы
+Ответить с цитированием данного сообщения

Ответить в эту темуОткрыть новую тему
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 



- Текстовая версия Сейчас: 28.3.2024, 11:18

Книжки в помощь: "Сборник заданий по высшей математике" Кузнецов Л.А., "Сборник заданий по высшей математике" Чудесенко В.Ф., "Индивидуальные задания по высшей математике" Рябушко А.П., и другие.




Зеркало сайта Решебник.Ру - reshebnik.org.ru