Хостинг Портала RusFAQ.ru:
MosHoster.ru - Профессиональный хостинг на Windows 2008

РАССЫЛКИ ПОРТАЛА RUSFAQ.RU

Чемпионы рейтинга экспертов в этой рассылке

Полтев Станислав Михайлович Статус: Практикант Рейтинг: 223 ∙ повысить рейтинг >>

Шичко Игорь Статус: Практикант Рейтинг: 201 ∙ повысить рейтинг >>

Зенченко Константин Николаевич Статус: Профессор Рейтинг: 174 ∙ повысить рейтинг >>

/ КОМПЬЮТЕРЫ И ПО / Языки программирования / Pascal

Выпуск № 738
от 27.11.2008, 06:05

Вопрос № 151297: Здравствуйте эксперты! Помогите составить программу: Из заданной матрицы удалить p-ую строку и k-ый столбец. Матрица вводится пользователем с клавиатуры....

Вопрос № 151.297

Здравствуйте эксперты! Помогите составить программу: Из заданной матрицы удалить p-ую строку и k-ый столбец. Матрица вводится пользователем с клавиатуры.

Отправлен: 21.11.2008, 14:47 Вопрос задал: Петров Иван Сергеевич (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Зенченко Константин Николаевич Здравствуйте, Петров Иван Сергеевич! Программа в приложении. Вычеркиванием строки и столбца занимается строка: a[ i , j ]:=a[ i + ord(k<=i) , j + ord(p<=j) ]; Функция ord - возвращает результат: 1 если true и 0 если fasle. Удачи! Приложение: const n=5; m=6; var a:array[1..n,1..m]of integer; p,k,i,j:integer; begin randomize; {сождаем случайную матрицу и выводим её на экран} for i:=1 to n do begin for j:=1 to m do begin a[i,j]:=random(20); write(a[i,j]:4); end; writeln; end; {вводим столбец} repeat write('Enter P:'); readln(p); until (p>0)and(p<=m); {вводим строку} repeat write('Enter K:'); readln(k); until (k>0)and(k<=n); {вычеркивание строки и столбца} for i:=1 to n-1 do for j:=1 to m-1 do a[i,j]:=a[i+ord(k<=i),j+ord(p<=j)]; {вывод результата работы} for i:=1 to n-1 do begin for j:=1 to m-1 do write(a[i,j]:4); writeln; end; readln; end. --------- Итерация от человека, рекурсия — от Бога (Питер Дойч)

Ответ отправил: Зенченко Константин Николаевич (статус: Профессор) Украина, Киев Тел.: +380979536619 Адрес: Украина г.Киев ---- Ответ отправлен: 21.11.2008, 15:42 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 236243 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Вопрос № 151.302

Здравствуйте!!! Помогите пожалуйста решить задачи: 1. Дана непустая последовательность символов. Требуется построить и напечатать множество, элементами которого являются встречающиеся в последовательности знаки препинания и буквы от ‘E’ до‘N’. 2.В школе имеются секции по следующим видам самодеятельности: хор, авиамодельный кружок, фотокружок, художественная гимнастика, шахматный кружок, туристический клуб. По результатам опроса учащихся требуется построить и распечатать множество, включающее в себя виды самодеятельности, которым занимаются хотя бы в одном классе. Количество классов – 10.

Отправлен: 21.11.2008, 15:38 Вопрос задала: Водянникова Екатерина Валерьевна (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Водянникова Екатерина Валерьевна! Или у меня дежавю, или я уже отвечал на этот вопрос. Решение в приложении. Приложение: №1. uses crt; const mn=['E'..'N','.',',',';',':','?','!'];{знаки препинания надо добавить} var s:string; m:set of char; {множество символов} i:integer; begin clrscr; writeln('Ishodnaja stroka s: '); readln(s); writeln; m:=[]; {пустое множество} for i:=1 to length(s)do if s[i] in mn then include(m,s[i]); {если встречен нужный символ, вставляем его в новое множество} writeln('Mnozestvo:'); for i:=33 to 78 do {diapazon kodov '!' do N}{если в новом множестве есть символы с этими кодами, они по порядку выведутся на экран} if chr(i)in m then write(chr(i),' '); readln end. №2. uses crt; {создаем тип кружки(русские буквы нельзя, поэтому} type krz=set of (hr,am,ft,hg,sh,tk); {сокращенно англиискими) } var m,m1,m2,m3,m4,m5,m6,m7,m8,m9,m10,MR:krz; {десять классов} s:array[1..6]of krz; {массив кружков} s1:array[1..6]of string; {массив названий кружков} i,k:integer; begin clrscr; m1:=[hr,ft,sh]; {первый класс, можно любой набор кружков} m2:=[hr,ft,sh]; {второй} m3:=[tk,sh,ft,hr]; {третий} m4:=[tk,sh,ft]; m5:=[sh,ft,hr]; m6:=[tk,ft,hr]; m7:=[tk,sh,hr]; m8:=[tk,sh,ft]; m9:=[tk,sh]; m10:=[tk,sh,ft,hr]; s[1]:=[hr];s[2]:=[am];s[3]:=[ft];s[4]:=[hg];s[5]:=[sh];s[6]:=[tk]; s1[1]:='Хор';s1[2]:='Авиамодельный';s1[3]:='Фото'; s1[4]:='Художественная гимнастика';s1[5]:='Шахматы';s1[6]:='Туристический'; MR:=[]; for i:=1 to 6 do if (s[i]*m1=s[i])or(s[i]*m2=s[i])or(s[i]*m3=s[i]) or(s[i]*m4=s[i])or(s[i]*m5=s[i])or(s[i]*m6=s[i])or(s[i]*m7=s[i]) or(s[i]*m8=s[i])or(s[i]*m9=s[i])or(s[i]*m10=s[i]) then MR:=MR+s[i];k:=0; writeln('Занимаются хотя бы в одном классе:'); for i:=1 to 6 do if s[i]*MR<>[] then begin writeln(s1[i]); k:=k+1; end; if k=0 then writeln('Таких кружков нет'); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Специалист) Ответ отправлен: 23.11.2008, 18:32 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 236445 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Вопрос № 151.305

Здравствуйте!!! 1) Написать программу создающую текстовый файл с данными о пользователе и времени запуска программы. Если такой файл существует, на экран выводится информация о предыдущем запуске программы. 2) Написать программу проверки наличия комментария и удаления однострочных (многострочных) комментариев из исходного текста программы на языке Pascal, хранящегося в текстовом файле. 3) Вычислить выражение: y = 5 – min(a, b, -0.5) + max(a, b, c) +kvadr (a, b, c), где функция kvadr (x, y, z) — вычисляет квадратный корень суммы квадратов аргументов. Функции min и max возвращают минимальное и максимальное числа из переданных. ЗАРАНЕЕ БОЛЬШОЕ СПАСИБО!!!!!! Приложение: Везде использовать подпрограммы.

Отправлен: 21.11.2008, 15:53 Вопрос задала: Водянникова Екатерина Валерьевна (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Шевченко Дмитрий Здравствуйте, Водянникова Екатерина Валерьевна! В приложении - ответ на задачу №3. С уважением, Дмитрий. Приложение: Function min(a,b,c : Real):Real; begin IF a < b then IF a < c then min:=a Else min:=c Else IF b < c then min:=b Else min:=c; end; Function max(a,b,c : Real):Real; begin IF a > b then IF a > c then max:=a Else max:=c Else IF b > c then max:=b Else max:=c; end; Function kvadr(a,b,c:Real):Real; begin kvadr:=sqrt(sqr(a)+sqr(b)+sqr(c)); end; var a,b,c:Real; begin Write('Enter a: '); ReadLn(a); Write('Enter b: '); ReadLn(b); Write('Enter c: '); ReadLn(c); WriteLn('Result:'); WriteLn(5 - min(a,b,-0.5) + max(a,b,c) + kvadr (a,b,c):5:6); end.

Ответ отправил: Шевченко Дмитрий (статус: 5-й класс) Ответ отправлен: 22.11.2008, 00:30 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 236308 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 5

Вопрос № 151.364

Дорогие эксперты нужна программа считающая детерминант матрицы методом рекурсии, матрица задается пользователем размером от 2*2 до 10*10 только с одинаковыми сторонами Приложение: я так понял нужно раскладывать матрицы на меньшие |2 4 6| |1 3 5| = 2|3 5| -4|1 5|+6|1 3| |0 3 5| |3 5| |0 5| |0 3|

Отправлен: 21.11.2008, 20:43 Вопрос задал: Xbondx (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Denisss Здравствуйте, Xbondx! По определению определители существуют только у квадратных матриц, потому и требуется, чтобы стороны были одинаковыми. В приложении находится примерный код с комментариями. Код проверен на десятке различных примерах (матрицы размерностью до 4х4). Функция det_ считает детерминанты методом рекурсий. Функция det является оболочкой для первой функции. Удачи! Приложение: program Q151364; const { Максимальный размер матрицы } MAX_SIZE = 10; type TByteSet = set of Byte; TMatrix = array[1..MAX_SIZE, 1..MAX_SIZE] of Shortint; { Рекурсивная функция } { вычисления детерминатора } { квадратной матрицы } function det_(var mx: TMatrix; const n: Byte; const noCols: TByteSet): Integer; var sum, tmp: Integer; i, k: Byte; begin { Инициализация } sum:= 0; i:= 0; if (n = 1) then begin Inc(i); while (i in noCols) do Inc(i); sum:= mx[i, 1]; end else begin for k:= 1 to n do begin Inc(i); while (i in noCols) do Inc(i); { Вычисляем слагаемое или вычитаемое } tmp:= mx[i,n]*det_(mx, n-1, noCols+[i]); { Сумма } { Здесь учитывается, что мы всегда выбираем последний ряд матрицы для расчетов } if (((n+k-1) and 1) = 1) then Inc(sum, tmp) else Dec(sum, tmp); end; end; { Результат } det_:= sum; end; { Детерминатор матрицы } { Своеобразная оболочка для настоящей функции } function det(var mx: TMatrix; const size: Byte): Integer; begin det:= det_(mx, size, []); end; var n, i, j: Byte; mx: TMatrix; begin { Вводим размер квадратной матрицы } repeat write('n = '); readln(n); until ((n >= 2) and (n <= MAX_SIZE)); { Заполняем матрицу } for i:= 1 to n do for j:= 1 to n do begin write('A[', i, ',', j,'] = '); readln(mx[i,j]); end; writeln; { Выводим результат } writeln('det(A) = ', det(mx, n)); writeln; writeln('Press [Enter] to continue...'); readln; end. --------- Все должно быть сделано настолько просто, насколько это возможно. Но не проще. (с) А.Эйнштейн

Ответ отправил: Denisss (статус: Профессор) Россия, Москва ICQ: 281599577 ---- Ответ отправлен: 22.11.2008, 19:59 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 236370 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 5

Вопрос № 151.384

Помогите написать программу: С клавиатуры вводится текст из строчных (маленьких) латинских букв, за которым следует точка. Напечатать все буквы, входящие в текст по одному разу. Вывод на экран: титульный лист + задание; строка с исходным текстом, строка с результатом имеет длину строки с исходным текстом с буквами через пробел Надо сделать в борланде Заранее благодарен!!!!

Отправлен: 21.11.2008, 22:55 Вопрос задал: Domi Alexandro (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Шевченко Дмитрий Здравствуйте, Domi Alexandro! В приложении находится код программы со всеми пояснениями. С уважением, Дмитрий. Приложение: Function bukvi(s:string):String; var res:String; i:Integer; begin res:=''; For i := 1 to length(s) do//перебираем строку IF pos(copy(s,i,1),res) > 0 then//если такой символ уже встречался - res:=res + ' '//заменяем его пробелом Else//иначе - res:=res + copy(s,i,1);//добавляем его в строку со встретившимися уникальными символами bukvi:=res; end; var s:string; begin WriteLn('Enter text'); ReadLn(s); WriteLn('Result:'); WriteLn(bukvi(s)); end.

Ответ отправил: Шевченко Дмитрий (статус: 5-й класс) Ответ отправлен: 21.11.2008, 23:34 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 236301 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

© 2001-2008, Портал RusFAQ.ru, Россия, Москва. Авторское право: ООО "Мастер-Эксперт Про" Техподдержка портала, тел.: +7 (926) 535-23-31 Хостинг: "Московский хостер" Поддержка: "Московский дизайнер" Авторские права | Реклама на портале ∙ Версия системы: 5.12 от 19.11.2008
RusFAQ.ru | MosHoster.ru | MosDesigner.ru RusIRC.ru | Kalashnikoff.ru | RadioLeader.ru