Форум
» Назад на решение задач по физике и термеху
Регистрация | Профиль | Войти | Забытый пароль | Присутствующие | Справка | Поиск

» Добро пожаловать, Гость: Войти | Регистрация
    Форум
    Информационные технологии
        Решение задач на Pascal. Форум 2
Отметить все сообщения как прочитанные   [ Помощь ]
» Добро пожаловать на форум "Информационные технологии" «

Переход к теме
<< Назад Вперед >>
Несколько страниц [ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 ]
Модераторы: paradise, KMA
  

Dale



Участник

DELUZA  , сами решайте
Простое число - число, делящееся только на себя и на 1. Не вызовет затруднений перебрать все числа в цикле, пока не найдется нужное

(Сообщение отредактировал Dale 16 июня 2009 15:46)


(Сообщение отредактировал Dale 16 июня 2009 17:20)

-----
Прикольная песня :-)

Всего сообщений: 139 | Присоединился: май 2009 | Отправлено: 15 июня 2009 23:44 | IP
Dale



Участник

Дру&#769;жественные чи&#769;сла  - два натуральных числа&#769;, для которых сумма всех делителей первого числа&#769; (кроме него самого) равна второму числу и сумма всех делителей второго числа&#769; (кроме него самого) равна первому числу
Согласно материалам википедии, http://ru.wikipedia.org/wiki/%D0%94%D1%80%D1%83%D0%B6%D0%B5%D1%81%D1%82%D0%B2%D0%B5%D0%BD%D0%BD%D1%8B%D0%B5_%D1%87%D0%B8%D1%81%D0%BB%D0%B0
общего способа нахождения таких пар нет до сих пор.

Но пар  др. чисел мало: всего 13 для k<100 000. Возможно, прокатит обычный их вывод?



(Сообщение отредактировал Dale 16 июня 2009 16:03)

-----
Прикольная песня :-)

Всего сообщений: 139 | Присоединился: май 2009 | Отправлено: 16 июня 2009 16:01 | IP
DikayaKiska


Новичок

Мальчишки помогите пожалуйста глупенькой девушке с паскалем ....
решите 2 простеньких задачки плз..... и если можете напишите объяснение нам так препод требует, заранее чмокси.....
Удалить все элементы, кроме имеющих заданное произведение цифр
Составить вектор минимальных чисел Фибоначчи в столбцах матрицы.
ПОскаль - сделать решение

Всего сообщений: 2 | Присоединился: июнь 2009 | Отправлено: 16 июня 2009 17:30 | IP
Dale



Участник

DikayaKiska  
1)Как я понимаю, речь идет об эллементах массива? И удалять нужно наварняка со сдвигом?
Тогда алгоритм следующий:

1)С помощью процедуры readln организовываем ввод с клавиатуры массива и двух чисел.
2)Перебераем в цикле  while массив и сравниваем его элементы с произведением этих чисел. Если что-то совпало, то:
  - Если да: сдвигаем массив начиная со следующего элемента, при этом не забыв уменьшить N (количество элементов в массиве).
  - Если нет: увеличиваем счетчик i, для на следующий элемент массива
Условие выхода из цикла - если i = n.
3)Выводим массив.

Код выглядит примерно так:
____________________
uses crt;       {подкл. модуль crt, необходимый для исп.
                      процедуры readkey в конце и clrscr}
const N1=5; {Количество элементов в массиве
                     константа потому, что описание массива в
                     разделе var этого требует. Для операций будет
                     исп. переменная N, которой будет присвоено    
                     значение N1 перед входом в цикл.}
var N,i,j:integer;
     a,b:integer;{числа, вводимые с клавиатуры}
     mas:array[1..N1] of integer; {массив}
begin
clrscr;
writeln('BBEDUTE nOO4EPEDHO  MaCCuB');
for i:=1 to N1 do readln(mas[ i ]);

{BbIB.  massiv dJI9I ydo6cTBA }
clrscr;{очистка экрана}

for i:=1 to N1 do write(mas[ i ],'  ');
writeln('Введите два числа');
readln(a); readln(b);
writeln;
i:=1;
N:=N1;
While i<>N do begin
 if mas[ i ]=(a*b) then begin
     
        for j:=i to N-1 do mas[ j ]:= mas[ j + 1];
        N:=N-1;
     
 end else i:=i+1;
 
end;{Вот и все!}  

{выводим массив}
writeln;
for i:=1 to N do write(mas[ i ],'  ');
readkey;{Ждеп, пока нажмут клавишу}

end.



(Сообщение отредактировал Dale 17 июня 2009 1:06)

-----
Прикольная песня :-)

Всего сообщений: 139 | Присоединился: май 2009 | Отправлено: 17 июня 2009 0:36 | IP
Dale



Участник

Если по 1-ой задаче есть вопросы, обращайтесь
Что касается второй, то я забыл, что такое числа Фибоначчи.

(Сообщение отредактировал Dale 17 июня 2009 0:43)

-----
Прикольная песня :-)

Всего сообщений: 139 | Присоединился: май 2009 | Отправлено: 17 июня 2009 0:40 | IP
KMA



Долгожитель

Числа Фиббоначи это одна из сторон треугольника Паскаля. Здесь рассматривалась не раз.

Их суть: 1 1 2 3 5 8 13 21 и т. д., т. е. каждое последующее число является суммой двух предыдущих. Реализуется примерно так:

Code Sample:
 
fst:=1;
scnd:=1;
i:=0;
write(scnd);
while (i<=20) do
begin
  buf:=scnd;
  scnd:=scnd+fst;
  fst:=buf;
  write(scnd, ' ');
  inc(i)
end;



Вроде должно работать.

-----
Gentoo, FreeBSD 7.2, PHP, JavaScript (jQuery), Python, Shell
Помогаю с задачами только на форуме.
Все мои действия четко согласуются с правилами раздела. Поэтому никаких претензий и обид.

Всего сообщений: 940 | Присоединился: декабрь 2005 | Отправлено: 19 июня 2009 18:38 | IP
Lenin



Новичок

Опять здравствуйте! Помогите мне пожалуйста!
Мне нада сделать курсовую роботу. У меня есть три задачи, из них одна готовая, другуя нада чуть чуть переделать, а третью сделать! Есть готовое меню и пример курсовой роботы! протсо нада подставить все мое и сделать так чтобы она работала! если этим ктонибудь займется прошу написать!

Всего сообщений: 12 | Присоединился: май 2009 | Отправлено: 21 июня 2009 13:11 | IP
Lenin



Новичок

Міністерство освіти і науки України
Київський національний університет будівництва і архітектури
Кафедра АТП








Курсова робота на тему:
“Створення меню”





Виконав: студент групи АТП-12
Досенко А.М.
Перевірив викладач: Бондарчук О.В.






Київ 2009
Курсова робота №26

1.Дано файл f, в якому знаходиться інформація про товари, що експортуються: вказується найменування товару, країна, яка імпортує товар і об’єм партії в штуках. Знайти країни, в які експортується даний товар, і загальний об’єм його експорту.
2.Дано дійсні числа а&#8321;,…,а&#8321;&#8325; (всі числа попарно різні). Поміняти у послідовності місцями найбільший та найменший елементи.
3.Дано дійсна матриця порядку n. Знайти найбільший по модулю елемент. Отримати квадратну матрицю порядку n-1 шляхом викидання з початкової матриці будь-якого рядка та стовпця, на перетині яких розташований максимальний елемент.

































Теоретичні відомості

Для розробки меню обов’язково використовується модуль crt. В ньому містяться усі необхідні функції та процедури для створення інтерактивного середовища, в якому буде повноцінний зв'язок між діями користувача та переходом між операціями запрограмованими в меню. Завдяки йому здійснюється повний контроль положення курсору та всього, що виводиться на екран, зміна кольору тексту  чи фону, використання звукових сигналів.
Подібні меню є повністю придатними для роботи з базами даних, обчисленням необхідних задач і, знову ж таки, подальшого оперування з отриманими в них результатами. Користувач сам зможе вибрати необхідний підпункт меню, необхідну кількість раз до завершення головної програми.
Для кращого візуального сприйняття програми, можна також використовувати модуль graph, який дозволить “оживити” меню за допомогою виведення на екран графічних об’єктів.










































 
   1                                 2                                                     3                                else








                                                                 4





Текст головної програми

Program DosMenu;
uses crt, graph, export, archis, matrix;
const
k=4;
NameRegime:array[1..k] of string[26]=('1 - work with files',
                                     '2 - work with digits',
                                     '3 - work with matrix',
                                     '4 - exit');
var
driver, mode, error:integer;
x1,x2,x3,y1,y2,y3,i,j,w,z,deltime,grm:integer;
p:array[1..20] of pointtype;
ch:char;
label
mlab;

procedure intro;
begin
driver:=detect;
initgraph(driver,mode,'C:\Program Files\TURBO PASCAL 7.1\BGI');
error:=graphresult;
getgraphmode;
if error <> grok then begin
writeln (grapherrormsg(error));
halt; end
else
begin

x1:=((getmaxx div 2)-150);
x2:=((getmaxx div 2)+152);
y1:=((getmaxy div 2)-70);
y2:=((getmaxy div 2)+72);
setfillstyle (1, white);
bar (x1,y1,x2,y2);
setcolor (black);
settextjustify (centertext,centertext);
outtextXY(getmaxx div 2, (getmaxy div 2)-30, 'Welcome to D91-Menu');
outtextXY(getmaxx div 2, (getmaxy div 2)+20, 'press any key to continue');
repeat
sound (300);
delay (4000);
setfillstyle (1,white);
nosound;
delay (50000);
delay (50000);
sound (300);
delay (4000);
setfillstyle (1,white);
nosound;
bar ((getmaxx div 2)-120, (getmaxy div 2)+10, (getmaxx div 2)+120, (getmaxy div 2)+30);
delay (50000);
delay (50000);

for i:=1 to 20 do
    with p do begin
    w:=random (16);
    x:=random(getmaxx);
    y:=random(getmaxy);
    putpixel (x,y,w);
    end;
    setfillstyle (1, white);
bar (x1,y1,x2,y2);
setcolor (black);
settextjustify (centertext,centertext);
settextstyle (3,0,9);
outtextXY(getmaxx div 2, (getmaxy div 2)-30, 'Welcome to D91-Menu');
outtextXY(getmaxx div 2, (getmaxy div 2)+20, 'press any key to continue');
    delay (500);
    until keypressed;
restorecrtmode;
end;
end;

procedure fin;
begin
  setgraphmode (grm);
  settextjustify (centertext,centertext);
  outtextxy (getmaxx div 2, (getmaxy div 2), 'Have a nice day!');
   sound (400);
  delay (20000);
  sound (500);
  delay (20000);
  sound (600);
  delay (40000);
  nosound;
  repeat
  for i:=1 to 20 do
    with p do begin
    w:=random(16);
    x:=random(getmaxx);
    y:=random(getmaxy);
    putpixel (x,y,w);
    end;
    delay (50000); delay (50000);
   for i:=1 to 20 do
     with p do begin
     w:=0;
     putpixel (x,y,w);
     end;

  until keypressed;
  readln;
  halt;
end;

procedure errorro;
begin
gotoxy (20,17);
  write ('This option doesnt exists. Try again.');
  sound (300);
  delay (20000);
  nosound;
  for deltime:=1 to 8 do
  delay (50000);
end;

begin

intro;

while True do begin
clrscr;

gotoXY (18,2);
write ('===============================================');
gotoXY (18,18);
write ('===============================================');
z:=3;
repeat
gotoXY (17,z);
write ('|');
z:=z+1
until z=18;
z:=3;
repeat
gotoXY (65,z);
write ('|');
z:=z+1
until z=18;

gotoXY (24, 4);
textcolor (green);
write ('Main menu');
textcolor (white);
for j:=1 to k do begin
gotoXY (25, 7+j);
write (nameregime[j]);
end;
gotoXY (20,15);
write ('Type in number of option and press enter: ');
gotoxy (62,15);
readln (i);
case i of
1: begin
  clrscr;
  dataexp;
  workexp;
  end;
2: begin
  clrscr;
  datachis;
  workchis;
  outchis;
  readln;
  end;
3: begin
  clrscr;
  datamatr;
  workmatr;
  outmatr;
  end;
4: begin
  fin;
  end;

  else
  begin
  errorro;
  end; end; end;
  end.






Текст модуля “export”

unit export;
    interface
const
n=10;
type
tovar=record
g:string[6];
c:string[11];
a:integer;
end;
var
sg:string;
t:array[1..n] of tovar;
f:file of tovar;

procedure dataexp;
procedure workexp;

    implementation

procedure dataexp;
var
i:integer;
begin
assign (f, 'expo.txt');
rewrite (f);
for i:=1 to n do begin
write ('Type in goods name: ');
readln (t.g);
write ('Type in country name: ');
readln (t.c);
write ('Type in amount of a deal: ');
readln (t.a);
writeln;
write (f, t);
end;
close (f);
end;

procedure workexp;
var
i:integer;
begin
write ('- Chose type of good: ');
readln (sg);
reset (f);
writeln;
writeln (sg, ' is exported to: ');
for i:=1 to n do begin
read (f, t);
with t do begin
if g=sg then
writeln (c, ' in amount of ', a);
end; end;
readln
end;
end.






























Текст модуля archis

unit archis;
    interface
const
n=15;
type
digi=array[1..n] of real;
var
achis:digi;

procedure datachis;
procedure workchis;
procedure outchis;

   implementation

procedure datachis;
var i:integer;
begin
writeln ('Type in 15 digits');
for i:=1 to n do
read (achis);
end;

procedure workchis;
var
i,j,k:integer;
max,min:real;
begin
min:=200; max:=-200;
for i:=1 to n do begin
if achis > max then begin
max:=achis;
j:=i;
end;
end;
for i:=1 to n do begin
if achis < min then begin
min:=achis;
k:=i;
end;
end;
achis[j]:=min;
achis[k]:=max;
end;

procedure outchis;
var
i:integer;
begin
writeln ('New array');
for i:=1 to n do
write (achis:3:0, ' ');
readln
end;
end.
































Текст модуля matrix

unit matrix;
    interface
const
n=5;
type
matr=array[1..n, 1..n] of integer;
newmatr=array[1..n-1, 1..n-1] of integer;
var
mat:matr;
newmat:newmatr;

procedure datamatr;
procedure workmatr;
procedure outmatr;

   implementation

procedure datamatr;
var i,j:integer;
begin
writeln ('Type in matrix elements');
writeln;
for i:=1 to n do begin
for j:=1 to n do
        read (mat[i,j]);
        readln;
        end;
end;

procedure workmatr;
var i,j,k,t,i2,j2,max:integer;
begin
max:=-200;
for i:=1 to n do
for j:=1 to n do
if abs(mat[i,j]) > max then begin
max:=abs(mat[i,j]);
k:=i; t:=j;
end;
i2:=1; j2:=1;
for i:=1 to n do begin
for j:=1 to n do
if (i<>k) and (j<>t) then begin
newmat[i2,j2]:=mat[i,j];
if j2=4 then begin
j2:=1; i2:=i2+1;
end
else j2:=j2+1;
end;
end; end;

procedure outmatr;
var
i,j:integer;
begin
writeln;
writeln ('New matrix');
writeln;
for i:=1 to n-1 do begin
for j:=1 to n-1 do
write (newmat[i,j], ' ');
writeln;
end;
readln;
end;
end.





















Результати роботи пункту меню №3

Type in matrix elements

3 4 1 2 0
5 2 0 3 2
4 9 1 6 7
1 3 4 7 2
0 3 5 2 8

New matrix
3 1 2 0
5 0 3 2
1 4 7 2
0 6 2 8








Пояснення до програми

В даній роботі були використані наступні процедури та функції модуля crt:

- clrscr; – очищення екрану від раніше виведеного тексту;
- sound (І); – використання в програмі звукового сигналу з вбудованого в комп'ютер динаміка. І – частота звуку в герцах ;
- nosound; – вимкнення динаміку;
- delay (F); – забезпечує затримку роботи програми на заданий інтервал часу F (у мілісекундах);
- gotoxy (x,y); – встановлює курсор в положення з відповідно заданими координатами x (по горизонталі) та y (по вертикалі) відносно поточного вікна;
- textcolor (color); – надання тексту на екрані необхідного кольору. Щоб задати колір, можна використовувати як відповідний код, так і вводити назву кольору англійською мовою;
- keypressed; – повертає логічне значення true, якщо натиснута будь-яка клавіша та false у протилежному випадку;




Всего сообщений: 12 | Присоединился: май 2009 | Отправлено: 21 июня 2009 13:14 | IP
Lenin



Новичок

Из всего выше написаного нада сделать такоеже только с моими задачами! А вот и они!  http://fileshare.in.ua/2089003

Всего сообщений: 12 | Присоединился: май 2009 | Отправлено: 21 июня 2009 13:29 | IP
Lenin



Новичок

меню у нас есть, нужно вставить процедуры к задачам. если так удобнее, то можно написать отдельный модуль для каждой и уже их использовать в основном меню.
в самом меню должно быть задействовано не меньше пяти процедур, функций модуля crt.
потом сделать блоксхемы - одна ко всему меню в общем и ещё к каждой отдельной задаче тоже прописать блоксхему как она работает.
в обьяснении к програме нужно написать какие и для чего использовались функции, процедуры crt и дальше главные моменты всего меню описать, с помощью чего, что у нас там происходит

ВОООООТ!

Всего сообщений: 12 | Присоединился: май 2009 | Отправлено: 21 июня 2009 13:34 | IP

Эта тема закрыта, новые ответы не принимаются

Переход к теме
<< Назад Вперед >>
Несколько страниц [ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 ]

Форум работает на скрипте © Ikonboard.com