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

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

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

Botsman Статус: Студент Рейтинг: 202 ∙ повысить рейтинг >>

Micren Статус: Практикант Рейтинг: 102 ∙ повысить рейтинг >>

Пупорев Юрий Борисович Статус: Специалист Рейтинг: 75 ∙ повысить рейтинг >>

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

Выпуск № 850
от 11.04.2009, 14:35

Вопрос № 164183: 1.-Слова в строке отделены пробелами.Подсчитать кол-во слов, в которых буква "а" встречается ровно 3 раза. 2.- в двумерном массиве (NxN) провести отображение относительно вертикальной оси симметрии 3.-Составить функцию для выполнения ...

Вопрос № 164.183

1.-Слова в строке отделены пробелами.Подсчитать кол-во слов, в которых буква "а" встречается ровно 3 раза. 2.- в двумерном массиве (NxN) провести отображение относительно вертикальной оси симметрии 3.-Составить функцию для выполнения операции с квадратными матрицами...сложение вычитание...умножение

Отправлен: 05.04.2009, 14:51 Вопрос задал: Курышов Евгений Андреевич (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Курышов Евгений Андреевич! Решение задач в приложении. Приложение: 1.-Слова в строке отделены пробелами.Подсчитать кол-во слов, в которых буква "а" встречается ровно 3 раза. uses crt; var s,s1:string; ks,ka,i:byte; begin clrscr; writeln('Введите строку из слов, разделенных пробелами:'); readln(s); s:=s+' ';{добавим пробел в конец строки} while pos(' ',s)>0 do delete(s,pos(' ',s),1); {между словами может быть более одного пробела, поэтому повторяющиеся удалим здесь между апострофами по 2 пробела, обязательно, если поставите 1, вся строка сольется в одно слово } ks:=0;{количество слов пока =0} while pos(' ',s)>0 do{пока в строке есть пробелы} begin s1:=copy(s,1,pos(' ',s));{читаем очередное слово с пробелом(он нам не мешает)} ka:=0;{количество букв а пока=0} for i:=1 to length(s1) do{смотрим слово} if s1[i] in ['a','а'] then ka:=ka+1;{если есть буква а, то считаем. Кстати буква выбрана неудачно, она одинаково выглядит и в латинице, и в кирилице, поэтому написал 1-латиницей, +1-кирилицей. Если нужна только одна, то нужно написать if s[i]='a' then, причем а-на том языке, который указан в задании. Если нужны и Прописные буквы А, то добавить их внутрь квадратных скобок(в множество)} if ka=3 then ks:=ks+1;{если а три раза, считаем это слово} delete(s,1,pos(' ',s));{удаляем просмотренный фрагмент строки} end; writeln('Буквы а встречаются по 3 раза в ',ks,' словах'); readln end. 2.- в двумерном массиве (NxN) провести отображение относительно вертикальной оси симметрии Немного не полно изложено условие. Или просто вывести матрицу в отраженном виде, либо создать из исходной отраженную, поэтому написал и то и другое. ненужное уберете. program zerkalo; uses crt; const n=6; var a:array[1..n,1..n] of integer; i,j,x:integer; begin clrscr; writeln('Исходная матрица:'); for i:=1 to n do begin for j:=1 to n do begin a[i,j]:=10*i+j; write(a[i,j]:3); end; writeln; end; readln; {просто вывод матрицы, отраженной по вертикальной оси} writeln('Отражение:'); for i:=1 to n do begin for j:=n downto 1 do begin write(a[i,j]:3);{просто выводим столбцы с конца, сама матрицак в памяти не меняется} end; writeln; end; readln; {создание отраженной матрицы} writeln('Отражение с перестановкой;'); for i:=1 to n do for j:=1 to n div 2 do{по строкам идем до середины} begin x:=a[i,j];{запоминаем элемент} a[i,j]:=a[i,n-j+1];{на его место ставим симметричный ему с конца строки} a[i,n-j+1]:=x;{этот ставим в конец, на место перемещенного} end; for i:=1 to n do {выводим матрицу, сейчас она в памяти уже измененнная} begin for j:=1 to n do write(a[i,j]:3); writeln; end; readln end. 3.-Составить функцию для выполнения операции с квадратными матрицами...сложение вычитание...умножение uses crt; const nmax=20;{максимальный размер матриц} type mas=array[1..nmax,1..nmax] of integer;{тип матриц} Procedure Vvod(r:byte;var x:mas);{создание матриц, ввод данных} var i,j:integer; Begin for i:=1 to r do for j:=1 to r do x[i,j]:=random(10);{числа от 0 до 9} end; Procedure Vyvod(r:byte;var x:mas);{вывод на экран} var i,j:integer; begin for i:=1 to r do begin for j:=1 to r do write(x[i,j]:4); writeln; end; end; procedure SummMatr(r:byte;x,y:mas; var w:mas;z:integer);{сложение и вычитание, z=1(сложение или -1, вычитание)} var i,j:integer; begin for i:=1 to r do for j:=1 to r do w[i,j]:=x[i,j]+y[i,j]*z;{складываем элементы матриц со знаком + или минус} end; procedure UmnMatr(r:byte;x,y:mas;var w:mas);{умножение матриц} var i,j,k:byte; begin for k:=1 to r do for j:=1 to r do begin w[k,j]:=0; for i:=1 to r do w[k,j]:=w[k,j]+x[k,i]*y[i,j];{умножаем элементы строки первой матрицы на элементы соответствующкго столбца второй матрицы и складываем} end; end; var a,b,sm,rz,um:mas; n:integer; BEGIN clrscr; repeat write('Razmernjst matric='); readln(n);{вводим размер с проверкой} until (n>0)and(n<=nmax); writeln('Matrica A:'); Vvod(n,a);{создаем матрицу} Vyvod(n,a);{выводим на экран} writeln('Matrica B:');{тоже матрица В} Vvod(n,b); Vyvod(n,b); writeln('Сумма матриц SM=A+B:');{далее выполняем все действия с выводом результата на экран} SummMatr(n,a,b,sm,1); Vyvod(n,sm); readln; writeln('Разность матриц RZ=A-B:'); SummMatr(n,a,b,rz,-1); Vyvod(n,rz); readln; writeln('Произведение матриц UM=A*B:'); UmnMatr(n,a,b,um); Vyvod(n,um); readln end.

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

Вопрос № 164.234

Здраствуйте, помогите написать несколько программ, очень срочно надо.. 1. Дано число N вычислить сумму цифр это числа 2. Вычислить n! для n введенного с клавиатуры. 3. Вычислить сумму ряда s=sin(1)+sin(2)+sin(3)+...+sin(n) для n введенного с клавиатуры. 4. Дано натуральное число N. Проверить, будут ли все цифры числа различными. 5. Натуральные числа a,b,c называют числами Пифагора, если выполняется условие a^2+b^2=c^2.Напечатать все числа Пифагора меньше N введенного с клавиатуры. Помогите пожалуйста, очень нужно..

Отправлен: 06.04.2009, 07:13 Вопрос задал: Загидулин Дмитрий Павлович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Загидулин Дмитрий Павловичь ! Решения задач в приложении. Приложение: 1. Дано число N вычислить сумму цифр это числа uses crt; var n:longint; k,s:byte; begin clrscr; write('n=');readln(n); s:=0; while n>0 do{пока число не ноль} begin k:= n mod 10;{отделяем последнюю цифру} s:=s+k;{складываем} n:=n div 10;{берем число без последней цифры и все повторяем} end; write('Summa=',s); readln end. 2. Вычислить n! для n введенного с клавиатуры. uses crt; var f:extended;{этот тип позволяет получить точное значение для n до 22, если взять целый тип longint, то только до 12} n,i:byte; begin clrscr; write('n=');readln(n); f:=1; for i:=1 to n do{от 1 до n умножаем в цикле все числа по порядку(1*2*3 . .*n)} f:=f*i; write('Faktorial N=',f:0:0);{выводим без дробной части} readln end. 3. Вычислить сумму ряда s=sin(1)+sin(2)+sin(3)+...+sin(n) для n введенного с клавиатуры. uses crt; var n,i:byte; s:real; begin clrscr; write('n=');readln(n); s:=0; for i:=1 to n do s:=s+sin(i);{просто считаем синус очередного числа и складываем} write('s=',s:0:5); readln end. 4. Дано натуральное число N. Проверить, будут ли все цифры числа различными. uses crt; var n:longint;{число} i,kc,kr:byte;{последняя цифра, количество цифр, количество разных} m:set of byte;{множество цифр} begin clrscr; write('n=');readln(n); m:=[];kc:=0;kr:=0;{множество пустое} while n>0 do{пока не нль} begin i:=n mod 10;{отделяем цифру} kc:=kc+1;{считаем количество цифр в числе} if not (i in m )then{если цифры нет в множестве} begin include(m,i);{добавляем} kr:=kr+1;{считаем} end; n:=n div 10;{берем без последней цифры и повторяем} end; if kr=kc then writeln('Все цифры разные!'){если разных=общему количеству, да} else writeln('Не все цифры разные!');{если нет, нет} readln end. 5. Натуральные числа a,b,c называют числами Пифагора, если выполняется условие a^2+b^2=c^2.Напечатать все числа Пифагора меньше N введенного с клавиатуры. uses crt; var n:longint;{число} i,j,k:word;{счетчики} begin clrscr; write('n=');readln(n); for i:=1 to n-1 do{перебираем все варианты} for j:=i+1 to n-1 do for k:=1 to n-1 do if i*i+j*j=k*k then{если условие выполняется} writeln(i:4,j:4,k:4);{выводим} readln end.

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

Вопрос № 164.259

1 задача. Дан двумерный массив целых чисел из 4 столбцов и 3 строк. Найти сумму элементов стоящих до первого нуля. Просмотр вести по строкам. Заменить элементы, стоящие после последнего нуля на эту сумму. Вывести массив по строкам до и после замены. 2 задача. Дана матрица А(nxn). Написать программу нахождения минимального элемента из (max1, ...,maxn), где maxi - максимальный в i - той строке. 3 задача. Дана прямоугольная матрица А(nxn). Заменить наименьший элемент каждой строки, начиная со второй, наибольшим элементом предыдущей строки. 4. Даны целочисленные массивы X и Y с разным количеством элементов. Найти разность между минимальными элементами этих массивов. Помогите пожалуйста....

Отправлен: 06.04.2009, 11:56 Вопрос задала: Яруллина Ирина Булатовна (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Botsman Здравствуйте, Яруллина Ирина Булатовна! Помогаю с первой задачей. Код - в приложении, внутри - подробные комментарии. Рад был помочь! Приложение: const n=3;{kol-vo strok} m=4;{kol-vo stolbtsov} var a:array[1..n,1..m] of integer; i,j:integer; i0,j0:integer;{poziciya poslednego 0} sum:integer;{summa elementov do 1-go 0} flag:boolean;{flag nalichiya 0} BEGIN randomize; {zapolnyaem massiv sluchaynymi tselymi chislami ot -5 do 5} for i:=1 to n do for j:=1 to m do a[i,j]:=trunc(-6+random*12); {vyvodim po strokam ishodniy massiv} writeln('ISHODNIY MASSIV:'); for i:=1 to n do begin for j:=1 to m do write(a[i,j]:4); writeln; end; {po umolchaniyu posledniy 0 - za predelami massiva} i0:=n+1; j0:=m+1; {summiruem vse do pervogo 0 i nahodim posledniy 0} flag:=false;{nul poka ne vstretili} sum:=0; for i:=1 to n do for j:=1 to m do if a[i,j]=0 then begin if not(flag) then flag:=true; {pervyi 0 naiden} {zapominaem koordinaty poslednego iz naidennyh 0} i0:=i; j0:=j; end else if not(flag) then inc(sum,a[i,j]); {zamenyaem vse elementy stroki pravee poslednego 0} for j:=j0+1 to m do a[i0,j]:=sum; {zamenyaem vse stroki nizhe poslednego 0} for i:=i0+1 to n do for j:=1 to m do a[i,j]:=sum; {esli 0 ne bylo, to massiv ne izmenilsya} if not flag then writeln ('Net elementov=0') else begin {vyvodim itogovyi massiv} writeln('ITOGOVIY MASSIV:'); for i:=1 to n do begin for j:=1 to m do write(a[i,j]:4); writeln; end; end; readln; END. --------- Хочешь победить Excel? Спроси меня как! ;)

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Яруллина Ирина Булатовна! Решения задач 2-4 в приложении. Основные моменты пояснил. Приложение: 2 задача. Дана матрица А(nxn). Написать программу нахождения минимального элемента из (max1, ...,maxn), где maxi - максимальный в i - той строке. uses crt; const n=6;{размер} var a:array[1..n,1..n] of integer;{тип} i,j,max,min:integer;{счетчики циклов, макс, мин} begin clrscr; randomize; writeln('Matrica:'); for i:=1 to n do begin for j:=1 to n do begin a[i,j]:=random(20);{числа от 0 до 19} write(a[i,j]:4); end; writeln; end; min:=maxint;{за мин принимаем самое большое число этого типа} for i:=1 to n do begin max:=a[i,1];{пусть макс первый} for j:=2 to n do{идем дальше по строке} if a[i,j]>max then max:=a[i,j];{если есть больший, всех, он максимальный} writeln('Max v stroke ',i,'=',max);{вфводим по строкам} if max<min then min:=max;{если макс меньше предыдущих макс, он мин} end; writeln; write('min iz max=',min);{выводим} readln end. 3 задача. Дана прямоугольная матрица А(nxn). Заменить наименьший элемент каждой строки, начиная со второй, наибольшим элементом предыдущей строки. uses crt; const n=6; var a:array[1..n,1..n] of integer; i,j,max,min,jmax,jmin:integer; begin clrscr; randomize; writeln('Matrica:'); for i:=1 to n do begin for j:=1 to n do begin a[i,j]:=random(20); write(a[i,j]:4); end; writeln; end; for i:=n downto 2 do {снизу матрицы смотрим по 2 строки} begin min:=a[i,1];jmin:=1; for j:=2 to n do{нижняя из двух} if a[i,j]<min then begin min:=a[i,j];{находим мин} jmin:=j;{его номер в строке} end; max:=a[i-1,1];jmax:=1; for j:=2 to n do {верхняя} if a[i-1,j]>max then begin max:=a[i-1,j];{находим макс} jmax:=j;{его номер} end; a[i,jmin]:=a[i-1,jmax];{меняем мин на макс} end; writeln('Rezultat:'); for i:=1 to n do begin for j:=1 to n do write(a[i,j]:4); writeln; end; readln end. 4. Даны целочисленные массивы X и Y с разным количеством элементов. Найти разность между минимальными элементами этих массивов. uses crt; const n1=10; n2=12; var a1,a2:array[1..n2] of integer; i,j,min1,min2:integer; begin clrscr; randomize; writeln('Massiv A1:'); min1:=maxint; for i:=1 to n1 do begin a1[i]:=random(20); if a1[i]<min1 then min1:=a1[i]; write(a1[i]:3); end; writeln; writeln('Min A1=',min1); writeln('Massiv A2:'); min2:=maxint; for i:=1 to n2 do begin a2[i]:=random(20)+10; if a2[i]<min2 then min2:=a2[i]; write(a2[i]:3); end; writeln; writeln('Min A2=',min2); write('Raznost=',abs(min1-min2)); readln end.

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

Вопрос № 164.270

Дыбрый день. Помогите мне пожалуйсто с лабораторной, объяснив в скобках ваши действия. Создать текстовый файл (в котором написаны только числа) и рассортировать числа по возрастанию методом выбора, добавив один ноль(если его не было). Результат записать в одномерный массив

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

Отвечает: Boriss Здравствуйте, Горбунов Михаил Валерьевич! Исходный файл: Код: -1 -12 -8 -14 -46 -23 -17 -7 Вывод: Код: Прочитано чисел: 9 -46 -23 -17 -14 -12 -8 -7 -1 0 Приложение: CONST FileName = '194270.dat'; {Имя текстового файлаю Полагаем, что создан и в нем в тестовом редакторе записаны целые числа} N = 1000; {максимальная разерность массива} VAR f: Text; {Создаем переменную для связи с текстовым файлом} ar: array[1..N] of Integer; i, j, min, buf, count: Integer; {число записанных чисел} BEGIN Assign(f, FileName); {Связываем файловую переменную с именем} {$I-} {Отключаем контроль операций ввода-вывода. Если этого не сделать то, если файла нет или его нельзя открыть (может уже открыт), наша программа завершится аварийно. Даже не узнаем, почему} Reset(f); {Открываем для чтения} if IOResult <> 0 then {Была ошибка} begin WriteLn('Не могу открыть файл ',FileName); Halt(1); {завершаем программу с кодом ошибки 1} end; {$I+} count := 0; while NOT EOF(f) do begin {Пока не достигнут конец файла EndOfFile = EOF возвращает TRUE, если достигнут конец файла} {$I-} {А вдруг не число!} Read(f, i); {Вот так читается из файла! Первый параметр = файловая переменная} {$I+} if IOResult = 0 then begin inc(count); {увеличиваем count на 1} ar[count] := i; {Записываем в массив, если все хорошо} end else Break; {Break = немедленный выход из цикла. Сколько считано - столько считано} end; Close(f); {Закрываем файл - так надо} case count of 0: {Ничего не считано} WriteLn('Ничего не удалось прочитать'); 1: {Нечего сортировать. Проверим, ноль ли?} begin if ar[count] <> 0 then if ar[count] < 0 then begin inc(count); ar[count] := 0; end else begin inc(count); ar[count] := ar[1]; ar[1] := 0 end; end; {В противном случае ничего тут не делаем} end; {Сортировка} if count > 1 then for j:=1 to count - 1 do begin min := j; for i:=min+1 to count do if ar[i] < ar[min] then min := i; buf := ar[min]; ar[min] := ar[j]; ar[j] := buf; end; {Теперь ищем, куда вставить ноль и нужно ли?} j := 0; {такого индекса нет - если окажется не ноль, то ноль есть и его индекс = j} for i:=1 to count do if ar[i] = 0 then begin j:=i; Break end; if j = 0 then {Ноль не обнаружен, но могут быть отрицательные и положительные числа} begin i := 1; {Пока не "прошли" массив и элементы отрицательные, увеличиваем i} while (i < count) and (ar[i] < 0) do inc(i); if i = 1 then begin inc(count); {"Увеличиваем" размерность массива} for j:=2 to count do ar[j]:=ar[j-1]; {смещаем на единицу} ar[1] := 0 {первым записываем ноль} end else if i = count then {все числа отрицательные - все просто = в конец ноль} begin inc(count); ar[count] := 0; end else begin {i = номер ПЕРВОГО положительного} inc(count); {переносим = освобождаем место под 0} for j:=count downto i do ar[j] := ar[j-1]; ar[i] := 0 end; end; {Показ массива} if count > 0 then begin WriteLn('Прочитано чисел: ',count); for i:=1 to count do Write(ar[i]:8); end; WriteLn; END. --------- Вывод - то место в тексте, где вы устали думать

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

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