Задачі по Pascal

Дата: Пн, 12.07.2010, 19:24 | Повідомлення № 1

Прописаний назавжди

Повідомлень: 449

Нагороди: 3

Рейтинг: 64

Не знайшов більш відповідної теми, тому вирішив створити нову, якщо вже десь є, прошу вибачення у модераторів
Отже, задача на масиви з посібника Я. Глинського (Turbo Pascal&Delphi 2004 р), не складна, але я щось загруз :(
"Утворити і вивести масив у з елементами у(к), к=1,12. Перший додатний елемент поміняти місцями з максимальним".

[admin]Шановні форумчани!!!!!
Повідомлення, які не відповідають темі або несуть некорисний зміст будуть видалятись без попередження!!!

program Masuvu;
uses crt;
var y,g:array [1..12] of real; max,h:real;
k,n,m:integer;
begin
clrscr;
max:=-1000000;
n:=0;
for k:=1 to 12 do
begin
y[k]:=sin(k*k)*cos(k*k*k)-sin(k)+5.2;
if y[k]>max then
begin
max:=y[k];
m:=k;
end;
if y[k]>0 then
begin
n:=n+1;
g[n]:=y[k];
h:=g[1];
end;
if y[k]=g[1] then
begin
y[k]:=max;
y[m]:=h;
end;
writeln (k,' element ',y[k]:5:2);
end;
if n>0 then writeln ('pershuj dodatnij element',g[1]:5:2)else writeln('nema dodatnih elementiv');
writeln ('maksumalnuj element - ', m,' -',max:5:2);
readln;
end.
end.

Відредаговано: W-w-W - Пт, 08.01.2016, 19:00

kom_adm

Дата: Пн, 12.07.2010, 21:42 | Повідомлення № 2

Ветеран спілкування

Повідомлень: 3767

Нагороди: 19

Рейтинг: 217

skif, надрукуйте, будь-ласка, повну умову задачі, чи ми маємо догадатись, що заповняти масив потрібно саме:

Quote (skif)

y[k]:=sin(k*k)*cos(k*k*k)-sin(k)+5.2;

Комарик

Дата: Пн, 12.07.2010, 23:04 | Повідомлення № 3

Прописаний назавжди

Повідомлень: 228

Нагороди: 0

Рейтинг: 14

Code

program Masuvu;
      uses crt;
      var y:array [1..12] of real; max,buf,dd:real;
          k,n,m,ndd:integer;
          ddz:boolean;
begin
     clrscr;
     n:=0;
     write('{');
     randomize;
     for k:=1 to 12 do
     begin
       y[k]:=-5+random(20){sin(k*k)*cos(k*k*k)-sin(k)+5.2};
       write(y[k]:2:2,',');
     end;
     writeln('}');
     max:=y[1];
     ddz:=true;
     for k:=1 to 12 do
     begin
        if y[k]>max then
        begin
           max:=y[k];
           m:=k;
        end;

        if (y[k]>0) and  (ddz=true) then
        begin
            dd:=y[k];
            ndd:=k;
            ddz:=false;
        end;
     end;
     if ddz then write('nema dodatnih')
     else begin
       buf:=y[ndd];
       y[ndd]:=y[m];
       y[m]:=buf;
     end;
      write('{');
     for k:=1 to 12 do
     begin
       write(y[k]:2:2,',');
     end;
     writeln('}');
     readln;
end.

ось вам розв*язок
ну і не обійдусь без критики.
навіть не знаю навіщо вам був той другий масив. для знаходження першого додатного елемента вистачило й бульової змінної...
також, не варто заповнювати масив і тут же ж шукати максимальний елемент (це моя така думка, але змилуйтесь над дітьми! хіба можна писати "max:=-1000000;"?)
і якщо вас просять поміняти елементи, то не обов*язково на них заводити змінні, достатньо лиш номера в масиві.
(в коді, для наглядності, я їх завів, все ж)
і коментар користувача Ковальчук_Олександр був доречним. там у вас всі елементи додатні!
і на кінець... два енда з крапочкою - це перебір...
якщо щось не зрозумілов розв*язку, то дописуйте...

Відредаговано: Комарик - Пн, 12.07.2010, 23:11

skif

Дата: Пн, 12.07.2010, 23:45 | Повідомлення № 4

Прописаний назавжди

Повідомлень: 449

Нагороди: 3

Рейтинг: 64

Quote (Комарик)

ну і не обійдусь без критики.

на критиці вчуся

Quote (Комарик)

навіть не знаю навіщо вам був той другий масив. для знаходження першого додатного елемента вистачило й бульової змінної...

в посібнику був лиш один приклад, на жаль Паскаля мене ніхто не вчив - ні в школі, ні в інституті, сам "гризу" граніт - тому й багато недоліків

Quote (Комарик)

якщо щось не зрозуміло в розв*язку, то дописуйте...

if ddz then write('nema dodatnih') - це розгалуження не розумію, не має бути if ddz=true then write('nema dodatnih') ?
Наразі велике спасибі!!!!

Відредаговано: skif - Вт, 13.07.2010, 00:03

Bandalak

Дата: Вт, 13.07.2010, 00:43 | Повідомлення № 5

Лідер форуму

Повідомлень: 6399

Нагороди: 45

Рейтинг: 291

Quote (skif)

if ddz then write('nema dodatnih') - це розгалуження не розумію

Елементарно, Ватсон!
ddz - змінна логічного типу, а будь-яка умова у тілі оператора if є логічним виразом. Логічний вираз, так само як і значення змінної логічного типу може набувати одне із двох значень - "істина" або "фальш". При значенні "істина" - виконуються команди написані після слова "then", а при значенні "фальш" - виконуються команди написані після слова "else", якщо таке є!

Комарик

Дата: Вт, 13.07.2010, 01:58 | Повідомлення № 6

Прописаний назавжди

Повідомлень: 228

Нагороди: 0

Рейтинг: 14

Quote (Bandalak)

точно!)
if <бульова змінна> then begin
<ряд команд які виконують якщо змінна набуває істинного значення>
end
else begin
<ну і якщо хибна>
end;

а можна навіть так
if not <змінна> then begin
<тут якщо хибна>
end
else begin
<тут якщо істинна>
end;

volevikt

Дата: Вт, 13.07.2010, 20:21 | Повідомлення № 7

Перспективна вчителька

Повідомлень: 1912

Нагороди: 25

Рейтинг: 267

Quote (Комарик)

ну і не обійдусь без критики.

Quote (Комарик)

змилуйтесь над дітьми!

Quote (Комарик)

і на кінець... два енда з крапочкою - це перебір...

"Розбили в пух і прах!"
Знаєте, якби мені дали таку відповідь, в мене б назавжди зникло бажання заходити на такий форум, або принаймні щось тут питати.
Можна подумати, що Ви одразу стали програмістом.
Питати не соромно, соромно критикувати за помилки. (ІМХО)

Комарик

Дата: Вт, 13.07.2010, 22:06 | Повідомлення № 8

Прописаний назавжди

Повідомлень: 228

Нагороди: 0

Рейтинг: 14

Quote (volevikt)

Знаєте, якби мені дали таку відповідь, в мене б назавжди зникло бажання заходити на такий форум, або принаймні щось тут питати.
Можна подумати, що Ви одразу стали програмістом.

хм... цікаво...
я лиш вказав на помилки і не хотів нікого ображати, а тим паче "Розбити в пух і прах!".
думаю без коментарів і вказівок на помилки користь від розв*язку була мінімальною.

Quote (volevikt)

Питати не соромно, соромно критикувати за помилки. (ІМХО)

ну раз так, то в наст раз порозсипаю смайлики по тексту повідомлення і не вживатиму слова "критика".

хоча я не вважаю повідомлення образливим, але у разі чого шановному користувачу skif приношу вибачення.

Відредаговано: Комарик - Вт, 13.07.2010, 22:11

skif

Дата: Пн, 19.07.2010, 22:35 | Повідомлення № 9

Прописаний назавжди

Повідомлень: 449

Нагороди: 3

Рейтинг: 64

Quote (Комарик)

у разі чого користувачу skif приношу вибачення

не турбуйтесь, все ОК

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

Quote (Bandalak)

Елементарно, Ватсон!

дякую!

Додано (19.07.2010, 22:35)
---------------------------------------------
Вивести номер передостаннього додатнього елемента у масиві

Code

program masuvu;
uses crt;
var y:array[1..12] of real;
k,n,m:integer; pde:real;
begin
clrscr;
n:=0;
m:=0;
for k:=12 downto 1 do
begin
y[k]:=abs(cos(k*k)-0.51)*sin(3*k-4);
if y[k]>0 then
n:=n+1;
if (n=2) and (y[k]>0) then
begin
pde:=y[k];
m:=k;
end;
end;
for k:=1 to 12 do
begin
y[k]:=abs(cos(k*k)-0.51)*sin(3*k-4);
writeln('y(',k,')=',y[k]:5:2);
end;
if (m>0) then writeln('peredostannij dodatnij elemnt ',pde:5:2,' pid nomerom ',m) else if (m=0) and (n=0) then writeln('ysi elementu masuvy videmni') else writeln ('e odun dodatnij element');
readln;
end.

якщо передостанній - це другий з кінця, чи є ще варіанти відшукання таких елеметів?

Відредаговано: skif - Пн, 19.07.2010, 22:59

Маргарита

Дата: Вт, 20.07.2010, 02:09 | Повідомлення № 10

Юний талант

Повідомлень: 142

Нагороди: 3

Рейтинг: 30

Quote (skif)

if (m>0) then writeln('peredostannij dodatnij elemnt ',pde:5:2,' pid nomerom ',m) else if (m=0) and (n=0) then writeln('ysi elementu masuvy videmni') else writeln ('e odun dodatnij element');
readln;

Треба писати що усі елементи масиву "не додатні", бо слово "від'ємні" не передбачає можливі нульові значення.

skif

Дата: Нд, 15.08.2010, 10:59 | Повідомлення № 11

Прописаний назавжди

Повідомлень: 449

Нагороди: 3

Рейтинг: 64

Рядки...
Ввести прізвище, ім'я та по батькові як одне дане типу рядок. Визначити довжину рядка і кількість букв "а" у ньому. Виконати додатково завдання двома способами: а) розглядаючи рядок як масив символів; б) застосовуючи до рядка функції та процедури.
завдання додатково: 1) Вивести ім'я та кількість букв у третьому слові.

задачу, використовуючи масиви бачу так:

Code

program riadku;
uses crt;
var a:string; i,n,m,n1,n2:integer;
begin
clrscr;
write('vvedit tekst dlia opracjvannia  ');
read(a);
n:=0;
m:=0;
for i:=1 to length(a) do
  begin
  if (a[i]='a') or (a[i]='а') then  n:=n+1;
  if a[i]=' ' then
     begin
     m:=m+1;
     if m=1 then n1:=i;
     if m=2 then n2:=i;
     end;
  end;
writeln('dovzuna riadka ',length(a));
writeln('kilkist bykv a y nomy ',n);
writeln('vashe imia ',copy(a,n1,n2-n1));
writeln('kilkist bykv y prizvushchi ',length(a)-n2);
readln
end.

а от як подифікувати тут під pos i delete не вдається....

vitert

Дата: Нд, 15.08.2010, 12:44 | Повідомлення № 12

Тут живе...

Повідомлень: 174

Нагороди: 1

Рейтинг: 22

Quote (skif)

1) як масив:
program rr;
var s:string;
i,b,k:integer;
m: array [1..2] of integer;
begin
readln(s);
k:=1;
b:=0;
for i:=1 to length(s) do begin
if s[i]='a' then inc(b);
if s[i]=' ' then begin m[k]:=i; inc(k); end;
end;
writeln(length(s));
writeln(b);
writeln(copy(s,m[1]+1,m[2]-m[1]));
writeln(length(s)-m[2]);
end.

2) Застосовуючи функції та процедури:
program rr;
var s,s1:string;
i,pn,pf,a,b,c:integer;
begin
readln(s);
s1:=s;
pn:=pos(' ',s);
delete(s,pn,1);
pf:=pos(' ',s);
delete(s,pf,1);
b:=0;
while pos('a',s1)<>0 do begin
inc(b);
delete(s1,pos('a',s1),1);
end;
writeln(length(s)+2);
writeln(b);
writeln(copy(s,pn,pf-pn));
writeln(length(s)-pf+1);
end.

Правда ще є нюанси з літерою а

Andrey123q

Дата: Пн, 09.05.2011, 16:14 | Повідомлення № 13

Досвідчений учасник

Повідомлень: 1236

Нагороди: 3

Рейтинг: 84

Quote (skif)

"Утворити і вивести масив у з елементами у(к), к=1,12. Перший додатний елемент поміняти місцями з максимальним".

Кстати, ради интереса, как бы выглядела эта задачка на Perl:

Code

#!/usr/bin/perl
sub fx {
($q)=@_;
sin($q**2)*cos($q**3)-sin($q)+5.2;
}
print "\nИсходный массив для k=1..12 и f(x)=sin(x^2)*cos(x^3)-sin(x)+5.2 \n";
foreach (1..12) {
          $hash{$_}=&fx($_);
          $y=&fx($_);
          if ($y>$max1) {$max1=$_}
          if ($y>0 and not defined $dod1) {$dod1=$_};
          $f=$hash{$_};
          print "$_: $f \n";
}
if (defined $dod1) {
          $m1=&fx($max1);
          $d1=&fx($dod1);
          print "\nМаксимум:\t $max1: $m1
          1е положит.:\t $dod1: $d1 \n\n";
          $hash{$dod1}=&fx($max1);
          $hash{$max1}=&fx($dod1);
          print "Решение:\n";
          foreach (1..12) {
                  $f=$hash{$_};
                  print "$_: $f \n";}
}
else {print "Положительных чисел не найдено\n";}

Відредаговано: Andrey123q - Пн, 09.05.2011, 23:18

Пилипчук_О_П

Дата: Пн, 09.05.2011, 20:02 | Повідомлення № 14