1 2 1.
3 PROGRAM binary_search;
4 5 {Program to search a number using binary search}
6 7 USES crt;
8 9 TYPE index=1..100;
10 VAR arr:ARRAY[1..100] OF index;
11 VAR mid,low,high,search:integer;
12 i,n:index;
13 found:boolean;
14 15 BEGIN
16 clrscr;
17 writeln('BINARY SEARCH');
18 writeln('Enter the array size');
19 readln(n);
20 writeln('Enter the array elements');
21 FOR i:=1 TO n DO
22 BEGIN
23 readln(arr[i]);
24 END;
25 writeln('Enter the search element');
26 readln(search);
27 low:=1;
28 high:=n;
29 found:=false;
30 REPEAT
31 mid:=trunc(low+high) DIV 2;
32 IF (search<arr[mid]) THEN
33 high:=mid-1;
34 IF (search>arr[mid]) THEN
35 low:=mid+1;
36 IF (search=arr[mid]) THEN
37 found:=true
38 ELSE
39 found:=false;
40 UNTIL ((found=true) OR (high<low));
41 IF found=true THEN writeln('ELEMENT FOUND')
42 ELSE writeln('ELEMENT NOT FOUND');
43 END.
44 45 2.
46 PROGRAM linear_search;
47 48 {Program to search a number using linear search}
49 50 USES crt;
51 52 TYPE index=1..100;
53 54 VAR n,searchkey,i:integer;
55 found:boolean;
56 arr:ARRAY[1..100] OF index;
57 58 BEGIN
59 writeln('LINEAR SEARCH');
60 writeln('Enter the boundary of the array');
61 readln(n);
62 writeln('Enter the array elements');
63 FOR i:=1 TO n DO
64 BEGIN
65 readln(arr[i]);
66 END;
67 i:=1;
68 found:=false;
69 writeln('Enter the search element');
70 readln(searchkey);
71 WHILE ((i<=n) AND (found=false)) DO
72 BEGIN
73 IF arr[i]=searchkey THEN
74 found:=true
75 ELSE found:=false;
76 i:=i+1;
77 END;
78 IF found=true THEN
79 writeln('ELEMENT FOUND')
80 ELSE
81 writeln('ELEMENT NOT FOUND');
82 END.
83 84 3.
85 PROGRAM bubble_sort;
86 87 CONST items=100;
88 89 VAR n,temp,pass,index:integer;
90 sorted:boolean;
91 vector:ARRAY[1..items] of integer;
92 93 PROCEDURE sort;
94 95 BEGIN
96 pass:=1;
97 REPEAT
98 sorted:=true;
99 FOR index:=1 TO items-pass DO
100 BEGIN
101 IF vector[index]>vector[index+1] THEN
102 BEGIN
103 sorted:=false;
104 temp:=vector[index];
105 vector[index]:=vector[index+1];
106 vector[index+1]:=temp;
107 END;
108 END;
109 pass:=pass+1;
110 UNTIL sorted;
111 END;
112 113 BEGIN
114 writeln('How many elements');
115 readln(n);
116 writeln('Enter the unsorted elements');
117 index:=1;
118 REPEAT
119 readln(vector[index]);
120 index:=index+1;
121 UNTIL index=n+1;
122 sort;
123 writeln('Sorted Data');
124 FOR index:=1 TO items DO
125 BEGIN
126 IF ((index-1) MOD 10)=0 THEN writeln;
127 writeln(vector[index]:4);
128 END;
129 writeln('Total number of passes=> ',pass);
130 writeln;
131 END.
132 133 4.
134 PROGRAM insertion_sort;
135 136 {Program to sort the given nos using insertion sort}
137 138 USES crt;
139 140 VAR a:ARRAY[1..100] of real;
141 142 VAR temp:real;
143 i,j,n:integer;
144 145 BEGIN
146 clrscr;
147 writeln('Enter the boundary of the array');
148 readln(n);
149 writeln('Enter the elements of the array');
150 FOR i:=1 TO n DO
151 BEGIN
152 readln(a[i]);
153 END;
154 FOR i:=2 TO n DO
155 BEGIN
156 j:=i-1;
157 WHILE ((j>=1) AND (a[j+1]<a[j])) DO
158 BEGIN
159 temp:=a[j];
160 a[j]:=a[j+1];
161 a[j+1]:=temp;
162 j:=j-1;
163 END;
164 END;
165 writeln('The sorted elements are as follows');
166 FOR i:=1 TO n DO
167 writeln(a[i]);
168 END.
169 170 5.
171 program QSort;
172 {$R-,S-}
173 uses Crt;
174 175 { This program demonstrates the quicksort algorithm, which }
176 { provides an extremely efficient method of sorting arrays in }
177 { memory. The program generates a list of 1000 random numbers }
178 { between 0 and 29999, and then sorts them using the QUICKSORT }
179 { procedure. Finally, the sorted list is output on the screen. }
180 { Note that stack and range checks are turned off (through the }
181 { compiler directive above) to optimize execution speed. }
182 183 const
184 Max = 1000;
185 186 type
187 List = array[1..Max] of Integer;
188 189 var
190 Data: List;
191 I: Integer;
192 193 { QUICKSORT sorts elements in the array A with indices between }
194 { LO and HI (both inclusive). Note that the QUICKSORT proce- }
195 { dure provides only an "interface" to the program. The actual }
196 { processing takes place in the SORT procedure, which executes }
197 { itself recursively.
}
198 199 procedure QuickSort(var A: List; Lo, Hi: Integer);
200 201 procedure Sort(l, r: Integer);
202 var
203 i, j, x, y: integer;
204 begin
205 i := l; j := r; x := a[(l+r) DIV 2];
206 repeat
207 while a[i] < x do i := i + 1;
208 while x < a[j] do j := j - 1;
209 if i <= j then
210 begin
211 y := a[i]; a[i] := a[j]; a[j] := y;
212 i := i + 1; j := j - 1;
213 end;
214 until i > j;
215 if l < j then Sort(l, j);
216 if i < r then Sort(i, r);
217 end;
218 219 begin {QuickSort};
220 Sort(Lo,Hi);
221 end;
222 223 begin {QSort}
224 Write('Now generating 1000 random numbers...');
225 Randomize;
226 for i := 1 to Max do Data[i] := Random(30000);
227 Writeln;
228 Write('Now sorting random numbers...');
229 QuickSort(Data, 1, Max);
230 Writeln;
231 for i := 1 to 1000 do Write(Data[i]:8);
232 end.
233 234 6.
235 PROGRAM backwards;
236 237 {This program reads a line of text and writes it out in a reverse order}
238 239 USES crt;
240 241 PROCEDURE flipit;
242 243 {Reads single characters recursively and then writes them out}
244 245 VAR c:char;
246 247 {The procedure flipit is the key thing in this program.First it reads
248 a single character and then makes sure (checks) that it is not an end
249 of line,and if this condition satisfies then it once again goes to the
250 procedure flipit and reads the next single character.This process continues
251 until the end of line is detected,after which the computer writes out the
252 output in the order of the most recent character written first (i.e., the
253 character where the end of line was encountered) and the first character
254 written last.Hence we get a line of text written in a reverse order in the
255 output.}
256 257 BEGIN
258 read(c);
259 IF NOT eoln THEN flipit;
260 write(c)
261 END;
262 263 BEGIN
264 clrscr;
265 writeln('Enter a line of text');
266 writeln;
267 flipit;
268 END.
269 270 7.
271 PROGRAM factorial;
272 273 {Program to calculate the factorial of a number using recursive function}
274 275 VAR x:integer;
276 277 FUNCTION fact(n:integer):integer;
278 279 BEGIN
280 IF n<=1 THEN fact:=1
281 ELSE fact:=n*fact(n-1);
282 END;
283 284 BEGIN
285 writeln('Enter any integer');
286 read(x);
287 writeln('The factorial is ',fact(x))
288 END.
289 290 8.
291 PROGRAM fibonacci_series;
292 293 (*Program to find the fibonacci series upto a given number*)
294 295 VAR a,b,j,n:integer;
296 297 PROCEDURE fib(a,b,j:integer);
298 299 BEGIN
300 IF j>0 THEN
301 BEGIN
302 WHILE j<>a DO
303 BEGIN
304 writeln(a:1,' ');
305 fib(b,a+b,j-1);
306 END;
307 END;
308 END;
309 BEGIN
310 writeln('FIBONACCI SERIES');
311 writeln;
312 writeln('Enter any number');
313 readln(n);
314 writeln;
315 IF n<=0 THEN writeln('Invalid Entry,please try again!')
316 ELSE
317 fib(0,1,n);
318 END.
319 320 9.
321 PROGRAM gcd_recursion;
322 323 {Program to calculate the GCD of 2 nos using recursive function}
324 325 USES crt;
326 327 VAR a,b:integer;
328 329 FUNCTION gcd(p,q:integer):integer;
330 331 BEGIN
332 IF p<q THEN
333 BEGIN
334 gcd:=gcd(q,p);
335 END
336 ELSE
337 IF q=0 THEN
338 BEGIN
339 gcd:=p;
340 END
341 ELSE
342 gcd:=gcd(q,p MOD q);
343 END;
344 345 BEGIN
346 clrscr;
347 writeln('Enter any two elements');
348 readln(a,b);
349 gcd(a,b);
350 writeln('The gcd of two numbers is ',gcd(a,b));
351 END.
352 353 10.
354 PROGRAM fact1;
355 356 {Factorial of a number}
357 358 USES crt;
359 360 VAR n:integer;
361 362 FUNCTION fact(i:integer):integer;
363 364 VAR prod1:integer;
365 366 BEGIN
367 BEGIN
368 prod1:=1;
369 REPEAT
370 prod1:=prod1*i;
371 i:=i-1;
372 UNTIL i = 1;
373 END;
374 writeln('The factorial of ',n,' is ',prod1)
375 END;
376 377 BEGIN
378 clrscr;
379 writeln('Enter any number');
380 read(n);
381 fact(n);
382 383 END.
384 385 11.
386 PROGRAM gcd;
387 388 (*program to find the gcd of two numbers*)
389 390 USES crt;
391 392 VAR a,b,c,d,i:integer;
393 394 BEGIN
395 clrscr;
396 writeln('Enter any two integers');
397 readln(a,b);
398 IF a<=b THEN c:=a;
399 c:=b;
400 FOR i:=1 TO c DO
401 402 BEGIN
403 404 IF (a MOD i=0)AND(b MOD i=0) THEN
405 d:=i;
406 END;
407 408 writeln('The GCD of two numbers is ',d);
409 END.
410 411 12.
412 PROGRAM file_create;
413 414 TYPE student=RECORD
415 name:string[20];
416 rollno,marks:integer;
417 END;
418 VAR n,i:integer;
419 data:student;
420 file1:FILE OF student;
421 422 BEGIN
423 writeln('Program to create a sequential file of student data');
424 assign(file1,'file1.dat');
425 rewrite(file1);
426 REPEAT
427 write('Enter the number of students:');
428 readln(n);
429 UNTIL n>0;
430 FOR i:=1 TO n DO
431 WITH data DO
432 BEGIN
433 write('NAME : ');
434 readln(name);
435 write('ROLL NO : ');
436 readln(rollno);
437 write('MARKS : ');
438 readln(marks);
439 write(file1,data);
440 END;
441 reset(file1);
442 writeln('The data file contains the following information: ');
443 writeln('NAME':15,'':12,'ROLL NO.':8,'MARKS':10);
444 WHILE (NOT eof(file1)) DO
445 BEGIN
446 read(file1,data);
447 WITH data DO
448 writeln(name:20,rollno:12,marks:12);
449 END;
450 END.
451 452 13.
453 PROGRAM function_procedure_parameter;
454 455 VAR x:real;
456 457 FUNCTION f1(a:real):real;
458 459 BEGIN
460 f1:=sqr(a);
461 END;
462 463 PROCEDURE p(x:real);
464 {A function is declared within a Procedure}
465 FUNCTION f(x:real):real;
466 467 VAR y:real;
468 469 BEGIN
470 y:=f(x);
471 writeln('The output is...');
472 writeln(y);
473 END;
474 475 BEGIN
{main program statements}
476 x:=9;
477 p(x,f1);
478 END.
479 480 14.
481 PROGRAM towers_of_hanoi;
482 483 {This program solves a well known game using recursive procedures calls
484 and user defined data}
485 486 TYPE poles=(left,centre,right);
487 disks=0..maxint;
488 489 VAR n:disks;
490 491 PROCEDURE transfer(n:disks;origin,destination,other:poles);
492 493 {Note that origin,destination and other are formal parameters for the
494 procedure transfer,they are supposed to be replaced by the actual parameter
495 left,centre,right in the procedure reference in the main program}
496 497 {Transfer n disks from the origin to the destination}
498 499 PROCEDURE diskmove(origin,destination:poles);
500 501 {Move a single disk from the origin to the destination}
502 BEGIN
503 write('Move ');
504 CASE origin OF
505 left :IF destination=centre
506 THEN writeln('left to centre')
507 ELSE writeln('left to right');
508 centre :IF destination=left
509 THEN writeln('centre to left')
510 ELSE writeln('centre to right');
511 right :IF destination=centre
512 THEN writeln('right to centre')
513 ELSE writeln('right to left');
514 END;
{End case}
515 END;
{End diskmove}
516 BEGIN {Transfer}
517 IF n>0 THEN BEGIN
518 transfer(n-1,origin,other,destination);
519 diskmove(origin,destination);
520 transfer(n-1,other,destination,origin);
521 END;
522 END;
{End Transfer}
523 524 BEGIN
{Main action block}
525 write('Enter the number of disks->');
526 readln(n);
527 writeln;
528 transfer(n,left,right,centre); {Transfer n disk from left to right}
529 END.
530 531 15.
532 PROGRAM matrix1;
533 534 {Program that declares a integer matrix and initializes it to 1's
535 on the diagonal and 0's elsewhere}
536 537 VAR arr:ARRAY[1..100,1..100] OF integer;
538 i,j,index,m,n:integer;
539 540 BEGIN
541 writeln;
542 writeln('Enter the number of rows and columns');
543 readln(m,n);
544 FOR i:=1 TO m DO
545 BEGIN
546 FOR j:=1 TO n DO
547 BEGIN
548 IF i=j THEN
549 arr[i,j]:=1
550 ELSE
551 arr[i,j]:=0;
552 IF ((j-1) MOD n)=0 THEN writeln;
553 write(' ',arr[i,j],' ');
554 END;
555 END;
556 557 END.
558 559 16.
560 PROGRAM power;
561 562 {Program that will allow an integer type number to be raised to an
563 integer type power}
564 565 USES crt;
566 567 VAR x,y:integer;
568 569 PROCEDURE pow(a,b:integer);
570 571 {Procedure to calculate x^y}
572 573 VAR count,expo:integer;
574 575 BEGIN
576 count:=1;
577 expo:=1;
578 FOR count:=1 TO b DO
579 BEGIN
580 expo:=expo*a;
581 END;
582 writeln('The answer is ',expo);
583 END;
584 585 BEGIN
586 clrscr;
587 writeln('Program to calculate "x to the power of y" ');
588 writeln;
589 writeln('Enter any two numbers x & y');
590 readln(x,y);
591 pow(x,y);
592 END.
593 594 17.
595 PROGRAM prime_check;
596 597 VAR n,i,s:integer;
598 flag:boolean;
599 600 BEGIN
601 writeln('Enter any number');
602 readln(n);
603 flag:=false;
604 s:=trunc(sqrt(n*1.0));
605 FOR i:=2 TO s DO
606 IF ((n MOD i)=0) THEN
607 flag:=false
608 ELSE
609 flag:=true;
610 IF flag=true THEN writeln('It is a Prime number')
611 ELSE
612 writeln('Not a prime number');
613 END.
614 615 18.
616 PROGRAM prime_generation;
617 618 VAR i,j,k,n:integer;
619 620 BEGIN
621 writeln('Enter any number');
622 readln(n);
623 FOR i:=2 TO n DO
624 BEGIN
625 k:=0;
626 FOR j:=1 TO n DO
627 IF i MOD j =0 THEN k:=k+1;
628 IF k<=2 THEN writeln(i);
629 END;
630 END.
631 632 19.
633 PROGRAM graph;
634 635 CONST scale=30;
636 centre=40;
637 increment=15;
638 PI=3.14159;
639 640 VAR i,angle:integer;
641 642 FUNCTION sinetrace:integer;
643 {Evaluate position on the screen for plotting sine wave}
644 BEGIN
645 sinetrace:=trunc(centre-scale*sin(angle*PI/100));
646 END;
647 648 BEGIN
649 angle:=0;
650 WHILE angle>=0 DO
651 BEGIN
652 FOR i:=1 TO sinetrace DO
653 write(' ');
654 writeln('sine');
655 angle:=angle+increment;
656 END;
657 END.
658 659 20.
660 PROGRAM vowels;
661 662 USES crt;
663 664 {Program that counts the number of vowels in a sentence}
665 666 CONST space=' ';
667 maxchar=80;
668 669 TYPE vowel=(a,e,i,o,u);
670 671 VAR buffer:ARRAY[1..maxchar] of char;
672 vowelcount:ARRAY[vowel] of integer;
673 674 PROCEDURE initialize;
675 676 VAR ch:vowel;
677 678 BEGIN
679 FOR ch:=a TO u DO
680 BEGIN
681 vowelcount[ch]:=0;
682 END;
683 END;
684 685 PROCEDURE textinput;
686 687 VAR index:integer;
688 689 BEGIN
690 writeln('Input a sentence');
691 FOR index:=1 TO maxchar DO
692 IF eoln THEN buffer[index]:=space
693 ELSE read(buffer[index]);
694 readln;
695 END;
696 697 PROCEDURE analysis;
698 699 VAR index:integer;
700 ch:vowel;
701 702 BEGIN
703 index:=1;
704 WHILE index<>maxchar+1 DO
705 BEGIN
706 IF buffer[index] IN ['a','e','i','o','u'] THEN
707 BEGIN
708 CASE buffer[index] OF
709 'a':ch:=a;
710 'e':ch:=e;
711 'i':ch:=i;
712 'o':ch:=o;
713 'u':ch:=u;
714 END;
715 vowelcount[ch]:=vowelcount[ch]+1;
716 END;
717 index:=index+1;
718 END;
719 END;
720 721 PROCEDURE vowelout;
722 723 VAR ch:vowel;
724 725 BEGIN
726 clrscr;
727 writeln;
728 writeln(' a e i o u');
729 FOR ch:=a TO u DO
730 write(vowelcount[ch]:4);
731 writeln;
732 END;
733 734 BEGIN
735 initialize;
736 textinput;
737 analysis;
738 vowelout;
739 END.
740 741 21.
742 PROGRAM no_of_words;
743 744 {Program to count the number of words in a sentence}
745 746 USES crt;
747 748 CONST space=' ';
749 750 VAR nextchar:char;
751 words:integer;
752 753 BEGIN
754 words:=1;
755 clrscr;
756 writeln('Input sentence-terminate with return');
757 WHILE not eoln DO
758 BEGIN
759 read(nextchar); {If readln was used instead of
760 read then the program would not work}
761 IF nextchar=space THEN
762 words:=words+1;
763 END;
764 writeln('Number of words in the sentence => ',words);
765 END.
766 767 22.
768 PROGRAM makelist;
769 770 TYPE link=^personal;
771 personal=RECORD
772 name:PACKED ARRAY[1..30] OF char;
773 next:link
774 END;
775 776 VAR item,pointer:link;
777 778 PROCEDURE readname(VAR newname:link);
779 {This procedure reads a name into the computer}
780 781 VAR count:0..40;
782 783 BEGIN
784 FOR count:=1 TO 40 DO
785 newname^.name[count]:=' ';
786 write('New name: ');
787 count:=0;
788 WHILE NOT eoln DO
789 BEGIN
790 count:=count+1;
791 read(newname^.name[count])
792 END;
793 readln
794 END;
795 796 BEGIN
797 BEGIN
798 new(item);
799 readname(item);
800 item^.next:=NIL;
801 pointer:=item;
802 WHILE NOT ((item^.name[1] IN ['E','e'])
803 AND (item^.name[2] IN ['N','n'])
804 AND (item^.name[3] IN ['D','d'])) DO
805 BEGIN
806 new(item);
807 readname(item);
808 item^.next:=pointer;
809 pointer:=item;
810 END;
811 pointer:=item^.next
812 END;
813 BEGIN
814 writeln;
815 WHILE pointer<>NIL DO
816 BEGIN
817 item:=pointer;
818 writeln(item^.name);
819 pointer:=item^.next
820 END;
821 END;
822 END.
823 824 825 826 
