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

Выпуск № 591
от 03.03.2008, 12:05

Вопрос № 124.889

здрасти) посмотрите задачку... Дан одномерный массив. Упорядочить его по убыванию.

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

Отвечает: Николай Владимирович / Н.В. Здравствуйте, родион! Программа в приложении. Удачи! Приложение: const N = 10; var a : array [1..10] of integer; procedure vvod; var i:integer; begin for i:=1 to N do a[i]:=random(100); end; procedure vyvod; var i:integer; begin for i:=1 to N do writeLn(a[i]); end; function findmax(k:integer):integer; var i, max : integer; begin max := k; for i := k+1 to N do if a[i] > a[max] then max := i; findmax := max; end; procedure change(var a,b:integer); var t : integer; begin t := a; a := b; b := t; end; procedure sort; var i:integer; begin for i := 1 to N-1 do change(a[findmax(i)],a[i]); end; begin randomize; vvod; vyvod; writeln; sort; vyvod; ReadLn; end.

Ответ отправил: Николай Владимирович / Н.В. (статус: Профессионал) Россия, Москва WWW: nvsoft.org ICQ: 420720 ---- Ответ отправлен: 26.02.2008, 17:59 Оценка за ответ: 5

Вопрос № 124.936

здравствуйте! помогите решить задачу по проге. тема( обработка одномерных массивв) задание (даны две последовательности целых чисел, определить явл. ли множество чисел первой последов. подмножеством второй. Если явл. то упорядочить первую по возростанию(не использовать exit,break ...) night_ghost2009@mail.ru

Отправлен: 26.02.2008, 16:02 Вопрос задал: Ворожбянов Евгений С. (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Delph Здравствуйте, Ворожбянов Евгений С.! В приложении - решение Вашей задачки. Обе последовательности заполняются при помощи функции Random - генератора (псевдо)случайных чисел. Если хотите, чтобы первая послед-ть более часто полностью оказывалась подмножеством второй, уменьшите константу MaxInt. Приложение: Program Pr124936; Const MaxInt = 100; { Ограничитель на величину наших чисел } N1 = 16; N2 = 240; Var Arr1 : Array[1..N1] of Integer; Arr2 : Array[1..N2] of Integer; B1, b2 : Boolean; i, j, r: Integer; Begin Randomize; WriteLn; WriteLn('Первая последовательность чисел:'); for i := 1 to N1 do begin Arr1[i] := Random(MaxInt); Write(Arr1[i]:4); if i mod 16 = 0 then WriteLn; end; WriteLn; WriteLn('Вторая последовательность чисел:'); for i := 1 to N2 do begin Arr2[i] := Random(MaxInt); Write(Arr2[i]:4); if i mod 16 = 0 then WriteLn; end; WriteLn; B1 := True; { Пока не нашли нарушений, считаем, что всё в порядке } for i := 1 to N1 do begin b2 := False; { Встречается ли Arr1[i] хотя бы раз в Arr2 ? } for j := 1 to N2 do b2 := (b2 or (Arr1[i] = Arr2[j])); { Если в Arr1 есть хоть одно число, которого нет в Arr2, в b1 получаем False } b1 := (b1 and b2); end; if b1 then begin WriteLn('Первая послед-ть полностью входит во вторую!'); for i := 1 to N1 - 1 do for j := i + 1 to N1 do if Arr1[j] < Arr1[i] then begin r := Arr1[i]; Arr1[i] := Arr1[j]; Arr1[j] := r; end; WriteLn('Результат сортировки первой последовательности:'); for i := 1 to N1 do begin Write(Arr1[i]:4); if i mod 16 = 0 then WriteLn; end; WriteLn; end else begin WriteLn('Увы...'); end; ReadLn; End. --------- Сомневайся во всём! Реальность часто бывает не такой, как мы о ней думаем.

Ответ отправил: Delph (статус: Студент) Ответ отправлен: 27.02.2008, 13:18

Вопрос № 124.937

здравствуйте! помогите реш задачу. тема(использование подпрограмм при работе с двумерными массивами) задание (упорядочить строки данной вещественной матрици по неубыванию наибольших элементов строки) не использовать (exit,break...)

Отправлен: 26.02.2008, 16:05 Вопрос задал: Ворожбянов Евгений С. (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Николай Владимирович / Н.В. Здравствуйте, Ворожбянов Евгений С.! Программа в приложении. Удачи! Приложение: uses crt; const N = 5; M = 7; var A:array [1..N, 1..M] of integer; procedure vvod; var i,j:integer; begin for i:=1 to N do for j := 1 to M do a[i,j]:=random(10); end; procedure vyvod; var i, j:integer; begin for i:=1 to N do begin for j := 1 to M do write(a[i,j],' '); WriteLn; end; end; procedure change(l1,l2:integer); var i,t : integer; begin for i := 1 to M do begin t := A[l1,i]; A[l1,i] := A[l2,i];; A[l2,i] := t; end; end; function max(k:integer):integer; {returns max value in line k} var i, res : integer; begin res := A[k,1]; for i := 2 to M do if A[k,i] > res then res := A[k,i]; max := res; end; function findmin(k:integer):integer; var i, res : integer; begin res := k; for i := k+1 to N do if max(i) < max(res) then res := i; findmin := res; end; var i : integer; begin randomize; clrscr; writeln; vvod; vyvod; writeln; for i := 1 to N do begin change(findmin(i),i); end; vyvod; ReadLn; end.

Ответ отправил: Николай Владимирович / Н.В. (статус: Профессионал) Россия, Москва WWW: nvsoft.org ICQ: 420720 ---- Ответ отправлен: 26.02.2008, 18:35

Вопрос № 124.939

здравствуйте! помогите реш задачу. тема(использование функций при работе со строками) задание (определить упорядочены ли лексикографически слова данного предложения) не использовать (exit,break...) Night_Ghost@mail.ru

Отправлен: 26.02.2008, 16:07 Вопрос задал: Ворожбянов Евгений С. (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Николай Владимирович / Н.В. Здравствуйте, Ворожбянов Евгений С.! Программа в приложении. Удачи! Приложение: function Trim(const S: string): string; var I, L: Integer; res : string; begin L := Length(S); I := 1; while (I <= L) and (S[I] <= ' ') do Inc(I); if I > L then res := '' else begin while S[L] <= ' ' do Dec(L); Res := Copy(S, I, L - I + 1); end; Trim := res; end; Function CountWords(s : String) : Integer; var res : integer; begin {delete double spaces} s := Trim(s); While pos(' ', s) > 0 do delete(s, pos(' ',s), 1); res := 0; s := Trim(s); While pos(' ',s)>0 do begin s := copy(s, pos(' ',s)+1, Length(s) - pos(' ', s)); s := Trim(s); inc(res) end; CountWords := res+1; End; Function GetWord(s : String; i : Integer) : String; var s1 : string; k : integer; begin s1 := s; For k := 1 To i - 1 do s1 := trim(copy(s1, pos(' ',s1)+1, Length(s1) - pos(' ', s1)+1)); If pos(' ', s1) > 0 Then GetWord := copy(s1, 1, pos(' ',s1) - 1) Else GetWord := Trim(s1); End; function check(s:string;a,b:integer):boolean; var res : boolean; w1, w2 :string; begin w1 := getword(s,a); w2 := getword(s,b); check := (w1 < w2) end; const symbols = ',:;.!?'; { znaki prepinaniya } var s : string; i, c : integer; res : boolean; {true - если слова упорядочены} begin WriteLn('Vvedite stroku:'); ReadLn(s); WriteLn; if trim(s) <> '' then begin { change all symbols to spaces } for i := 1 to length(s) do if (pos(copy(s,i,1),symbols)>0) then begin insert(' ',s,i); delete(s,i+1,1); end; {delete double spaces} s := Trim(s); While pos(' ', s) > 0 do delete(s, pos(' ',s), 1); c := countwords(s); i := 2; res := true; while (i <= c)and(res) do begin if not check(s, i-1, i) then res := false; inc(i) end; end; WriteLn; if res then WriteLn('uporyadocheny') else WriteLn('Ne uporyadocheny.'); ReadLn; end.

Ответ отправил: Николай Владимирович / Н.В. (статус: Профессионал) Россия, Москва WWW: nvsoft.org ICQ: 420720 ---- Ответ отправлен: 26.02.2008, 19:36

Вопрос № 125.025

Здравствуйте помогите мне пожалуйста ! Я изучаю Паскаль но уменя проблема.не могу пройти на граф режим.всё написала var DriverVar, ModeVar: integer; begin DriverVar:=Detect; InitGraph(DriverVar, ModeVar,’TPGRAPH’); или пишу программу .... uses graph;... на что паскаль ведет ошибку: file not found GRAPH.TPU этот файл лежит в папке units / что нужно сделать, чтоб графика работала?

Отправлен: 26.02.2008, 23:15 Вопрос задала: Nargis Haydarova (статус: Посетитель) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Verena Здравствуйте, Nargis Haydarova! Если файл есть, а он при запуске его не находит, значит, скорей всего, он не знает путь к нужной директории. Попробуйте в самом Паскале (программе) прописать в Options->Directories->EXE&TPU directories путь к папке с модулями. Если после этого программа будет запускаться, но инициализация графического режима будет неудачна, проверьте, правильно ли указан путь к файлу драйвера egavga.bgi (если Вы используете VGA режим), т.е. файл с таким названием должен лежать в TPGRAPH (если он в другой папке, надо указать её). Рекомендую проверить на GraphResult после вызова InitGraph. Удачи! --------- Эта история - не для истории, понимаешь?

Ответ отправила: Verena (статус: Студент) Ответ отправлен: 26.02.2008, 23:51 Оценка за ответ: 4

Отвечает: Шемет Станіслав Васильович Здравствуйте, Nargis Haydarova! Значит если у тебя полный путь к Graph.tpu вот такой "d:pascalgiGraph.tpu" То надо писать : var DriverVar, ModeVar: integer; begin DriverVar:=Detect; InitGraph(DriverVar, ModeVar,’d:pascalgi’); Но можно еще написать и так: var DriverVar, ModeVar: integer; begin DriverVar:=Detect; InitGraph(DriverVar, ModeVar,’’); Токо тогда надо чтоб Graph.tpu была в тойже папке что и программа. --------- Любовь это прекрасно!!!

Ответ отправил: Шемет Станіслав Васильович (статус: 3-ий класс) Ответ отправлен: 27.02.2008, 12:50 Оценка за ответ: 4

Отвечает: Евчик Сергей Александрович Здравствуйте, Nargis Haydarova! Все дело в том что graph.tpu находится в папке UNITS. Скопируйте его в папку BIN и все должно получиться

Ответ отправил: Евчик Сергей Александрович (статус: 2-ой класс) Ответ отправлен: 27.02.2008, 16:28 Оценка за ответ: 5 Комментарий оценки: Cпасибо большое всё получилось

Вопрос № 125.067

Вычислить тангенс X по данной формуле: tgX=sinX/cosX Значения тангенса и "икса" вывести в текстовой файл.

Отправлен: 27.02.2008, 10:27 Вопрос задал: Romi4 (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Delph Здравствуйте, Romi4! В приложении пример программы под Вашу задачу. Запрашиваются начальное и конечное значение для x. Если программа заметит, что tg(x) по модулю устремляется к бесконечности, то вместо значения подставит в строку INFINITY, после чего продолжит дальнейшие вычисления. Результаты вычислений отображаются на экран и одновременно выводятся в файл Pr125067.txt, имя которого Вы можете изменить. Приложение: Program Pr125067; var f: TextFile; Min, Max, Delta, Eps, x, y: Real; Begin Assign(f, 'Pr125067.txt'); Rewrite(f); Write('Начальное значение x = '); ReadLn(Min); Write('Конечное значение x = '); ReadLn(Max); Write('Шаг изменения по x = '); ReadLn(Delta); eps := 1e-6; { Если Abs(Cos(x)) < Eps, то считаем тангенс бесконечным } x := Min; Repeat if Abs(Cos(x)) >= Eps then begin y := Sin(x) / Cos(x); WriteLn(f, 'x = ', x:8:5, ' tg(x) = ', y:12:5); WriteLn('x = ', x:8:5, ' tg(x) = ', y:12:5); end else begin WriteLn(f, 'x = ', x:8:5, ' tg(x) = INFINITY'); WriteLn('x = ', x:8:5, ' tg(x) = INFINITY'); end; x := x + Delta; Until x > Max; Close(f); ReadLn; End. --------- Сомневайся во всём! Реальность часто бывает не такой, как мы о ней думаем.

Ответ отправил: Delph (статус: Студент) Ответ отправлен: 27.02.2008, 11:20

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