Digma Опубликовано 26 мая, 2009 Жалоба Опубликовано 26 мая, 2009 День добрый. Прошу помощи, а точнее решите пожалуйсто 2 задачки.Составти пожалуйсто программу.1. Среди элементов квадратной матрицы 3х3 определить количество отрицательных элементов, а положительные увеличить на 2!!!2. В массиве из 10 вещественных чисел найти наибольший элемент и поменять его местами с первым элементом.ПОЖАЛЙСТО НАПИШИТЕ СРАЗУ ПРОГРАММУ, БУДУ ОЧЕНЬ БЛАГОДАРЕН! РЕШИВШЕМУ ЗАКИНУ ДЕНЕГ НА МОБИЛУ!!! ПЛИЗ!!! Цитата
martinges Опубликовано 26 мая, 2009 Жалоба Опубликовано 26 мая, 2009 пока свободное время буду прикалываться Apocalipsisраздел переменныха,b: массив[1..const]действительных чисел;count,i:целое число;начало блока кодацикл с параметром iзанести данные в массив a;конец цикла с параметром;цикл с параметром iзанести 0 в массив b;конец цикла с параметром;цикл с параметром i до const-1 элемента массиваесли (i элемент а)*(i+1 элемент а)<0 тогда начало I+1 элемент массива b =1; увеличиваем count на 1;конец цикла с параметром;цикл с параметром iесли I элемент массива b не равен 0 то вывести на экран: ‘мужик на ‘,I,’ месте знак поменялсо караул ’;конец цикла с параметром;вывести на экран: ‘капитан, за время вашего отсутствия выявлено ‘,count,’ чередований знаков ’;конец блока кода. Цитата
Baimer Опубликовано 26 мая, 2009 Жалоба Опубликовано 26 мая, 2009 Digmavara:array [1..3,1..3]of integer;i,j,n:integer;beginfor i:=1 to 3 do for j:=1 to 3 do begin readln(a[i,j]); if a[i,j]<0 then n:=n+1 else a[i,j]:=a[i,j]+2; end;for i:=1 to 3 do begin writeln; for j:=1 to 3 do write(a[i,j],' '); end;writeln('отрицательных элементов ',n);end.program zadacha1;var a:array[1..10]of real; i,n:integer; x:real;beginfor i:=1 to 10 do readln(a[i]);x:=a[1];n:=1;for i:=2 to 10 do if x x:=a[i]; n:=i; end;a[n]:=a[1];a[1]:=x;for i:=1 to 10 do writeln(a[i]);end.program zadacha2; Цитата
Apocalipsis Опубликовано 27 мая, 2009 Жалоба Опубликовано 27 мая, 2009 Кто умеет создавать отчеты в делфи отпишите в личку. Цитата
Exclusive Опубликовано 27 мая, 2009 Жалоба Опубликовано 27 мая, 2009 Уважаемые программисты. Пожалуйсто напишите программу для решения этих двух задачек.1. Определить, является ли заданное натуральное число N совершенным, т.е. равным сумме всех своих (положительных) делителей, кроме самого себя.2. Вычислить значение выражения: y=5!/(4в степени5+4!/(4в степени4+3!/(4в степени3+2!/(4в степени2+1/(4+х)))))Не смог понять как написать число в степени, поэтому написал словами. Пожалуйсто помогите, напишите программу... Цитата
ght Опубликовано 27 мая, 2009 Жалоба Опубликовано 27 мая, 2009 спасибо за решение задач!!! Решите пожалуйста еще 2 задачи до пятницы срочно надо(скоро сессия )1. Найти все двухзначные числа , сумма квадратов цифр которых делится на 132. Даны действительное a и натуральное n . Вычислитьp=a*(1+2)*(1+2+3)*...*(1+2+...+n) Цитата
SxLvn Опубликовано 28 мая, 2009 Жалоба Опубликовано 28 мая, 2009 Написал прогу, тока чёт она тупит, помогите исправить, пожалуйста:Даны сведения о сотрудниках учреждения: фамилия, инициалы, номер телефона.Упорядочить сведения о сотрудниках, фамилия которых начинается с заданной буквы, в порядке возрастания номеров телефонов.program zad;uses crt;const y=3;type stud=record fam,fio:string[30]; nomer:longint; end;var st:stud; a:array[1..y] of stud; i,j,k,n:integer; x:longint;begin clrscr; for i:=1 to y do begin writeln ('vvedite familiyu'); readln (a[i].fam); writeln ('vvedite iniczial'); readln (a[i].fio); writeln ('vvedite nomer'); readln (a[i].nomer); end; for i:=1 to y do if a[i].fam[1]='o' then x:=a[i].nomer; n:=i; for j:=1 to y do if a[j].nomer>x then begin x:=a[j].nomer; n:=j; end; for i:=n to y do a[i]:=a[i+1]; for i:=1 to y do writeln (a[i].fam, a[i].fio:4, a[i].nomer:12); readkeyend. Цитата
martinges Опубликовано 28 мая, 2009 Жалоба Опубликовано 28 мая, 2009 метод пузырька с фильтром на начало буквы. Правило: фамилия с буквой о всегда меньше чем другие записи без о, одна из двух фамилий с буквой о меньше, если цифровой номер меньше. Тупо тот же метод пузырька только условие исходя из этих правил. Искомые записи отсортируются по возрастанию в начале или в конце списка. Цитата
FunlOvEe Опубликовано 28 мая, 2009 Жалоба Опубликовано 28 мая, 2009 ghtvar i:integer;beginclrscr; for i:= 10 to 99 do if ( ( sqr( i div 10 ) + sqr( i mod 10 ) ) mod 13 = 0 ) then write( i:3 );readkey;end.uses crt;var n,i:integer; a,p:real;function sum(n:integer):integer;begin if n = 0 then sum := 0 else sum := n+sum(n-1);end;beginclrscr; write('a = '); readln(a); write('n = '); readln(n); p := a; for i:=2 to n do begin p := p * sum(i); end; write('Ответ: ',p:5:2);readkey;end.uses crt; Цитата
genemy Опубликовано 28 мая, 2009 Жалоба Опубликовано 28 мая, 2009 SxLvn, у вас в коде полная кашагде сортировка то ?примерно должно быть такписал прямо тут, не проверял )vartmp_stud : stud;// ....for i:=1 to ydo if a[i].fam[1]='o'then begin x := 0; for j := i to у do if a[j].fam[1]='o' and a[j].nomer > x then begin x := a[j].nomer; k := j; end; if k <> i then begin tmp_stud := a[i]; a[i] := a[k]; a[k] := tmp_stud; end;end;// тут вывод Цитата
$h|{et Опубликовано 28 мая, 2009 Жалоба Опубликовано 28 мая, 2009 Уважаемые программисты. Пожалуйсто напишите программу для решения этих задач.1.Дана последовательность действительных чисел A1,2.Даны действительные числа A1,A2,...An. Требуется умножить все члены последовательности A1,A2,...An на квадрат ее наименьшего члена, если Ак>0,и на квадрат ее наибольшего члена, если Ак<0(13.Дана последовательность целых чисел.Найти кол-во различных чисел в этой последовательности.4.Дана последовательность целых чисел A1,A2,...An.Выяснить, какое число встречается раньше-положительное или отрицательное. Цитата
Digma Опубликовано 28 мая, 2009 Жалоба Опубликовано 28 мая, 2009 Уважаемые программисты. Пожалуйсто напишите программу для решения этих двух задачек.1. Определить, является ли заданное натуральное число N совершенным, т.е. равным сумме всех своих (положительных) делителей, кроме самого себя.2. Вычислить значение выражения: y=5!/(4в степени5+4!/(4в степени4+3!/(4в степени3+2!/(4в степени2+1/(4+х)))))Не смог понять как написать число в степени, поэтому написал словами. Пожалуйсто помогите, напишите программу... Цитата
SxLvn Опубликовано 28 мая, 2009 Жалоба Опубликовано 28 мая, 2009 genemy а можешь всю прогу написать, а то у мну не получается.У меня так получилосьuses crt;const y=3;type stud=record fam,fio:string[30]; nomer:longint; end;var tmp_stud:stud; a:array[1..y] of stud; i,j,k,n:integer; x:longint;begin clrscr; for i:=1 to y do begin writeln ('vvedite familiyu'); readln (a[i].fam); writeln ('vvedite iniczial'); readln (a[i].fio); writeln ('vvedite nomer'); readln (a[i].nomer); end; for i:=1 to ydo if a[i].fam[1]='o'then begin x := 0; for j := i to ó do if a[j].fam[1]='o' and a[j].nomer > x then begin x := a[j].nomer; k := j; end; if k <> i then begin tmp_stud := a[i]; a[i] := a[k]; a[k] := tmp_stud; end;end; for i:=n to y do a[i]:=a[i+1]; for i:=1 to y do writeln (a[i].fam, a[i].fio:4, a[i].nomer:12); readkeyend.program zad; Цитата
genemy Опубликовано 28 мая, 2009 Жалоба Опубликовано 28 мая, 2009 for i:=n to y do a:=a[i+1];вот это зачем ?у меня ни дельфи ни паскаля нету Цитата
ght Опубликовано 28 мая, 2009 Жалоба Опубликовано 28 мая, 2009 FunlOvEeспасибо огромное! Завтро покажу задачи и все ок))) Цитата
FunlOvEe Опубликовано 28 мая, 2009 Жалоба Опубликовано 28 мая, 2009 Digmavar i,n,sum:integer;beginclrscr; write(' N = ' ); readln(n); for i:=1 to n div 2 do if n mod i = 0 then sum:= sum + i; if ( sum = n) then writeln(' Число ',n, ' совершенное') else writeln(' Число ',n, ' несовершенное');readkey;end.uses crt;var n,i:integer; x,y:real;function f(n:integer):integer;begin if n = 0 then f := 1 else f := n*f(n-1);end;function s(x,n:real):real;var t:real;begin t := Abs(x); if x < 0 then s:= (-1)*exp(n*Ln(t)) else s:= exp(n*Ln(t));end;beginclrscr; x := 0; y := f(5)/( s(4,5)+f(4) / ( s(4,4)+f(3) / ( s(4,3)+f(2) / (s(4,2)+1/(4+x)) ) ) ); write(y:1:8);readkey;end.uses crt;SxLvnconst y = 4;type stud = record fam,fio:string[30]; nomer:longint; end;var tmp_stud:stud; a:array[1..y] of stud; i,j,k,n:integer; x:longint;procedure swap(var e1, e2: stud);var e: stud;begin e := e1; e1 := e2; e2 := e;end;procedure qsort(l, r: integer);var i, j, x: integer;begin i := l; j := r; x := a[l+random(r-l+1)].nomer; repeat while ( x > a[i].nomer ) do inc(i); while ( x < a[j].nomer ) do dec(j); if (i <= j) and ((a[i].fam[1] = 'o') or ( a[j].fam[1] = 'o')) then begin swap(a[i], a[j]); inc(i); dec(j); end else begin inc(i); dec(j); end; until i > j; if l < j then qsort(l, j); if i < r then qsort(i, r);end;beginclrscr; for i:=1 to y do begin write('vvedite familiyu: '); readln(a[i].fam); write('vvedite iniczial: '); readln(a[i].fio); write('vvedite nomer: '); readln(a[i].nomer); end; for i:=1 to y do if ( a[i].fam[1] = 'o' ) then qsort(1,y); for i:=1 to y do writeln (a[i].fam, a[i].fio:4, a[i].nomer:12); readkey;end.uses crt; Цитата
SxLvn Опубликовано 28 мая, 2009 Жалоба Опубликовано 28 мая, 2009 SxLvnconst y = 4;type stud = record fam,fio:string[30]; nomer:longint; end;var tmp_stud:stud; a:array[1..y] of stud; i,j,k,n:integer; x:longint;procedure swap(var e1, e2: stud);var e: stud;begin e := e1; e1 := e2; e2 := e;end;procedure qsort(l, r: integer);var i, j, x: integer;begin i := l; j := r; x := a[l+random(r-l+1)].nomer; repeat while ( x > a[i].nomer ) do inc(i); while ( x < a[j].nomer ) do dec(j); if (i <= j) and ((a[i].fam[1] = 'o') or ( a[j].fam[1] = 'o')) then begin swap(a[i], a[j]); inc(i); dec(j); end else begin inc(i); dec(j); end; until i > j; if l < j then qsort(l, j); if i < r then qsort(i, r);end;beginclrscr; for i:=1 to y do begin write('vvedite familiyu: '); readln(a[i].fam); write('vvedite iniczial: '); readln(a[i].fio); write('vvedite nomer: '); readln(a[i].nomer); end; for i:=1 to y do if ( a[i].fam[1] = 'o' ) then qsort(1,y); for i:=1 to y do writeln (a[i].fam, a[i].fio:4, a[i].nomer:12); readkey;end.uses crt;Спс за попытку, но прога не сортирует Цитата
SaS Опубликовано 31 мая, 2009 Жалоба Опубликовано 31 мая, 2009 Помогите написать.Среди N четырехугольников с заданными сторонами подсчитать количество параллелограммов, из которых найти один с наибольшим периметром. Цитата
Lakers Опубликовано 31 мая, 2009 Жалоба Опубликовано 31 мая, 2009 Экспромт.....max,i,n,k:integer;function pro(i:integer):boolean;begin if ((a[i][1]=a[i][2])and(a[i][3]=a[i][4]))or ((a[i][3]=a[i][2])and(a[i][1]=a[i][4]))then pro:=true else pro:=false;end;beginclrscr;write('Введите кол-во четырехугольников');readln(n);for i:=1 to n do begin write('сторона 1: ');readln(a[i][1]); write('сторона 2: ');readln(a[i][2]); write('сторона 3: ');readln(a[i][3]); write('сторона 4: ');readln(a[i][4]); end;max:=-1;for i:=1 to n dobeginif pro(i) then begin k:=k+1; if a[i][1]+a[i][2]+a[i][3]+a[i][4]>max then max:=a[i][1]+a[i][2]+a[i][3]+a[i][4]; end;end;writeln('количество прямоугольников: ',k);writeln('максимальный периметр: ',max);readkey;end.var a[1..100][1..4]of integer; Цитата
Скиф Опубликовано 3 июня, 2009 Жалоба Опубликовано 3 июня, 2009 Скиф program D_Andre; type Pere=array [1..10] of byte; var N,i,j:byte; X:Pere; Yes:boolean; procedure Next(var X:Pere;var Yes:boolean); var i:byte; procedure Swap(var a,b:byte); {обмен переменных} var c:byte; begin c:=a;a:=b;b:=c end; begin i:=N-1; while (i>0)and(X>X[i+1]) do dec(i); if i>0 then begin j:=i+1; while (jX) do inc(j); Swap(X,X[j]); for j:=i+1 to (N+i) div 2 do Swap(X[j],X[N-j+i+1]); Yes:=true end else Yes:=false end; function pro:boolean; var i:integer; f:boolean; begin f:=true; for i:=1 to n-1 do begin if i mod 2=1 then begin if x>x[i+1] then f:=false; end else begin if x end; end; pro:=f; end; begin assign(input,'p.txt'); reset(input); assign(output,'p_OUT.txt'); rewrite(output); readln(n); for i:=1 to N do X:=i; repeat if pro then begin for i:=1 to N do write(X);writeln;end; Next(X,Yes) until not Yes; close(output); end.создаш файл "p.txt" туда запишеш 7.Спасибо огромное!!!!!! Цитата
SaS Опубликовано 7 июня, 2009 Жалоба Опубликовано 7 июня, 2009 Lakers спс.Вот ещо помогите)))Pascal/Записи.Даны сведения о сотрудниках учреждения: фамилия, инициалы, номер телефона (если телефона нет, то 0).а) Выдать на экран сведения о сотрудниках, номер телефона которых заканчивается на “10”, и подсчитать их количество.б) Упорядочить все сведения о сотрудниках в алфавитном порядке фамилий.Помогите) Цитата
martinges Опубликовано 7 июня, 2009 Жалоба Опубликовано 7 июня, 2009 а в чем именно помочь? с функцией ввода? с процедурой сортировки? если просто тупо написать прогу, то это неинтересно Цитата
SaS Опубликовано 7 июня, 2009 Жалоба Опубликовано 7 июня, 2009 Lakers спс.Вот ещо помогите)))Pascal/Записи.Даны сведения о сотрудниках учреждения: фамилия, инициалы, номер телефона (если телефона нет, то 0).а) Выдать на экран сведения о сотрудниках, номер телефона которых заканчивается на “10”, и подсчитать их количество.б) Упорядочить все сведения о сотрудниках в алфавитном порядке фамилий.HeLp))) Цитата
ght Опубликовано 8 июня, 2009 Жалоба Опубликовано 8 июня, 2009 решите еще эти плз)))1) Вычислить произведение элементов массива С [7] целых чисел, и если это произведение отрицательное , то вывести его абсолютное значение.2) Дана последовательность n различных целых чисел. Найти сумму ее членов , расположенных между максимальным и минимальным значениями(в сумму включить и оба этих числа)меня уже в группе за гения считают =)))) Цитата
Рекомендуемые сообщения
Присоединяйтесь к обсуждению
Вы можете написать сейчас и зарегистрироваться позже. Если у вас есть аккаунт, авторизуйтесь, чтобы опубликовать от имени своего аккаунта.