diff --git a/assembly/A DOS 2.0 filter for word processing document files.asm b/assembly/A DOS 2.0 filter for word processing document files.asm new file mode 100644 index 0000000..e8b2941 --- /dev/null +++ b/assembly/A DOS 2.0 filter for word processing document files.asm @@ -0,0 +1,136 @@ +; +; This program reads text from the standard input device and writes +; filtered and transformed text to the standard output device. +; +; 1. High bit of all characters is stripped off. +; 2. Tabs are expanded. +; 3. Removes all control codes except for line +; feeds, carriage returns, and form feeds. +; 4. Appends an end-of-file mark to the text, if +; none was present in the input stream. +; +; Can be used to make a WordStar file acceptable for +; other screen or line editors, and vice versa. +; +; +cr equ 0dh ; ASCII carriage return +lf equ 0ah ; ASCII line feed +ff equ 0ch ; ASCII form feed +eof equ 01ah ; End-of-file marker +tab equ 09h ; ASCII tab code + +command equ 80h ; buffer for command tail + +; DOS 2.0 Pre-Defined Handles + +stdin equ 0000 ; standard input file +stdout equ 0001 ; standard output file +stderr equ 0002 ; standard error file +stdaux equ 0003 ; standard auxilliary file +stdprn equ 0004 ; standard printer file + +cseg segment para public 'CODE' + + assume cs:cseg,ds:cseg + + org 100H ; start .COM at 100H + +clean proc far ; entry point from PC-DOS. + push ds ; push a long return back + xor ax,ax ; to DOS onto the stack. + push ax + +clean3: call get_char ; get a character from input. + and al,7fh ; turn off the high bit. + cmp al,20h ; is it a control char? + jae clean4 ; no. write it to output. + cmp al,eof ; is it end of file? + je clean6 ; yes, go write EOF mark and exit. + cmp al,tab ; is it a tab? + je clean5 ; yes, go expand it to spaces. + cmp al,cr ; is it a carriage return? + je clean35 ; yes, go process it. + cmp al,lf ; is it a line feed? + je clean35 ; yes, go process it. + cmp al,ff ; is it a form feed? + jne clean3 ; no. discard it. +clean35: + mov column,0 ; if it's a legit ctrl char, + jmp clean45 ; we should be back at column 0. + +clean4: inc column ; if it's a non-ctrl char, +clean45: ; col = col + 1. + call put_char ; write the char to output. + jnc clean3 ; if OK, go back for another char. + + mov bx,stderr ; not OK. Set up to show error. + mov dx,offset err_msg + mov cx,err_msg_len ; error = Disk full. + mov ah,40h ; write the error message + int 21h ; to the standard error device. (CON:) + ret ; back to DOS. + +clean5: mov ax,column ; tab code detected, must expand + cwd ; expand tabs to spaces. + mov cx,8 ; divide the current column counter + idiv cx ; by eight... + sub cx,dx ; eight minus the remainder is the + add column,cx ; number of spaces to send out to +clean55: ; move to the next tab position. + push cx + mov al,20h + call put_char ; send an ASCII blank + pop cx + loop clean55 + jmp clean3 + +clean6: call put_char ; write out the EOF mark, + ret ; and return to DOS. + +clean endp + + +get_char proc near + mov bx,stdin ; get chars from std. input + mov cx,1 ; # of chars to get = 1 + mov dx,offset input_buffer ; location = input_buffer + mov ah,3fh + int 21h ; do the function call + or ax,ax ; test # of chars returned + jz get_char1 ; if none, return EOF + mov al,input_buffer ; else, return the char in AL + ret +get_char1: + mov al,eof ; no chars read, return + ret ; an End-of-File (EOF) mark. +get_char endp + +put_char proc near + mov output_buffer,al ; put char to write in buffer. + mov bx,stdout ; write to std. output + mov cx,1 ; # of chars = 1 + mov dx,offset output_buffer ; location = output_buffer + mov ah,40h + int 21h ; do the function call + cmp ax,1 ; check to see it was really done. + jne put_char1 + clc ; really done. return carry = 0 + ret ; as success signal. +put_char1: + stc ; not really done. return carry = 1 + ret ; as error signal (device is full). +put_char endp + +input_buffer db 0 +output_buffer db 0 + +column dw 0 + +err_msg db cr,lf + db 'clean: Disk is full.' + db cr,lf +err_msg_len equ (this byte)-(offset err_msg) + +cseg ends + + end clean \ No newline at end of file diff --git a/assembly/A listing into pages and give new subtitles.asm b/assembly/A listing into pages and give new subtitles.asm new file mode 100644 index 0000000..fb620d9 --- /dev/null +++ b/assembly/A listing into pages and give new subtitles.asm @@ -0,0 +1,310 @@ +; +; Macro file for MSDOS. +; + +SUBTTL BREAK a listing into pages and give new subtitles +PAGE +BREAK MACRO subtitle + SUBTTL subtitle + PAGE +ENDM + +BREAK + +; +; declare a variable external and allocate a size +; +I_NEED MACRO sym,len + CODE ENDS + DATA SEGMENT BYTE PUBLIC 'DATA' + + IFIDN , + EXTRN &sym:WORD + ELSE + IFIDN , + EXTRN &sym:DWORD + ELSE + EXTRN &sym:BYTE + ENDIF + ENDIF + + DATA ENDS + CODE SEGMENT BYTE PUBLIC 'CODE' +ENDM + +; +; call a procedure that may be external. The call will be short. +; +invoke MACRO name +&.xcref + add_ext name,near +&.cref + CALL name +ENDM + +PAGE +; +; jump to a label that may be external. The call will be near. +; +transfer MACRO name +&.xcref + add_ext name,near +&.cref + JUMP name +ENDM + +; +; get a short address in a word +; +short_addr MACRO name + IFDIF , +&.xcref + add_ext name,near +&.cref + DW OFFSET DOSGROUP:name + ELSE + DW ? + ENDIF +ENDM + +; +; get a long address in a dword +; +long_addr MACRO name +&.xcref + add_ext name,far +&.cref + DD name +ENDM + +; +; declare a PROC near or far but PUBLIC nonetheless +; +procedure MACRO name,distance + PUBLIC name +name PROC distance +ENDM + +PAGE +; +; define a data item to be public and of an appropriate size/type +; +I_AM MACRO name,size + PUBLIC name + + IFIDN , + name DW ? + ELSE + IFIDN , + name DD ? + ELSE + IFIDN , + name DB ? + ELSE + name DB size DUP (?) + ENDIF + ENDIF + ENDIF +ENDM + +PAGE +; +; play games with a possible external. Create a new +; macro for the symbol and text, and string it together +; with a central invoker +; + +.xcref +.xcref ?i +.xcref def_mac +.xcref ?z0 +.xcref add_ext +.cref + +IF1 + ?i=0 +ENDIF + +?z0 macro +endm + +; +; add an external declaration to s with type t if it is not defined +; +add_ext macro s,t +&.xcref +&.xcref ?&s +&.cref + IFNDEF ?&s + ?i = ?i + 1 + def_mac ?z&%?i,?z&%(?i-1),s,t + ENDIF +endm + +; +; define a macro called that possibly externals s:t and then calls macro n +; +def_mac macro m,n,s,t +&.xcref +&.xcref ?&s +&.xcref m +&.cref +m macro + ifndef s + extrn s:&t + endif + purge m + purge ?&s + n +endm +?&s macro +&endm +endm + +; +; call the macro chain +; +do_ext macro +&.xcref + expand_mac ?z%?i +&.cref +endm + +PAGE +expand_mac macro m + m +endm + +; +; define an entry in a procedure +; +entry macro name + PUBLIC name +name: +endm + +BREAK + +error macro code + local a +.xcref + MOV AL,code + transfer SYS_RET_ERR +.cref +ENDM + +BREAK +; +; given a label either 2 byte jump to another label _J +; if it is near enough or 3 byte jump to +; + +jump macro lbl + local a +.xcref + a: + ifndef lbl&_J ; is this the first invocation + JMP lbl + ELSE + IF lbl&_J GE $ + JMP lbl + ELSE + IF ($-lbl&_J) GT 126 ; is the jump too far away? + JMP lbl + ELSE ; do the short one... + JMP lbl&_J + ENDIF + ENDIF + ENDIF +endm + +BREAK + +return macro + local a +.xcref +a: + RET +ret_l = a +endm + +BREAK + +makelab macro l,cc,ncc + j&ncc a ; j a: + return ; return + a: ; a: + ret_&cc = ret_l ; define ret_ to be ret_l +endm + +condret macro cc,ncc + local a,b + ifdef ret_l ; if ret_l is defined + if (($ - ret_l) le 126) and ($ gt ret_l) + ; if ret_l is near enough then + a: j&cc ret_l ; a: j to ret_l + ret_&cc = a ; define ret_ to be a: + else + makelab a,cc,ncc + endif + else + ifdef ret_&cc ; if ret_ defined + if (($ - ret_&cc) le 126) and ($ gt ret_&cc) + ; if ret_ is near enough + a: j&cc ret_&cc ; a: j to ret_ + ret_&cc = a ; define ret_ to be a: + else + makelab a,cc,ncc + endif + else + makelab a,cc,ncc + endif + endif +endm +;condret macro cc,ncc +; local a,b +; ifdef ret_l ; if ret_l is defined +; if (($ - ret_l) le 126) and ($ gt ret_l) +; ; if ret_l is near enough then +; a: j&cc ret_l ; a: j to ret_l +; ret_&cc = a ; define ret_ to be a: +; exitm +; endif +; endif +; ifdef ret_&cc ; if ret_ defined +; if (($ - ret_&cc) le 126) and ($ gt ret_&cc) +; ; if ret_ is near enough +; a: j&cc ret_&cc ; a: j to ret_ +; ret_&cc = a ; define ret_ to be a: +; exitm +; endif +; endif +; j&ncc a ; j a: +; return ; return +; a: ; a: +; ret_&cc = ret_l ; define ret_ to be ret_l +;endm + +BREAK + +retz macro + condret z,nz +endm + +BREAK + +retnz macro + condret nz,z +endm + +BREAK + +retc macro + condret c,nc +endm + +BREAK + +retnc macro + condret nc,c +endm diff --git a/assembly/A small program that calculates and prints terms of the Fibonacci series.asm b/assembly/A small program that calculates and prints terms of the Fibonacci series.asm new file mode 100644 index 0000000..7d0cccc --- /dev/null +++ b/assembly/A small program that calculates and prints terms of the Fibonacci series.asm @@ -0,0 +1,261 @@ +; fibo.asm +; assemble using nasm: +; nasm -o fibo.com -f bin fibo.asm +; +;**************************************************************************** +; Alterable Constant +;**************************************************************************** +; You can adjust this upward but the upper limit is around 150000 terms. +; the limitation is due to the fact that we can only address 64K of memory +; in a DOS com file, and the program is about 211 bytes long and the +; address space starts at 100h. So that leaves roughly 65000 bytes to +; be shared by the two terms (num1 and num2 at the end of this file). Since +; they're of equal size, that's about 32500 bytes each, and the 150000th +; term of the Fibonacci sequence is 31349 digits long. +; + maxTerms equ 15000 ; number of terms of the series to calculate + +;**************************************************************************** +; Number digits to use. This is based on a little bit of tricky math. +; One way to calculate F(n) (i.e. the nth term of the Fibonacci seeries) +; is to use the equation int(phi^n/sqrt(5)) where ^ means exponentiation +; and phi = (1 + sqrt(5))/2, the "golden number" which is a constant about +; equal to 1.618. To get the number of decimal digits, we just take the +; base ten log of this number. We can very easily see how to get the +; base phi log of F(n) -- it's just n*lp(phi)+lp(sqrt(5)), where lp means +; a base phi log. To get the base ten log of this we just divide by the +; base ten log of phi. If we work through all that math, we get: +; +; digits = terms * log(phi) + log(sqrt(5))/log(phi) +; +; the constants below are slightly high to assure that we always have +; enough room. As mentioned above the 150000th term has 31349 digits, +; but this formula gives 31351. Not too much waste there, but I'd be +; a little concerned about the stack! +; + digits equ (maxTerms*209+1673)/1000 + +; this is just the number of digits for the term counter + cntDigits equ 6 ; number of digits for counter + + org 100h ; this is a DOS com file +;**************************************************************************** +;**************************************************************************** +main: +; initializes the two numbers and the counter. Note that this assumes +; that the counter and num1 and num2 areas are contiguous! +; + mov ax,'00' ; initialize to all ASCII zeroes + mov di,counter ; including the counter + mov cx,digits+cntDigits/2 ; two bytes at a time + cld ; initialize from low to high memory + rep stosw ; write the data + inc ax ; make sure ASCII zero is in al + mov [num1 + digits - 1],al ; last digit is one + mov [num2 + digits - 1],al ; + mov [counter + cntDigits - 1],al + + jmp .bottom ; done with initialization, so begin + +.top + ; add num1 to num2 + mov di,num1+digits-1 + mov si,num2+digits-1 + mov cx,digits ; + call AddNumbers ; num2 += num1 + mov bp,num2 ; + call PrintLine ; + dec dword [term] ; decrement loop counter + jz .done ; + + ; add num2 to num1 + mov di,num2+digits-1 + mov si,num1+digits-1 + mov cx,digits ; + call AddNumbers ; num1 += num2 +.bottom + mov bp,num1 ; + call PrintLine ; + dec dword [term] ; decrement loop counter + jnz .top ; +.done + call CRLF ; finish off with CRLF + mov ax,4c00h ; terminate + int 21h ; + + +;**************************************************************************** +; +; PrintLine +; prints a single line of output containing one term of the +; Fibonacci sequence. The first few lines look like this: +; +; Fibonacci(1): 1 +; Fibonacci(2): 1 +; Fibonacci(3): 2 +; Fibonacci(4): 3 +; +; INPUT: ds:bp ==> number string, cx = max string length +; OUTPUT: CF set on error, AX = error code if carry set +; DESTROYED: ax, bx, cx, dx, di +; +;**************************************************************************** +PrintLine: + mov dx,eol ; print combined CRLF and msg1 + mov cx,msg1len+eollen ; + call PrintString ; + + mov di,counter ; print counter + mov cx,cntDigits ; + call PrintNumericString + + call IncrementCount ; also increment the counter + + mov dx,msg2 ; print msg2 + mov cx,msg2len ; + call PrintString ; + + mov di,bp ; recall address of number + mov cx,digits ; + ; deliberately fall through to PrintNumericString + +;**************************************************************************** +; +; PrintNumericString +; prints the numeric string at DS:DI, suppressing leading zeroes +; max length is CX +; +; INPUT: ds:di ==> number string, cx = max string length +; OUTPUT: CF set on error, AX = error code if carry set +; DESTROYED: ax, bx, cx, dx, di +; +;**************************************************************************** +PrintNumericString: + ; first scan for the first non-zero byte + mov al,'0' ; look for ASCII zero + cld ; scan from MSD to LSD + repe scasb ; + mov dx,di ; points to one byte after + dec dx ; back up one character + inc cx ; + ; deliberately fall through to PrintString + +;**************************************************************************** +; +; PrintString +; prints the string at DS:DX with length CX to stdout +; +; INPUT: ds:dx ==> string, cx = string length +; OUTPUT: CF set on error, AX = error code if carry set +; DESTROYED: ax, bx +; +;**************************************************************************** +PrintString: + mov bx, 1 ; write to stdout + mov ah, 040h ; write to file handle + int 21h ; ignore return value + ret ; + +;**************************************************************************** +; +; AddNumbers +; add number 2 at ds:si to number 1 at es:di of width cx +; +; +; INPUT: es:di ==> number1, ds:si ==> number2, cx= max width +; OUTPUT: CF set on overflow +; DESTROYED: ax, si, di +; +;**************************************************************************** +AddNumbers: + std ; go from LSB to MSB + clc ; + pushf ; save carry flag +.top + mov ax,0f0fh ; convert from ASCII BCD to BCD + and al,[si] ; get next digit of number2 in al + and ah,[di] ; get next digit of number1 in ah + popf ; recall carry flag + adc al,ah ; add these digits + aaa ; convert to BCD + pushf ; + add al,'0' ; convert back to ASCII BCD digit + stosb ; save it and increment both counters + dec si ; + loop .top ; keep going until we've got them all + popf ; recall carry flag + ret ; + +;**************************************************************************** +; +; IncrementCount +; increments a multidigit term counter by one +; +; INPUT: none +; OUTPUT: CF set on overflow +; DESTROYED: ax, cx, di +; +;**************************************************************************** +IncrementCount: + mov cx,cntDigits ; + mov di,counter+cntDigits-1 + std ; go from LSB to MSB + stc ; this is our increment + pushf ; save carry flag +.top + mov ax,000fh ; convert from ASCII BCD to BCD + and al,[di] ; get next digit of counter in al + popf ; recall carry flag + adc al,ah ; add these digits + aaa ; convert to BCD + pushf ; + add al,'0' ; convert back to ASCII BCD digit + stosb ; save and increment counter + loop .top ; + popf ; recall carry flag + ret ; + +;**************************************************************************** +; +; CRLF +; prints carriage return, line feed pair to stdout +; +; INPUT: none +; OUTPUT: CF set on error, AX = error code if carry set +; DESTROYED: ax, bx, cx, dx +; +;**************************************************************************** +CRLF: mov dx,eol ; + mov cx,eollen ; + jmp PrintString ; + +;**************************************************************************** +; static data +;**************************************************************************** +eol db 13,10 ; DOS-style end of line +eollen equ $ - eol + +msg1 db 'Fibonacci(' ; +msg1len equ $ - msg1 + +msg2 db '): ' ; +msg2len equ $ - msg2 +;**************************************************************************** +; initialized data +;**************************************************************************** +term dd maxTerms ; +;**************************************************************************** +; unallocated data +; +; A better way to do this would be to actually ask for a memory +; allocation and use that memory space, but this is a DOS COM file +; and so we are given the entire 64K of space. Technically, this +; could fail since we *might* be running on a machine which doesn't +; have 64K free. If you're running on such a memory poor machine, +; my advice would be to not run this program. +; +;**************************************************************************** +; static data +counter: ; +num1 equ counter+cntDigits ; +num2 equ num1+digits ; \ No newline at end of file diff --git a/assembly/A utility to report free space on the default or selected disk drive.asm b/assembly/A utility to report free space on the default or selected disk drive.asm new file mode 100644 index 0000000..78e8cec --- /dev/null +++ b/assembly/A utility to report free space on the default or selected disk drive.asm @@ -0,0 +1,207 @@ +name free + page 60,132 + title 'FREE --- Report free space on disk' + +; FREE --- a utility to report free space on +; the default or selected disk drive. +; +; Requires PC-DOS or MS-DOS 2.0. +; +; Used in the form: +; A> FREE [unit:] +; (item in square brackets is optional) +; + +cr equ 0dh ;ASCII carriage return +lf equ 0ah ;ASCII line feed +blank equ 20h ;ASCII space code +eom equ '$' ;end of string marker + + +; Here we define a dummy segment containing labels +; for the default file control block and the command tail buffer, +; so that the main program can access those locations. +; +psp segment para public 'PSP' + + org 05ch +fcb label byte ;default file control block + + org 080h +command label byte ;default command buffer + +psp ends + + +cseg segment para public 'CODE' + + assume cs:cseg,ds:psp,es:data,ss:stack + + +get_drive proc near ;get drive selection, if any, + ;otherwise obtain the identity + ;of the current disk drive. + ;Return drive (1=A, 2=B, etc) in AL. + ; + mov al,fcb ;Pick up the drive code, parsed + ;by DOS into the default file + ;control block. + or al,al ;Is it the default? + jnz get_drive1 ;no, use it + mov ah,19h ;Yes, get the actual current + int 21h ;drive from PC-DOS. + inc al ;Increment to match FCB code. +get_drive1: ;Return drive code in AL. + ret +get_drive endp + + +free proc far ;entry point from PC-DOS + + push ds ;save DS:0000 for final + xor ax,ax ;return to PC-DOS + push ax + mov ax,data ;make our data segment + mov es,ax ;addressable via ES register. + mov ah,30h ;check version of PC-DOS. + int 21h + cmp al,2 + jae free1 ;proceed, DOS 2.0 or greater. + mov dx,offset msg2 ;DOS 1.x --- print error message + mov ax,es ;and exit. First fix up DS register + mov ds,ax ;so error message is addressable. + jmp free4 + +free1: call get_drive ;get drive selection into DL. + push es ;copy ES to DS for remainder + pop ds ;of the program... + assume ds:data ;and tell assembler about it. + mov dl,al + add al,'A'-1 ;form drive letter from drive code, + mov outputb,al ;and put it into the output string. + mov ah,36h ;now call DOS to get free disk space. + int 21h + cmp ax,-1 ;was drive invalid? + je free3 ;yes,go print error message + ;drive was ok, so now registers are... + ;AX=number of sectors per cluster + ;BX=available clusters, + ;CX=number of bytes per sector, + ;DX=total clusters per drive. + ;calculate free space: + mul cx ;sectors per cluster * bytes per sector + ;(we assume this won't overflow into DX) + mul bx ;then * available clusters + + ;DX:AX now contains free space in bytes. + ;SI = last byte address for converted string. + mov si,offset (outputa+9) + mov cx,10 ;CX = 10, radix for conversion + call bin_to_asc ;convert free space value to ASCII, + mov dx,offset output + jmp free4 ;and print it out. + +free3: mov dx,offset msg1 ;illegal drive, print error + +free4: mov ah,9 ;print the string whose address + int 21h ;is in DX. + ret ;then return to DOS. + +free endp + + +; Convert 32 bit binary value to ASCII string. +; +; Call with DX:AX = signed 32 bit value +; CX = radix +; SI = last byte of area to store resulting string +; (make sure enough room is available to store +; the string in the radix you have selected.) +; +; Destroys AX, BX, CX, DX, and SI. +; +bin_to_asc proc near ;convert DX:AX to ASCII. + ;force storage of at least 1 digit. + mov byte ptr [si],'0' + or dx,dx ;test sign of 32 bit value, + pushf ;and save sign on stack. + jns bin1 ;jump if it was positive. + not dx ;it was negative, take 2's complement + not ax ;of the value. + add ax,1 + adc dx,0 +bin1: ;divide the 32 bit value by the radix + ;to extract the next digit for the + ;forming string. + mov bx,ax ;is the value zero yet? + or bx,dx + jz bin3 ;yes, we are done converting. + call divide ;no, divide by radix. + add bl,'0' ;convert the remainder to an ASCII digit. + cmp bl,'9' ;we might be converting to hex ASCII, + jle bin2 ;jump if in range 0-9, + add bl,'A'-'9'-1 ;correct it if in range A-F. +bin2: mov [si],bl ;store this character into string. + dec si ;back up through string, + jmp bin1 ;and do it again. +bin3: ;restore sign flag, + popf ;was original value negative? + jns bin4 ;no, jump + ;yes,store sign into output string. + mov byte ptr [si],'-' +bin4: ret ;back to caller. +bin_to_asc endp + + +; General purpose 32 bit by 16 bit unsigned divide. +; This must be used instead of the plain machine unsigned divide +; for cases where the quotient may overflow 16 bits (for example, +; dividing 100,000 by 2). If called with a zero divisor, this +; routine returns the dividend unchanged and gives no warning. +; +; Call with DX:AX = 32 bit dividend +; CX = divisor +; +; Returns DX:AX = quotient +; BX = remainder +; CX = divisor (unchanged) +; +divide proc near ; Divide DX:AX by CX + jcxz div1 ; exit if divide by zero + push ax ; 0:dividend_upper/divisor + mov ax,dx + xor dx,dx + div cx + mov bx,ax ; BX = quotient1 + pop ax ; remainder1:dividend_lower/divisor + div cx + xchg bx,dx ; DX:AX = quotient1:quotient2 +div1: ret ; BX = remainder2 +divide endp + +cseg ends + + +data segment para public 'DATA' + +output db cr,lf +outputa db 10 dup (blank) + db ' bytes free on drive ' +outputb db 'x:',cr,lf,eom + +msg1 db cr,lf + db 'That disk drive does not exist.' + db cr,lf,eom + +msg2 db cr,lf + db 'Requires DOS version 2 or greater.' + db cr,lf,eom + +data ends + + +stack segment para stack 'STACK' + db 64 dup (?) +stack ends + + end free \ No newline at end of file diff --git a/assembly/Absolute Disk Read.asm b/assembly/Absolute Disk Read.asm new file mode 100644 index 0000000..fcca0ed --- /dev/null +++ b/assembly/Absolute Disk Read.asm @@ -0,0 +1,55 @@ +; +; Synopsis: int getsec(drive,numsec,begsec,buffer) +; unsigned int drive; /* 0=A, 1=B, etc. */ +; unsigned int numsec; /* Number of sectors to read */ +; unsigned int begsec; /* Beginning logical sector */ +; char *buffer; /* Transfer address */ +; +; Function: The number of sectors specified are transferred +; between the given drive and the transfer address. +; LOGICAL SECTOR NUMBERS are obtained by numbering +; each sector sequentially starting from track 0, head 0, +; sector 1 (logical sector 0) and continuing along the +; same head, then to the next head until the last sector +; on the last head of the track is counted. Thus, +; logical sector 1 is track 0, head 0, sector 2, +; logical sector 2 is track 0, head 0, sector 3, & so on. +; +; Returns: NULL if the operation is successful. +; otherwise, error codes are as follows: +; +; hex 80 Attachment failed to respond. +; hex 40 SEEK operation failed. +; hex 20 Controller failure. +; hex 10 Bad CRC on diskette read. +; hex 08 DMA overrun on operation. +; hex 04 Requested sector not found. +; hex 03 Write attempt on write-protected diskette. +; hex 02 Address mark not found. +; hex FF Unspecified (error other than those above). +; +code segment byte public ;segment registers remain intact + assume cs:code ;all other registers will be destroyed + public getsec + +getsec: push bp ;save old frame pointer + mov bp,sp ;get new frame pointer + mov ax,4[bp] ;put drive number into AL + xor ah,ah + mov cx,6[bp] ;number of sectors to fetch + mov dx,8[bp] ;logical record number of 1st sector + mov bx,10[bp] ;pointer to transfer address + int 25h ;BIOS call + jc error ;error has occurred if carry flag = 1 + mov al,00H ;NULL to indicate sucessful completion + jmp done +error: cmp al,00H ;detect unspecified error code 00H + jne done ;...change to 0FFh if found to + mov al,0FFH ;...differentiate it from success code +done: xor ah,ah ;return AL only + popf ;remove flags int 0x25 left on stack + pop bp ;restore original frame pointer + ret ;all done + +code ends + end \ No newline at end of file diff --git a/assembly/Alarm.asm b/assembly/Alarm.asm new file mode 100644 index 0000000..4237b4c --- /dev/null +++ b/assembly/Alarm.asm @@ -0,0 +1,373 @@ +cseg segment para public 'code' +org 100h +alarm proc far + +; Memory-resident program to intercept the timer interrupt and display the +; system time in the upper right-hand corner of the display. +; This program is run as 'ALARM hh:mm x', where hh:mm is the alarm time and +; x is '-' to turn the display off. Any other value of x or no value will +; turn the clock on + +intaddr equ 1ch*4 ; interrupt address +segaddr equ 62h*4 ; segment address of first copy +mfactor equ 17478 ; minute conversion factor * 16 +whozat equ 1234h ; signature +color equ 14h ; color attribute + + assume cs:cseg,ds:cseg,ss:nothing,es:nothing + jmp p150 ; start-up code + +jumpval dd 0 ; address of prior interrupt +signature dw whozat ; program signature +state db 0 ; '-' = off, all else = on +wait dw 18 ; wait time - 1 second or 18 ticks +hour dw 0 ; hour of the day +atime dw 0ffffh ; minutes past midnite for alarm +acount dw 0 ; alarm beep counter - number of seconds (5) +atone db 5 ; alarm tone - may be from 1 to 255 - the + ; higher the number, the lower the frequency +aleng dw 8080h ; alarm length (loop count) may be from 1-FFFF + +dhours dw 0 ; display hours + db ':' +dmins dw 0 ; display minutes + db ':' +dsecs dw 0 ; display seconds + db '-' +ampm db 0 ; 'A' or 'P' for am or pm + db 'm' + +tstack db 16 dup('stack ') ; temporary stack +estack db 0 ; end of stack +holdsp dw 0 ; original sp +holdss dw 0 ; original ss + +p000: ; interrupt code + push ax ; save registers + push ds + pushf + + push cs + pop ds ; make ds=cs + mov ax,wait ; check wait time + dec ax ; zero? + jz p010 ; yes - 1 second has elapsed + mov wait,ax ; not this time + jmp p080 ; return + +p010: cli ; disable interrupts + mov ax,ss ; save stack + mov holdss,ax + mov holdsp,sp + mov ax,ds + mov ss,ax ; point to internal stack + mov sp,offset estack + sti ; allow interrupts + + push bx ; save other registers + push cx + push dx + push es + push si + push di + push bp + + mov ax,18 ; reset wait time + mov wait,ax + + mov al,state ; are we disabled? + cmp al,'-' + jnz p015 ; no + jmp p070 + +p015: mov ah,0 ; read time + int 1ah ; get time of day + mov ax,dx ; low part + mov dx,cx ; high part + mov cl,4 + shl dx,cl ; multiply by 16 + mov bx,ax + mov cl,12 + shr bx,cl ; isolate top 4 bits of ax + add dx,bx ; now in upper + mov cl,4 + shl ax,cl ; multiply by 16 + mov bx,mfactor ; compute minutes + div bx ; minutes in ax, remainder in dx + cmp ax,atime ; time to sound the alarm? + jnz p020 ; no + call p100 ; yes - beep the speaker twice + push ax + mov ax,acount ; get beep count + dec ax ; down by 1 + mov acount,ax ; save beep count + cmp ax,0 ; is it zero? + jnz p018 ; no - keep alarm on + mov ax,0ffffh ; turn off alarm + mov atime,ax +p018: pop ax + +p020: mov dsecs,dx ; save remainder + mov bx,60 ; compute hours + xor dx,dx ; zero it + div bx ; hours in ax, minutes in dx + mov dmins,dx ; save minutes + + cmp ax,0 ; midnight? + jnz p030 ; no + mov ax,12 ; yes + jmp p040a ; set am + +p030: cmp ax,12 ; before noon? + jb p040a ; yes - set am + jz p040p ; noon - set pm + sub ax,12 ; convert the rest +p040p: mov bl,'p' + jmp p040x + +p040a: mov bl,'a' + +p040x: mov ampm,bl + aam ; fix up hour + cmp ax,hour ; top of the hour? + jz p060 ; no + + mov hour,ax + call p120 ; beep the speaker once + +p060: add ax,3030h ; convert hours to ascii + xchg ah,al + mov dhours,ax + + mov ax,dmins ; get minutes + aam + add ax,3030h ; convert to ascii + xchg ah,al + mov dmins,ax + + mov ax,dsecs ; get seconds (remainder) + xor dx,dx + mov bx,60 + mul bx + mov bx,mfactor + div bx ; seconds in ax + aam + add ax,3030h + xchg ah,al + mov dsecs,ax + + xor ax,ax ; check monitor type + mov es,ax + mov ax,es:[410h] ; get config byte + and al,30h ; isolate monitor type + cmp al,30h ; color? + mov ax,0b000h ; assume mono + jz p061 ; its mono + + mov ax,0b800h ; color screen address + +p061: mov dx,es:[463h] ; point to 6845 base port + add dx,6 ; point to status port + + mov es,ax ; point to monitor + mov bh,color ; color in bh + mov si,offset dhours ; point to time + mov di,138 ; row 1, col 69 + cld + mov cx,11 ; loop count + +p062: mov bl,[si] ; get next character + +p063: in al,dx ; get crt status + test al,1 ; is it low? + jnz p063 ; no - wait + cli ; no interrupts + +p064: in al,dx ; get crt status + test al,1 ; is it high? + jz p064 ; no - wait + + mov ax,bx ; move color & character + stosw ; move color & character again + sti ; interrupts back on + inc si ; point to next character + loop p062 ; done? + +p070: pop bp ; restore registers + pop di + pop si + pop es + pop dx + pop cx + pop bx + cli ; no interrupts + mov ax,holdss + mov ss,ax + mov sp,holdsp + sti ; allow interrupts + +p080: popf + pop ds + pop ax + jmp cs:[jumpval] + +p100 proc near ; beep the speaker twice + call p120 + push cx + mov cx,20000 +p105: loop p105 ; wait around + pop cx + call p120 + push cx + mov cx,20000 +p106: loop p106 ; wait around + pop cx + call p120 + ret +p100 endp + +p120 proc near ; beep the speaker once + push ax + push cx + mov al,182 + out 43h,al ; setup for sound + mov al,0 + out 42h,al ; low part + mov al,atone ; get alarm tone + out 42h,al ; high part + in al,61h + push ax ; save port value + or al,3 + out 61h,al ; turn speaker on + mov cx,aleng ; get loop count +p125: loop p125 ; wait around + pop ax ; restore original port value + out 61h,al ; turn speaker off + pop cx + pop ax + ret +p120 endp + +p150: ; start of transient code + mov dx,offset copyr + call p220 ; print copyright + mov ax,0 + mov es,ax ; segment 0 + mov di,segaddr+2 ; this program's prior location + mov ax,es:[di] ; get prior code segment + mov es,ax ; point to prior program segment + mov di,offset signature + mov cx,es:[di] ; is it this program? + cmp cx,whozat + jnz p160 ; no - install it + call p200 ; set state & alarm + int 20h ; terminate + +p160: mov di,segaddr+2 ; point to int 62h + mov ax,0 + mov es,ax ; segment 0 + mov ax,ds ; get current ds + mov es:[di],ax ; set int 62h + mov si,offset jumpval + mov di,intaddr ; point to timer interrupt + mov bx,es:[di] ; get timer ip + mov ax,es:[di+2] ; and cs + mov [si],bx ; save prior ip + mov [si+2],ax ; and cs + mov bx,offset p000 + mov ax,ds + cli ; clear interrupts + mov es:[di],bx ; set new timer interrupt + mov es:[di+2],ax + sti ; set interrupts + push ds + pop es + call p200 ; set state & alarm + mov dx,offset p150 ; last byte of resident portion + inc dx + int 27h ; terminate + +p200 proc near ; set state & alarm + mov si,80h ; point to command line + mov ax,0 + mov di,0ffffh ; init hours + mov bh,0 + mov ch,0 + mov dh,0 ; : counter + mov es:[state],bh ; turn clock on + mov cl,[si] ; get length + jcxz p210 ; it's zero + +p203: inc si ; point to next char + mov bl,[si] ; get it + cmp bl,'-' ; is it a minus? + jnz p204 ; no + mov es:[state],bl ; turn clock off + push dx + mov dx,offset msg3 ; print msg + call p220 + pop dx + jmp p206 + +p204: cmp dh,2 ; seen 2nd colon? + jz p206 ; yes - ignore seconds + cmp bl,':' ; colon? + jnz p205 ; no + inc dh + cmp dh,2 ; second colon? + jz p206 ; yes - ignore seconds + push cx + push dx + mov cx,60 + mul cx ; multiply current ax by 60 + pop dx + pop cx + mov di,ax ; save hours + mov ax,0 + jmp p206 +p205: cmp bl,'0' + jb p206 ; too low + cmp bl,'9' + ja p206 ; too high - can be a problem + sub bl,'0' ; convert it to binary + push cx + push dx + mov cx,10 + mul cx ; multiply current value by 10 + add ax,bx ; and add latest digit + pop dx + pop cx +p206: loop p203 ; done yet? + cmp di,0ffffh ; any time to set? + jz p210 ; no + add ax,di ; add hours + cmp ax,24*60 + jb p209 ; ok + mov dx,offset msg1 ; print error message + call p220 + jmp p210 + +p209: mov es:[atime],ax ; save minutes past midnight + mov ax,5 + mov es:[acount],ax ; set alarm count + mov dx,offset msg2 ; print set msg + call p220 +p210: ret +p200 endp + +p220 proc near ; print message + push ax + mov ah,9 + int 21h + pop ax + ret +p220 endp + +copyr db 'Alarm - Clock',10,13,'$' +msg1 db 'Invalid time - must be from 00:00 to 23:59',10,13,'$' +msg2 db 'Resetting alarm time',10,13,'$' +msg3 db 'Turning clock display off',10,13,'$' + +alarm endp +cseg ends +end alarm diff --git a/assembly/An implementation of SLIP (Serial Link IP), RFC 1055 in assembly language.asm b/assembly/An implementation of SLIP (Serial Link IP), RFC 1055 in assembly language.asm new file mode 100644 index 0000000..4443808 --- /dev/null +++ b/assembly/An implementation of SLIP (Serial Link IP), RFC 1055 in assembly language.asm @@ -0,0 +1,147 @@ +; slip.asm +; +; This is an 8086+ implementation of SLIP (RFC 1055) +; +; It may be assembled using Microsoft's MASM using the command line: +; ml -Fl -c slip.asm +; +; or using Borland's TASM using the command line: +; tasm -la -m2 -jLOCALS slip.asm +; + .model small + .stack 100h + .data +SLIP_END equ 0C0h +SLIP_ESC equ 0DBh +SLIP_ESC_END equ 0DCh +SLIP_ESC_ESC equ 0DDh + +; note that these are both sample macros and are very simple +; In both cases, DX is assumed to already be pointing to the +; appropriate I/O port and a character is always assumed to +; be ready. +SEND_CHAR macro char + IFDIFI , + mov al,char + ENDIF + out dx,al +endm + +RECV_CHAR macro + in al,dx +endm + .code +;**************************************************************************** +; send_packet +; +; sends the passed packet (which is in a memory buffer) to the output +; device by using the macro SEND_CHAR() which must be defined by the +; user. A sample SEND_CHAR() is defined above. +; +; Entry: +; DS:SI ==> raw packet to be sent +; CX = length of raw packet to be sent +; direction flag is assumed to be cleared (incrementing) +; +; Exit: +; +; +; Trashed: +; none +; +;**************************************************************************** +send_packet proc + push cx + push si + SEND_CHAR SLIP_END ; send an end char to flush any garbage + jcxz @@bailout ; if zero length packet, bail out now +@@nextchar: + lodsb ; load next char + cmp al,SLIP_END ; Q: is it the special END char? + jne @@check_esc ; N: check for ESC + SEND_CHAR SLIP_ESC ; Y: send ESC + ESC_END instead + mov al,SLIP_ESC_END ; + jmp @@ordinary ; + +@@check_esc: + cmp al,SLIP_ESC ; Q: is it the special ESC char? + jne @@ordinary ; N: send ordinary char + SEND_CHAR SLIP_ESC ; Y: send ESC + ESC_END instead + mov al,SLIP_ESC_ESC ; + ; fall through to ordinary character + +@@ordinary: + SEND_CHAR al ; + + loop @@nextchar ; keep going until we've sent all chars +@@bailout: + SEND_CHAR SLIP_END ; send an end char to signal end of packet + pop si + pop cx + ret +send_packet endp + +;**************************************************************************** +; recv_packet +; +; receives a packet using the macro RECV_CHAR() which must be defined by +; the user and places the received packet into the memory buffer pointed +; to by ES:DI. The final length is returned in BX. +; +; Note that in the case of a buffer overrun, the portion of the packet +; that fit into the buffer is returned and BX and CX are equal. There +; is no way to tell the difference between a packet that just exactly +; fit and one which was truncated due to buffer overrun, so it is +; important to assure that the buffer is big enough to ALWAYS contain +; at least one spare byte. +; +; A sample RECV_CHAR() is defined above. +; +; Entry: +; ES:DI ==> packet buffer +; CX = length of buffer +; direction flag is assumed to be cleared (incrementing) +; +; Exit: +; BX = length of packet received +; +; Trashed: +; none +; +;**************************************************************************** +recv_packet proc + push cx + push di + xor bx,bx ; zero received byte count + jcxz @@bailout ; if zero length packet, bail out now +@@nextchar: + RECV_CHAR ; fetch a character into al + cmp al,SLIP_END ; Q: is it the special END char? + jne @@check_esc ; N: check for ESC + or bx,bx ; YQ: is it the beginning of packet? + jz @@nextchar ; Y: keep looking + jmp @@bailout ; N: end of packet, so return it + +@@check_esc: + cmp al,SLIP_ESC ; Q: is it the special ESC char? + jne @@ordinary ; N: it's an ordinary char + RECV_CHAR ; Y: get another character + cmp al,SLIP_ESC_END ; Q: is it ESC_END? + jne @@check_esc_esc ; N: check for ESC_ESC + mov al,SLIP_END ; Y: convert to ordinary END char + jmp @@ordinary ; +@@check_esc_esc: + cmp al,SLIP_ESC_ESC ; Q: is it ESC_ESC? + mov al,SLIP_ESC ; Y: convert to ordinary ESC char + ; protocol violation! fall through to ordinary character + +@@ordinary: + stosb ; store character in buffer + inc bx ; got another char + loop @@nextchar ; keep going until we've sent all chars +@@bailout: + pop di + pop cx + ret +recv_packet endp + END \ No newline at end of file diff --git a/assembly/Assembly language program which shows the current date and time in a form identical to that used by Posix ctime() .asm b/assembly/Assembly language program which shows the current date and time in a form identical to that used by Posix ctime() .asm new file mode 100644 index 0000000..4119e25 --- /dev/null +++ b/assembly/Assembly language program which shows the current date and time in a form identical to that used by Posix ctime() .asm @@ -0,0 +1,325 @@ +; showdate.asm +; +; prints the date and time to stdout +; equivalent to the following C++ program: +; +;#include +;#include +; +;int main() +;{ +; time_t t; +; time(&t); // get the current time +; cout << ctime(&t); // convert to string and print +; return 0; +;} +; +; This code may be assembled and linked using Borland's TASM: +; tasm /la /m2 showdate +; tlink /Tdc showdate +; +STDOUT equ 01h ; handle of standard output device + +DOS_GET_DATE equ 02ah ; get system date +DOS_GET_TIME equ 02ch ; get system time +DOS_WRITE_HANDLE equ 040h ; write to handle +DOS_TERMINATE equ 04ch ; terminate with error code + +DOSINT macro function, subfunction + IFB + mov ah,(function AND 0ffh) + ELSE + mov ax,(function SHL 8) OR (subfunction AND 0ffh) + ENDIF + int 21h ; invoke DOS function +endm + + +MODEL tiny +;.STACK 100h +.CODE + +;**************************************************************************** +; main +; +; calls showdate routne and exists with 00 error code +; +; Entry: +; +; Exit: +; +; Trashed: +; none +; +;**************************************************************************** +main proc far + .STARTUP ; sets up DS and stack + call showdate ; + .EXIT 0 ; return with errcode=0 +main endp + +;**************************************************************************** +; showdate +; +; fetches the DOS system date, prints it to stdout and exits +; the format of the output is identical to that of the Posix ctime() +; function: +; +; Thu May 11 16:11:30 2000 +; +; The day of week and month are always 3 characters long. The time of +; day is in 24hour form (e.g. 16:11:30 is a few minutes after four in +; the afternoon) and the year is always four digits. The whole thing is +; followed by a newline character (line feed = 0ah), making 25 +; characters total. +; +; Note that ctime() returns 26 characters which is all of the above, +; followed by a terminating NUL char but this program does not emit a +; NUL.) +; +; Entry: +; DS points to segment for our data tables +; +; Exit: +; carry may be set if last write failed +; +; Trashed: +; none +; +;**************************************************************************** +showdate proc + push ax bx cx dx ; + DOSINT DOS_GET_DATE ; +; returns the following +; cx = year (1980-2099) +; dh = month (1-12) == (Jan..Dec) +; dl = day (1-31) +; al = day of week (0-6) == (Sun..Sat) + + push cx ; + push dx ; save the return values + + ; write the day of week + mov dx, offset dayname ; + mov cx,3 ; number of bytes to write + call WriteSubstring ; + + ; write the month + pop ax ; recall month/day + push ax ; and save it again + mov al,ah ; isolate just month + mov dx, offset monthname - 3 ; monthname array is 1-based + mov cx,3 ; number of bytes to write + call WriteSubstring ; + + ; write the day of the month + pop ax ; + call WriteNumber ; + call WriteSpace ; + + ; write the hour + DOSINT DOS_GET_TIME ; ch = hour, cl = min, + ; dh = sec, dl = hundredths + + push dx ; save seconds + push cx ; save minutes + mov al,ch ; + call WriteNumber ; + call WriteColon ; + + ; write the minutes + pop ax ; + call WriteNumber ; + call WriteColon ; + + ; write the seconds + pop ax ; + mov al,ah ; + call WriteNumber ; + call WriteSpace ; + + ; write the year (century first) + pop ax ; + xor dx,dx ; clear other reg before divide + mov cx,100 ; ax = ax/100, dx = remainder + div cx ; + push dx ; save remainder + call WriteNumber ; + + ; write the year (year within century) + pop ax ; + call WriteNumber ; + mov dx,offset newlinechar + call PrintOne ; + pop dx cx bx ax ; restore stack + ret ; +showdate endp + +;**************************************************************************** +; WriteSubstring +; +; writes a short substring to stdout +; specifically, prints CL characters, starting at DS:(DX+CL*AL) +; +; Entry: +; DS:DX ==> pointer to base of string array +; CL = size of each string +; AL = string selector (i.e. which string) +; +; Exit: +; CY set if there was an error writing last byte +; if CY clear, +; AX = 1 (number of bytes written) +; else +; AX = error code +; +; Trashed: +; BX CX DX +; +;**************************************************************************** +WriteSubstring proc + mul cl ; ax = cl * al + add dx,ax ; offset now points to appropriate day string + call PrintIt ; +WriteSubstring endp + ; deliberately fall through +;**************************************************************************** +; WriteSpace +; +; writes a single space character (20h) to stdout +; +; Entry: +; DS points to data table segment +; +; Exit: +; CY set if there was an error writing last byte +; if CY clear, +; AX = 1 (number of bytes written) +; else +; AX = error code +; +; Trashed: +; BX CX DX +; +;**************************************************************************** +WriteSpace proc + mov dx,offset spacechar; +WriteSpace endp + ; deliberately fall through +;**************************************************************************** +; PrintOne +; +; prints a single character pointed to by DS:DX +; +; Entry: +; DS:DX ==> points to the character to be printed +; +; Exit: +; CY set if there was an error writing last byte +; if CY clear, +; AX = 1 (number of bytes written) +; else +; AX = error code +; +; Trashed: +; BX CX DX +; +;**************************************************************************** +PrintOne proc + mov cx,1 ; +PrintOne endp + ; deliberately fall through +;**************************************************************************** +; PrintIt +; +; prints the passed string to stdout +; +; Entry: +; DS:DX ==> points to string to be printed +; CX = number of bytes to be printed +; +; Exit: +; CY set if there was an error writing to stdout +; if CY clear, +; AX = number of bytes written +; else +; AX = error code +; +; Trashed: +; none +; +;**************************************************************************** +PrintIt proc + mov bx,STDOUT ; + DOSINT DOS_WRITE_HANDLE ; write to the file + ret ; +PrintIt endp + +;**************************************************************************** +; WriteColon +; +; writes a colon character to stdout +; +; Entry: +; DS points to data segment +; +; Exit: +; CY set if there was an error writing to stdout +; if CY clear, +; AX = 1 (number of bytes written) +; else +; AX = error code +; +; Trashed: +; none +; +;**************************************************************************** +WriteColon proc + mov dx,offset colonchar; + jmp PrintOne ; +WriteColon endp + +;**************************************************************************** +; WriteNumber +; +; prints the number in AL to stdout as two decimal digits +; +; Entry: +; AL = number to be printed. It must be in the range 00-99 +; +; Exit: +; CY set if there was an error writing to stdout +; if CY clear, +; AX = 2 (number of bytes written) +; else +; AX = error code +; +; Trashed: +; BX CX DX +; +;**************************************************************************** +WriteNumber proc + xor ah,ah ; clear out high half + mov cl,10 ; prepare to convert to decimal (base 10) + div cl ; divide it out + or ax,3030h ; convert to ASCII digits + push ds ; remember DS for later + push ax ; push converted chars on stack + mov dx,ss ; + mov ds,dx ; ds = ss + mov dx,sp ; print data from stack + mov cx,2 ; two characters only + call PrintIt ; + pop bx ; fix stack + pop ds ; restore ds pointer + ret ; +WriteNumber endp + +;.DATA + dayname db "SunMonTueWedThuFriSat" + monthname db "JanFebMarAprMayJunJulAugSepOctNovDec" + spacechar db " " + colonchar db ":" + newlinechar db 0ah ; in C this is \n + +end \ No newline at end of file diff --git a/assembly/BIOS-based disk I-O to access MS-DOS file structure.asm b/assembly/BIOS-based disk I-O to access MS-DOS file structure.asm new file mode 100644 index 0000000..22a1c82 --- /dev/null +++ b/assembly/BIOS-based disk I-O to access MS-DOS file structure.asm @@ -0,0 +1,350 @@ +; rawread.asm +; +; this program reads a DOS cluster using only BIOS disk calls. All +; of the tasks usually done by DOS, e.g. FAT lookup, cluster to +; logical sector translation, logical to physical translation, are +; all done by this program instead. The idea is to be able to create +; a program that can access DOS disks from a bootable floppy without +; having to have DOS. +; +; well, that's what it used to do. Now it's supposed to do something +; completely different. Its job is to scan the entire surface of the +; hard drive, looking for the specified string. If that string is +; found, it is to print the full path and directory entry, including +; the file date and time. +; +; but wait! There's more. Now what we have is a number of raw +; routines which could prove useful for manipulating a DOS file +; structure outside of the DOS environment. The main routine still +; should be kept (if renamed), since the order in which these things +; are done is important (e.g. later calls depend on data set up by +; earlier calls). +; +; get filename +; parse filename into subdirs +; locate root dir and cluster size +; follow subdir routing to filename +; report file size, date & time +; + .MODEL small + .STACK 0200h + .586P + + .DATA +PartEntry STRUC + Bootable db ? ;80h = bootable, 00h = nonbootable + BeginHead db ? ;beginning head + BeginSector db ? ;beginning sector + BeginCylinder db ? ;beginning cylinder + FileSystem db ? ;name of file system + EndHead db ? ;ending head + EndSector db ? ;ending sector + EndCylinder db ? ;ending cylinder + StartSector dd ? ;starting sector (relative to beg. of disk) + PartSectors dd ? ;number of sectors in partition +PartEntry ENDS + +BootSector STRUC + Jump db ? ;E9 xx xx or EB xx 90 + JumpTarget dw ? ;E9 xx xx or EB xx 90 + OemName db '????????' ;OEM name & version + ;Start of BIOS parameter block + BytesPerSec dw ? ;bytes per sector + SecPerClust db ? ;sectors per cluster + ResSectors dw ? ;number of reserved sectors + FATs db ? ;number of file allocation tables + RootDirEnts dw ? ;number of root-dir entries + Sectors dw ? ;total number of sectors + Media db ? ;media descriptor byte + FATsecs dw ? ;number of sectors per FAT + SecPerTrack dw ? ;sectors per track + Heads dw ? ;number of heads + HiddenSecs dd ? ;number of hidden sectors + HugeSectors dd ? ;num sectors if Sectors==0 + ;End of BIOS parameter block +BootSector ENDS + +DirEntry STRUC + FileName db '????????' ;name + Extension db '???' ;extension + Attributes db ? ;attributes + Reserved db 10 dup (?) ;reserved + Time dw ? ;time stamp + Date dw ? ;date stamp + StartCluster dw ? ;starting cluster + FileSize dd ? ;file size +DirEntry ENDS + +BootFileName db "CONFIG SYS" ;the boot loader for this OS +MBR DB 0200h DUP (?) +buff DB 0200h * 40h DUP (?) +ClustOffs dd ? + +CR EQU 0DH +LF EQU 0AH + + + .CODE +main PROC + STARTUPCODE ;initialize stuff + call FetchMBR C ;fetch the master boot record + jc @@exit + mov cx,4 ;search up to four partitions + add bx,01aeh ;point to partition table (-10h) +@@FindBootable: + add bx,10h ;point to next entry + cmp BYTE ptr [bx],80h ;is it a bootable partition? + loopnz @@FindBootable + call FetchSector C, \ + WORD ptr [(PartEntry PTR bx).BeginHead], \ + WORD ptr [(PartEntry PTR bx).BeginSector], \ + WORD ptr [(PartEntry PTR bx).BeginCylinder], \ + OFFSET MBR, ds ;SEG MBR +; +; here's the point at which our OS loader would begin, with the +; BootSector structure in memory. +; + mov bx, OFFSET MBR + call CalcClustOff C, \ + WORD ptr [(BootSector PTR bx).ResSectors], \ + WORD ptr [(BootSector PTR bx).FATsecs], \ + WORD ptr [(BootSector PTR bx).FATs], \ + WORD ptr [(BootSector PTR bx).RootDirEnts], \ + WORD ptr [(BootSector PTR bx).BytesPerSec], \ + WORD ptr [(BootSector PTR bx).SecPerClust] + mov WORD ptr [ClustOffs],ax + mov WORD ptr [ClustOffs+2],dx + call CalcClust2 C, \ + WORD ptr [(BootSector PTR bx).ResSectors], \ + WORD ptr [(BootSector PTR bx).FATsecs], \ + WORD ptr [(BootSector PTR bx).FATs] + ; now dx:ax contains the logical sector for cluster 2 + call LsectToGeom C, \ + ax, dx, \ + WORD ptr [(BootSector PTR bx).HiddenSecs] , \ + WORD ptr [((BootSector PTR bx).HiddenSecs)+2],\ + [(BootSector PTR bx).Heads], \ + [(BootSector PTR bx).SecPerTrack] + + mov dl,80h + mov bx,offset buff + mov al,[(BootSector PTR MBR).SecPerClust] + mov ah,2h ; get ready to read + int 13h + ; now find our desired filename within buffer (which has the root dir) + + call FindFile C, \ + bx, 200h * 40h, offset BootFileName + xor dh,dh + mov dl,[(BootSector PTR MBR).SecPerClust] + mov si,ax + mov ax,[(DirEntry PTR si).StartCluster] + mul dx + add ax,WORD ptr [ClustOffs] + adc dx,WORD ptr [ClustOffs+2] + ; now dx:ax contains logical sector number for start of file + + call LsectToGeom C, \ + ax, dx, \ + WORD ptr [(BootSector PTR MBR).HiddenSecs] , \ + WORD ptr [((BootSector PTR MBR).HiddenSecs)+2],\ + [(BootSector PTR MBR).Heads], \ + [(BootSector PTR MBR).SecPerTrack] + mov dl,80h + mov ax,204h ; read in 2k worth of data + int 13h + +@@exit: + EXITCODE ;exit to DOS +ENDP main + +; +; FetchMBR - fetches the Master Boot Record from the first physical +; hard disk and stores it in the location MBR. +; +; INPUT: none +; OUTPUT: AX is error code if CY set, ES:BX ==> MBR +; DESTROYED: none +; +FetchMBR PROC C + USES cx, dx ;save registers we'll use + mov dx,80h ;first physical disk + mov cx,1 ;head 1, sector 0 + mov bx,ds ; + mov es,bx ;point to boot record buffer + mov bx,OFFSET MBR ;read into boot record + mov ax,0201h ;read one sector + int 13h ;BIOS read + ret ;return to main +FetchMBR ENDP + +; +; FetchSector - fetches the physical sector described by the passed +; parameters and stores it in the named buffer +; +; INPUT: head, sector, cylinder, buffer +; OUTPUT: AX is error code if CY set, ES:BX ==> Boot +; DESTROYED: none +; +FetchSector PROC C head:BYTE, sector:BYTE, cylinder:BYTE, buffer:DWORD + USES cx, dx ;save registers we'll use + mov ch, [cylinder] ; + mov cl, [sector] ; + mov dh, [head] ; + mov dl, 80h ;first physical hard drive + les bx, [buffer] ; + mov ax,0201h ;read one sector + int 13h ;BIOS read + ret ;return to main +FetchSector ENDP + +; +; GeomToLsect - converts to logical sector number from the physical +; geometry (head, cylinder, track). See LsectToGeom. +; +; INPUT: cx, dx are set with cylinder/track, and head respectively +; HiddenSecs, Heads, SecPerTrack +; OUTPUT: lsect +; DESTROYED: none +; +GeomToLsect PROC C lsect:DWORD, dHiddenSecs:DWORD, \ + dHeads:WORD, dSecPerTrack:WORD, buffer:DWORD + USES ax ;save registers we'll use + mov ax, WORD ptr [lsect] ;load lsect into DX:AX + mov dx, WORD ptr [lsect+2] ; + stc ;add one additional + adc ax, WORD ptr [dHiddenSecs] ;add starting sector + adc dx, WORD ptr [dHiddenSecs+2] ; + div [dSecPerTrack] ; + mov cl,dl ;store sector in cl + xor dx,dx ; + div [dHeads] ; + mov dh,dl ;store head in dh + mov ch,al ;store low 8 bits of cylinder in ch + shr ax,1 ; + shr ax,1 ; + and al,0c0h ;pass through two hi bits only + or cl,ah ;mov bits into location + ret ; +GeomToLsect ENDP + +; +; LsectToGeom - converts from logical sector number to the physical +; geometry (head, cylinder, track) in the form required +; by the BIOS (Int 13h) disk read and write calls. +; +; INPUT: lsect, HiddenSecs, Heads, SecPerTrack +; OUTPUT: cx, dx are set with cylinder/track, and head respectively +; DESTROYED: none +; +LsectToGeom PROC C lsect:DWORD, lHiddenSecs:DWORD, \ + lHeads:WORD, lSecPerTrack:WORD, buffer:DWORD + USES ax ;save registers we'll use + mov ax, WORD ptr [lsect] ;load lsect into DX:AX + mov dx, WORD ptr [lsect+2] ; + stc ;add one additional + adc ax, WORD ptr [lHiddenSecs] ;add starting sector + adc dx, WORD ptr [lHiddenSecs+2] ; + div [lSecPerTrack] ; + mov cl,dl ;store sector in cl + xor dx,dx ; + div [lHeads] ; + mov dh,dl ;store head in dh + mov ch,al ;store low 8 bits of cylinder in ch + shr ax,1 ; + shr ax,1 ; + and al,0c0h ;pass through two hi bits only + or cl,ah ;mov bits into location + ret ; +LsectToGeom ENDP + +; +; CalcClust2 - calculates the starting logical sector number of +; cluster 2, (the beginning of data space for +; partitions). +; +; INPUT: ResSectors, FATsecs, FATs +; OUTPUT: dx:ax contains the starting logical sector number +; DESTROYED: none +; +CalcClust2 PROC C cResSectors:WORD, cFATsecs:WORD, cFATs:BYTE + xor dx,dx ; + mov ax,[cFATsecs] ; + mul [cFATs] ; + add ax,[cResSectors] ; + adc dx,0 ; + ret +CalcClust2 ENDP + +; +; CalcClustOff - calculates the starting logical sector number of +; cluster 0, which isn't really a cluster, but the +; number returned is useful for calculations converting +; cluster number to logical sector +; +; INPUT: ResSectors, FATsecs, FATs +; OUTPUT: dx:ax contains the starting logical sector number +; DESTROYED: none +; +CalcClustOff PROC C dResSectors:WORD, dFATsecs:WORD, dFATs:BYTE, \ + dRootDirEnts:WORD, dBytesPerSec:WORD, dSecPerClust:BYTE + LOCAL clustLo:WORD, clustHi:WORD + xor dh,dh + mov ax,[dFatSecs] + mov dl,[dFATs] + mul dx + add ax,[dResSectors] + adc dx,0 +; call CalcClust2 C, [dResSectors], [dFATsecs], [dFATs] + ; now dx:ax = FATs * FATsecs + ResSectors + mov [clustLo],ax + mov [clustHi],dx + mov dx,20h ; bytes per dir entry + mov ax,[dRootDirEnts] ; + mul dx ; multiply 'em out + div [dBytesPerSec] ; and divide by bytes/sec + add [clustLo],ax ; + adc [clustHi],dx ; create the aggregate + mov al,[dSecPerClust] ; + xor ah,ah ; + shl ax,1 ; AX = SecPerClust * 2 + sub [clustLo],ax ; + sbb [clustHi],0 ; propagate carry flag + mov ax,[clustLo] ; + mov dx,[clustHi] ; + ret +CalcClustOff ENDP + +; +; FindFile - given a memory buffer containing the directory data +; and a static file name for which to search, this routine +; finds the file and returns a pointer to its directory +; entry in ds:si +; +; INPUT: dirbuffer, filespec +; OUTPUT: ax contains pointer to directory entry (or NULL) +; DESTROYED: none +; +FindFile PROC C dirbuffer:WORD, limit:WORD, filespec:WORD + USES cx, dx, di, si, es + mov cx,ds ; + mov es,cx ; es and ds point to same segment + cld ; always count forward + mov ax,[dirbuffer] ; load 'em up + add [limit],ax + mov dx,[filespec] ; +keepsearching: + mov cx,11 ; size of dos filename (8.3) + mov si,dx ; + mov di,ax ; + repe cmpsb ; compare 'em + jz foundit ; + add ax,20h ; size of directory entry + cmp ax,[limit] + jb keepsearching + xor ax,ax + +foundit: + ret +FindFile ENDP + END \ No newline at end of file diff --git a/assembly/Boot loader for a roll-your-own operating system.asm b/assembly/Boot loader for a roll-your-own operating system.asm new file mode 100644 index 0000000..82ecfc3 --- /dev/null +++ b/assembly/Boot loader for a roll-your-own operating system.asm @@ -0,0 +1,267 @@ +; loader.asm + +PartEntry STRUC + Bootable db ? ;80h = bootable, 00h = nonbootable + BeginHead db ? ;beginning head + BeginSector db ? ;beginning sector + BeginCylinder db ? ;beginning cylinder + FileSystem db ? ;name of file system + EndHead db ? ;ending head + EndSector db ? ;ending sector + EndCylinder db ? ;ending cylinder + StartSector dd ? ;starting sector (relative to beg. of disk) + PartSectors dd ? ;number of sectors in partition +PartEntry ENDS + +BootSector STRUC + bsJump db 0EBh, (extra - bsJump), 090h + ; E9 XX XX or EB xx 90 + OemName db 8 dup (?) ; OEM name and version + ; start of BIOS parameter block + BytesPerSec dw ? ; bytes per sector + SecPerClust db ? ; sectors per cluster + ResSectors dw ? ; number of reserved sectors + FATs db ? ; number of FATs + RootDirEnts dw ? ; number of root directory entries + Sectors dw ? ; total number of sectors (see HugeSectors) + Media db ? ; media descriptor byte (0f0h for floppies) + FATsecs dw ? ; number of sectors per FAT + SecPerTrack dw ? ; sectors per track + Heads dw ? ; number of heads + HiddenSecs dd ? ; number of hidden sectors + HugeSectors dd ? ; number of sectors if Sectors equals 0 + ; end of BIOS parameter block + DriveNumber db ? ; + Reserved1 db ? ; + BootSignature db ? ; + VolumeID dd ? ; + VolumeLabel db 11 dup (?) + FileSysType db 8 dup (?) + extra dw ? +BootSector ENDS + +DirEntry STRUC + FileName db '????????' ;name + Extension db '???' ;extension + Attributes db ? ;attributes + Reserved db 10 dup (?) ;reserved + Time dw ? ;time stamp + Date dw ? ;date stamp + StartCluster dw ? ;starting cluster + FileSize dd ? ;file size +DirEntry ENDS + +CR EQU 0DH +LF EQU 0AH + +yonder segment para public use16 at 2000h + org 0h + destination proc far + destination endp +yonder ends + + +code segment para public use16 '_CODE' + .386 + assume cs:code, ds:code, es:code, ss:code + org 7c00h +main PROC +MBR: +Boot bootsector < ,'BEROSET ',512,1,1,2,224,2880,0f0h,9,18,2,\ + 0,0,0,0,29h,02a04063ch,'BEROSET 001',\ + 'FAT12 ',07df1h> +over: + mov ax,cs ; + cli + mov ss,ax ; point ss:sp to CS:7c00h + mov sp,7c00h ; which sets up a stack in first 64K + sti + mov ds,ax + mov es,ax +;**************************************************************************** +; +; CalcClustOff - calculates the starting logical sector number of +; cluster 0, which isn't really a cluster, but the +; number returned is useful for calculations converting +; cluster number to logical sector +; +; INPUT: ResSectors, FATsecs, FATs +; OUTPUT: dx:ax contains the starting logical sector number +; DESTROYED: none +; +;**************************************************************************** +CalcClustOff PROC + xor dh,dh + mov ax,[Boot.FatSecs] + mov dl,[Boot.FATs] + mul dx + add ax,[Boot.ResSectors] + adc dx,0 + ; now dx:ax = FATs * FATsecs + ResSectors + mov word ptr [ClustOffs],ax + mov word ptr [ClustOffs+2],dx + mov dx,20h ; bytes per dir entry + mov ax,[Boot.RootDirEnts] + mul dx ; multiply 'em out + div word ptr [Boot.BytesPerSec] ; and divide by bytes/sec + add word ptr [ClustOffs],ax + adc word ptr [ClustOffs+2],dx ; create the aggregate + mov al,[Boot.SecPerClust] ; + xor ah,ah ; + shl ax,1 ; AX = SecPerClust * 2 + sub word ptr [ClustOffs],ax ; + sbb word ptr [ClustOffs+2],0 ; propagate carry flag +; mov ax,word ptr [ClustOffs] ; +; mov dx,word ptr [ClustOffs+2] ; +; ret +CalcClustOff ENDP + +; mov WORD ptr [ClustOffs],ax +; mov WORD ptr [ClustOffs+2],dx + mov bx,offset Boot + call CalcClust2 C, \ + WORD ptr [(BootSector PTR bx).ResSectors], \ + WORD ptr [(BootSector PTR bx).FATsecs], \ + WORD ptr [(BootSector PTR bx).FATs] + ; now dx:ax contains the logical sector for cluster 2 + call LsectToGeom C, \ + WORD ptr [(BootSector PTR bx).HiddenSecs] , \ + WORD ptr [((BootSector PTR bx).HiddenSecs)+2],\ + [(BootSector PTR bx).Heads], \ + [(BootSector PTR bx).SecPerTrack] + + mov dl,[(BootSector PTR bx).DriveNumber] + mov bx,offset buff +retry1: + mov al,[(BootSector PTR MBR).SecPerClust] + mov ah,2h ; get ready to read + int 13h + jc retry1 + ; now find our desired filename within buffer (which has the root dir) + + call FindFile C, \ + bx, 200h * 40h, offset BootFileName + xor dh,dh + mov dl,[(BootSector PTR MBR).SecPerClust] + mov si,ax + mov ax,[(DirEntry PTR si).StartCluster] + mul dx + add ax,WORD ptr [ClustOffs] + adc dx,WORD ptr [ClustOffs+2] + ; now dx:ax contains logical sector number for start of file + + call LsectToGeom C, \ + WORD ptr [(BootSector PTR MBR).HiddenSecs] , \ + WORD ptr [((BootSector PTR MBR).HiddenSecs)+2],\ + [(BootSector PTR MBR).Heads], \ + [(BootSector PTR MBR).SecPerTrack] +retry2: + mov si,offset Boot + mov dl,[(BootSector PTR si).DriveNumber] + mov ah,2h + ; read in a cluster's worth of data + mov al,[(BootSector PTR si).SecPerClust] + ; point to our magic location + mov bx,seg destination + mov es,bx + mov bx,offset destination + int 13h + jc retry2 +@@exit: + jmp destination +ENDP main + +;**************************************************************************** +; +; LsectToGeom - converts from logical sector number to the physical +; geometry (head, cylinder, track) in the form required +; by the BIOS (Int 13h) disk read and write calls. +; +; INPUT: dx:ax=lsect, HiddenSecs, Heads, SecPerTrack +; OUTPUT: cx, dx are set with cylinder/track, and head respectively +; DESTROYED: none +;**************************************************************************** +LsectToGeom PROC C lHiddenSecs:DWORD, \ + lHeads:WORD, lSecPerTrack:WORD, buffer:DWORD + USES ax ;save registers we'll use + stc ;add one additional + adc ax, WORD ptr [lHiddenSecs] ;add starting sector + adc dx, WORD ptr [lHiddenSecs+2] ; + div [lSecPerTrack] ; + mov cl,dl ;store sector in cl + xor dx,dx ; + div [lHeads] ; + mov dh,dl ;store head in dh + mov ch,al ;store low 8 bits of cylinder in ch + shr ax,1 ; + shr ax,1 ; + and al,0c0h ;pass through two hi bits only + or cl,ah ;mov bits into location + ret ; +LsectToGeom ENDP + +;**************************************************************************** +; +; CalcClust2 - calculates the starting logical sector number of +; cluster 2, (the beginning of data space for +; partitions). +; +; INPUT: ResSectors, FATsecs, FATs +; OUTPUT: dx:ax contains the starting logical sector number +; DESTROYED: none +; +;**************************************************************************** +CalcClust2 PROC C cResSectors:WORD, cFATsecs:WORD, cFATs:BYTE + xor dx,dx ; + mov ax,[cFATsecs] ; + mul [cFATs] ; + add ax,[cResSectors] ; + adc dx,0 ; + ret +CalcClust2 ENDP + +;**************************************************************************** +; +; FindFile - given a memory buffer containing the directory data +; and a static file name for which to search, this routine +; finds the file and returns a pointer to its directory +; entry in ds:si +; +; INPUT: dirbuffer, filespec +; OUTPUT: ax contains pointer to directory entry (or NULL) +; DESTROYED: none +;**************************************************************************** + +FindFile PROC C dirbuffer:WORD, limit:WORD, filespec:WORD + USES cx, dx, di, si, es + mov cx,ds ; + mov es,cx ; es and ds point to same segment + cld ; always count forward + mov ax,[dirbuffer] ; load 'em up + add [limit],ax + mov dx,[filespec] ; +keepsearching: + mov cx,11 ; size of dos filename (8.3) + mov si,dx ; + mov di,ax ; + repe cmpsb ; compare 'em + jz foundit ; + add ax,20h ; size of directory entry + cmp ax,[limit] + jb keepsearching + xor ax,ax + +foundit: + ret +FindFile ENDP + + +BootFileName db "BEROSET SYS" ;the boot loader for this OS +; MBR db 0200h DUP (?) +buff db 0200h * 40h DUP (?) +ClustOffs dd ? + org 7dfeh + dw 0AA55h ; signature byte +code ends + + END \ No newline at end of file diff --git a/assembly/Break Handling Utilities Module.asm b/assembly/Break Handling Utilities Module.asm new file mode 100644 index 0000000..d5a0f97 --- /dev/null +++ b/assembly/Break Handling Utilities Module.asm @@ -0,0 +1,70 @@ +TITLE BRK2 -- Break Handling Utilities Module + +TRUE EQU 01H ;boolean true +FALSE EQU 00H ;boolean false +BREAKINT EQU 23H ;dos control-break intrpt +GETVECTOR EQU 35H ;dos get vector function +SETVECTOR EQU 25H ;dos set vector function +DOS_FUNCTION EQU 21H ;dos function call + +BREAK SEGMENT PUBLIC 'CODE' +BREAKFLAG DB 0H ;break key hit flag +SAVEBRK DD 0H ;saved break vec. contents + ASSUME CS:BREAK + ASSUME DS:NOTHING + +;CHECK_BREAK checks if ctrl-break has been pressed. It returns +;true if ctrl-break has been pressed and false if it hasn't. + + PUBLIC CHECK_BREAK +CHECK_BREAK PROC FAR + XOR AX, AX ;clear ax + MOV AL, BREAKFLAG ;return value = breakflag + MOV BREAKFLAG, FALSE ;reset breakflag + RET +CHECK_BREAK ENDP + +;INSTALL_BREAK_HANDLER sets up a ctrl-break interrupt handler. It +;also saves the address of the former break handler so that it can +;be restored later. + + PUBLIC INST_BRK_HANDLR +INST_BRK_HANDLR PROC FAR + PUSH DS + MOV AL, BREAKINT ;AL = break interrupt + MOV AH, GETVECTOR ;AH = dos function code + INT DOS_FUNCTION ;call dos + MOV WORD PTR SAVEBRK, BX ;save offset in int vector + MOV WORD PTR SAVEBRK+2, ES ;save base in int vector + MOV AL, BREAKINT ;AL = break interrupt + MOV AH, SETVECTOR ;AH = dos function code + MOV DX, OFFSET BRK_HANDLER ;DX = offset of brk handler + MOV BX, CS ;BX = this segment + MOV DS, BX ;DS = this segment + INT DOS_FUNCTION ;call dos + POP DS + RET +INST_BRK_HANDLR ENDP + +;BRK_HANDLER is invoked by the bios when ctrl_break is pressed + +BRK_HANDLER PROC FAR + MOV BREAKFLAG, TRUE ;breakflag = yes, break hit + IRET +BRK_HANDLER ENDP + +;REMOVE_BREAK_HANDLER restores the previous ctrl-break handler + +REM_BRK_HANDLR PROC FAR + PUSH DS + MOV AL, BREAKINT ;AL = break interrupt + MOV AH, SETVECTOR ;AH = dos function code + MOV DX, WORD PTR SAVEBRK ;DX = saved 1st word + MOV BX, WORD PTR SAVEBRK+2 ;BX = saved 2nd word + MOV DS, BX ;DS = saved 2nd word + INT DOS_FUNCTION ;call dos + POP DS + RET +REM_BRK_HANDLR ENDP +BREAK ENDS + END \ No newline at end of file diff --git a/assembly/Break.asm b/assembly/Break.asm new file mode 100644 index 0000000..361a21e --- /dev/null +++ b/assembly/Break.asm @@ -0,0 +1,47 @@ +PGROUP Group PROG +DGROUP Group DATA + + +DATA Segment Public 'DATA' + +public brkflag + +brkflag DW 0 + +DATA ends + +PROG Segment Para Public 'PROG' + +public TrapBrea + +assume cs:PGROUP,DS:DGROUP + +TrapBrea proc near + + push ds + push cs + pop ds + mov dx,offset PGROUP:Bret + mov ah,25h + mov al,23h + int 21h + pop ds + ret + +TrapBrea endp + +Bret proc far + + push ds + push ax + mov ax,DGROUP + mov ds,ax + mov brkflag,1 + pop ax + pop ds + iret + +Bret endp +PROG ends + + end \ No newline at end of file diff --git a/assembly/Burnout.asm b/assembly/Burnout.asm new file mode 100644 index 0000000..1a3a092 --- /dev/null +++ b/assembly/Burnout.asm @@ -0,0 +1,127 @@ +COMMENT * + + Demo (and semi-useful) program to read/set burnout device parameters. + + Usage: burnout [ticks] [C+-] [V+-] [H+-] + + Parameters can be separated by almost anything. + With no parameters, program simply returns current status. + + Examples: + burnout 5000 (sets time to 5000 ticks) + burnout 5000H+ (time=5000, use hardware blanking) + burnout 5000,h+ (ditto, separators don't matter) + burnout c+h-v+ (continuous clear, software, monitor video) + burnout /C+ /H- /V+ (ditto) + burnout (return status only) + + Assembly/link: + masm burnout; + link burnout; (ignore NO STACK warning message) + exe2bin burnout burnout.com + + +stdout equ 1 ; DOS output files +stderr equ 2 + +; ----- General equates +DOS equ 21H ; DOS interrupt +TERMINATE equ 20H ; Exit to DOS + +PRINT equ 09H ; DOS "print" string to stdout +FOPEN equ 3D02H ; DOS file open, read/write +FREAD equ 3FH ; DOS file read +FWRITE equ 40H ; DOS file write + +CR equ 13 ; ASCII carriage return +LF equ 10 ; ASCII line fine + +code segment +assume cs:code,ds:code + +org 80H ; Parm storage area in PSP +ParmLength label byte ; Length of parms +org 81H +Parameters label byte ; Start of parms + +org 100H ; Org for .COM +main proc far + jmp start ; Hate to execute data + +DevName db 'BRNDEV',0 ; Burnout device name +handle dw ? ; Storage for handle +Flush db '@' ; Char to flush device I/O +Execute db '#' ; Char to execute device commands + +NotInstalled db 'Burnout device is not installed',13,10 +NotInstalledL equ $ - NotInstalled + +Status db 'Current status: ' ; Status message +StatInsert db 40 dup (?) ; brndev will store status here + +; ----- Open the device +start: + mov dx,offset DevName ; DS:DX => device name + mov ax,FOPEN + int DOS + jnc A1 ; Continue if no error + mov bx,stderr ; Message to stderr + mov cx,NotInstalledL + mov dx,offset NotInstalled + mov ah,FWRITE + int DOS + jmp exit + +; ----- Flush any pending I/O to/from the device +A1: + mov handle,ax ; Save device handle + mov dx,offset Flush ; Point to the "@" + mov cx,1 ; Writing one byte + mov bx,handle ; Device handle + mov ah,FWRITE ; Write "@" to device + int DOS + +; ----- Send and execute parameters if present + mov cl,ParmLength ; Parm length to CL + or cl,cl ; Any parms present? + jz A2 ; Skip if not + xor ch,ch ; CX = parm length + mov dx,offset Parameters ; DS:DX => parms + mov bx,handle ; BX = device handle + mov ah,FWRITE ; Write parms to device + int DOS + + mov dx,offset Execute ; Execute the parms + mov cx,1 ; Writing one byte + mov bx,handle ; Device handle + mov ah,FWRITE ; Write "#" to device + int DOS + +; ----- Get and display device status +A2: + mov dx,offset StatInsert ; DS:DX => where to put status + mov cx,0FFH ; Ask for lots of data; DOS will ... + ; ... fetch only until CR found. + mov bx,handle ; Device handle + mov ah,FREAD ; Read device info + int DOS + + mov cx,ax ; CX = actual # bytes read + mov di,offset StatInsert ; Where the stat data is stored + add di,cx ; Add length of input read + mov al,CR ; Store a CR/LF/'$' at end + cld + stosb + mov al,LF + stosb + mov al,'$' + stosb + mov dx,offset Status ; Write status to stdout + mov ah,PRINT + int DOS + +exit: + int TERMINATE ; Exit to DOS +main endp +code ends +end main \ No newline at end of file diff --git a/assembly/CLEAR Utility to clear display and set character attributes.asm b/assembly/CLEAR Utility to clear display and set character attributes.asm new file mode 100644 index 0000000..0b4c07a --- /dev/null +++ b/assembly/CLEAR Utility to clear display and set character attributes.asm @@ -0,0 +1,103 @@ +; +input equ 080h ;command line tail buffer +cr equ 0dh ;ASCII carriage return +; +cseg segment byte + assume cs:cseg,ds:cseg +; + org 0100h ;since this will be + ; a COM file +; +clear: ;initialize display... + ;call BIOS video driver to + mov ah,15 ;get current display mode: + int 10h ;returns AL = mode, and + ;AH = no. of columns. + cmp al,7 ;if we are in graphics modes + je clear0 ;(modes 4,5,6) then exit + cmp al,3 ;but if we are in mode 0-3 + ja clear9 ;or 7 then continue. +clear0: ;set up size of window to + ;be initialized... + xor cx,cx ;set upper left corner of + ;window to (X,Y)=(0,0) + mov dh,24 ;set Y to 24 for lower right + mov dl,ah ;corner, and X to the number + dec dl ;of columns returned by BIOS + ;minus 1 + mov bh,7 ;initialize attribute byte + ;to "normal" video display, + ;i.e. white on black. + ;set SI=address of command + ;tail's length byte + mov si,offset input + cld ;clear the Direction Flag + ;for "LODS" string instruction. + lodsb ;check length byte to see if + or al,al ;there's any command tail. + jz clear8 ;no,go clear the screen + ;with normal video attribute + ; +clear1: lodsb ;check the next byte of + ;the command tail, + cmp al,cr ;if carriage return + je clear8 ;we are done. + or al,20h ;fold the character to + ;lower case. + cmp al,'a' ;make sure it's in range a-z + jb clear1 ;no, skip it + cmp al,'z' + ja clear1 ;no, skip it + cmp al,'i' ;I=Set intensity + jne clear2 ;jump if not I + or bh,08 ;set intensity bit + jmp short clear1 +clear2: cmp al,'r' ;R=Reverse + jne clear3 ;jump if not R + and bh,088h ;mask off old foreground/ + ;background bits and + or bh,070h ;change to reverse video + jmp short clear1 +clear3: cmp al,'u' ;U=Underline + jne clear4 ;jump if not U + and bh,088h ;mask off old foreground/ + ;background bits and + or bh,01h ;change to underline + jmp short clear1 +clear4: cmp al,'b' ;B=Blink + jne clear5 ;jump if not B + or bh,080h ;set blink bit + jmp short clear1 +clear5: cmp al,'s' ;S=Silent + jne clear1 ;if not S try next char. + mov bh,0 ;if S command, rig for + ;silent running. Clear + ;the foreground/background + ;display control fields, and + ;don't bother to look for + ;any more command characters. + ; +clear8: ;now we have decoded all + ;the characters in the + ;command tail, and are ready + ;to initialize the display. + ;BH= desired attribute + ;CL,CH=(X,Y),upper left + ; corner of window + ;DL,DH=(X,Y),lower right + ; corner of window + mov ax,0600h ;AH = function type 6, + ;AL = lines to scroll (zero) + int 10h ;request initialization + ;of window by BIOS + ; + mov ah,2 ;now set the cursor to + mov bh,0 ;(X,Y)=(0,0), Page=0 + xor dx,dx + int 10h + ; +clear9: int 20h ;exit to PC-DOS +; +cseg ends +; + end clear \ No newline at end of file diff --git a/assembly/Calculator.asm b/assembly/Calculator.asm new file mode 100644 index 0000000..0c9274b --- /dev/null +++ b/assembly/Calculator.asm @@ -0,0 +1,77 @@ +PAGE ,132 + TITLE CALC +CGROUP GROUP CODESEG +CODESEG SEGMENT PARA PUBLIC 'CODE' + ASSUME CS:CGROUP,DS:CGROUP,ES:CGROUP + PUBLIC CALC + + ORG 100H + +CALC PROC FAR + JMP START + +;---------------------------------------------------------------------; +; ; +; DATA AREA ; +; ; +;---------------------------------------------------------------------; + + DB 'INTERRUPT NUMBER =' +INT_NUMBER DB 61h + +SCREEN_HANDLE DW 0001h + +MESSAGE DB 'PEMATH is not resident',13,10 +MESSAGE_LEN EQU $-MESSAGE + +TAG DB 'PEMATH' +TAG_LEN EQU $-TAG + +;---------------------------------------------------------------------; +; ; +; CODE AREA ; +; ; +;---------------------------------------------------------------------; + +START: +;---------------------------------------------------------------------; +; TEST FOR PRESENCE OF CALCULATOR ; +;---------------------------------------------------------------------; + SUB AX,AX + MOV ES,AX + SUB BH,BH + MOV BL,INT_NUMBER + SHL BX,1 + SHL BX,1 + MOV DI,ES:[BX] + MOV ES,ES:[BX+2] + ADD DI,4 + LEA SI,TAG + MOV CX,TAG_LEN + REPE CMPSB + JE CALL_CALC + MOV BX,SCREEN_HANDLE + MOV CX,MESSAGE_LEN + LEA DX,MESSAGE + MOV AH,40h + INT 21h + JMP SHORT CALC_EXIT +;---------------------------------------------------------------------; +; CALL CALCULATOR ; +;---------------------------------------------------------------------; +CALL_CALC: + MOV AL,INT_NUMBER + MOV BYTE PTR INT_CODE,AL + DB 0CDh ; INT +INT_CODE: + DB 00h + NOP + NOP + +CALC_EXIT: + INT 20h + +CALC ENDP + +CODESEG ENDS + END CALC \ No newline at end of file diff --git a/assembly/Cd Check.asm b/assembly/Cd Check.asm new file mode 100644 index 0000000..f4e50a3 --- /dev/null +++ b/assembly/Cd Check.asm @@ -0,0 +1,58 @@ +.model small ; It's a flaw of mine ... I really like this model + ; I know I should do a .com with the tiny model.. + ; but I just love the small :> +.stack 100h ; Plenty stack ;> +.386 + +.data +info db 30 dup (0) +right db 'Right CD$' +wrong db 'Wrong CD$' +nomscdex db 'MSCDEX not installed$' +.code +mov ax, @data ; Make DS&ES point to the DATA +mov ds,ax +mov es,ax + +lea edx, nomscdex +xor ebx,ebx +mov eax, 1500h ; MSCDEX installed? +int 2fh +test ebx,ebx +jz exit + + +mov edi,10h +nextloop: +mov ecx,edi +mov ax, 150bh ; is drive ECX supported by MSCDEX (is it a cdrom?) +int 2fh +test ax,ax ; ax!=0 if drive is CDrom +jz continiue + +mov ax, 440dh +mov dx, offset info +mov bl,5 +mov ch,8 +mov cl,66h +int 21h ; Fetch volume serial number (same as when you do dir) + +mov eax, dword ptr [info+2] +cmp eax, 0ffb7f724h; ;<<<?@' + db 'ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`' + db 'abcdefghijklmnopqrstuvwxyz{|}~' + db 52 dup(' ') + db '|++++++|+++++++++-++++++++-+++++++++++++' + db 36 dup(' ') +ctable ends + end \ No newline at end of file diff --git a/assembly/Checks the validity of an ISBN by verifying the checksum.asm b/assembly/Checks the validity of an ISBN by verifying the checksum.asm new file mode 100644 index 0000000..b9fe254 --- /dev/null +++ b/assembly/Checks the validity of an ISBN by verifying the checksum.asm @@ -0,0 +1,113 @@ +; From Ed Beroset - ISBN validation +; > Anyone know how to validate the ISBN numbers from books? + +; isbnchek.asm +comment ^ + + This file contains a C-callable routine which calculates the + check digit (tenth digit) of an ISBN and returns the ASCII + representation of that digit. + + This code was written for Borland's TASM + and may be assembled with the following command: + + tasm /m2 isbnchek.asm + +^ + .MODEL small + + public isbncheck + + .CODE +;/*************************************************************************** +; +; Name: +; isbncheck +; +; Purpose: +; Calculates the check digit for a ten digit ISBN, converts that +; digit to its ASCII representation and returns that answer. +; +; Algorithm: +; An ISBN consists of nine digits plus a validation digit. +; Number the digits from left to right as d1, d2, ... d9, with +; d10 being the validation digit. The calculation is then +; +; d10 = (1(d1) + 2(d2) + 3(d3) + ... + i(di) + ... + 9(d9))%11 +; +; or the weighted sum of each digit mod eleven. +; +; In our assembly language implementation, we simulate the +; multiplications by looping through and summing as in the +; following psuedocode: +; +; sum = 0 +; for i=1 to 9 +; { +; for j=i to 9 +; { +; sum = sum + isbn[j] +; } +; } +; +; Entry: +; +; isbn = a nine digit ASCII string containing the ISBN +; (with or without the check digit which is not used here) +; +; Register usage within the routine: +; +; AL = current ISBN digit +; AH = sum of digits so far +; BX = start pointer into ISBN for each outer loop +; CX = digit counter (inner loop) +; DX = start value for digit counter +; SI = points to current ISBN digit +; +; Exit: +; +; AX = ASCII representation of calculated check digit +; +; Trashed: +; none +; +;***************************************************************************/ +isbncheck proc C isbn:ptr byte + push bx + push cx + push dx + push si + mov bx,[isbn] ; + mov dx,9 ; number of digits in raw ISBN + xor ax,ax ; clear out our total + cld ; count up +@@bigloop: ; + mov si,bx ; point to a digit in the ISBN + mov cx,dx ; get digit count in CX +@@AddEmUp: ; + lodsb ; fetch digit into AL + and al,0fh ; convert from ASCII + add ah,al ; add it to our total in AH + loop @@AddEmUp ; do all digits + inc bx ; and advance the digit pointer + dec dx ; now decrement digit count + jnz @@bigloop ; keep going if digits left + mov al,ah ; move sum into al + xor ah,ah ; clear out high half + mov cl,11 ; we'll be doing a mod 11 operation + div cl ; ah = sum mod 11 + mov al,ah ; move calculated check digit to AL + xor ah,ah ; clear out high half + or al,30h ; convert to ASCII digit + cmp al,3Ah ; + jnz NotTen ; + mov al,'X' ; +NotTen: ; + pop si + pop dx + pop cx + pop bx + ret ; return +isbncheck endp + + END \ No newline at end of file diff --git a/assembly/Chips.asm b/assembly/Chips.asm new file mode 100644 index 0000000..265e3df --- /dev/null +++ b/assembly/Chips.asm @@ -0,0 +1,208 @@ +; calling convention: +; +; int chips( void ); +; +; returns: +; +; tucked away neatly in your AX.... +; +; you get back 8x if an 8088/8086 +; 18x if an 80186/80188 +; 28x if an 80286 +; 38x if an 80386 +; 20x for a NEC V20/V30 +; AND +; xx0 if NO NDP is found +; xx1 if an 8087 +; xx2 if an 80287 +; xx3 for an 80387 +; +; OR..... +; +; >>> A return of 280 means you got an 80286 machine with no NDP, <<< +; >>> 383 means you have an 80386/80387 rig to work with, and a <<< +; >>> return of 81 sez that you have 8088/8086 CPU with an 8087. <<< +; >>> A 200 tells you that you got an NEC V20/V30 without an NDP. <<< +; >>> ETC., Etc., etc. <<< +; +; NOTE: +; +; There are lotsa ways of handling the way this function returns +; it's data. For my purposes, I have elected this one because +; it requires only int arithmetic on the caller's end to extract +; all the info I need from the return value. I think that I'm +; well enough 'commented' in the following code so that you will +; be able to tinker and Putz until you find the best return tech- +; nique for Ur purposes without having to reinvent the wheel. +; +; >>>> Please see TEST.C, enclosed in this .ARC. <<<< +; +; REFERENCES: +; +; _chips is made up of two PROC's, cpu_type and ndp_type. +; +; cpu_type is based on uncopyrighted, published logic by +; Clif (that's the way he spells it) Purkiser of Intel - +; Santa Clara. +; +; ndp_type is adopted from Ted Forgeron's article in PC +; Tech Journal, Aug '87 p43. +; +; In the event of subsequent republication of this function, +; please carry forward reference to these two gentlemen as +; original authors. +; +.MODEL SMALL +.CODE + PUBLIC _chips + +_chips PROC + +control dw 0 ; control word needed for the NDP test + + push BP ; save where Ur at + mov BP,SP ; going in..... + + push DI + push SI + push CX ; not really needed for MSC but kinda + ; nice to do cuz someone else might + ; want to use the function and we do + ; use CX later on + + call cpu_type ; find out what kinda CPU you got and + ; and save it in DX for future reference + call ndp_type ; check for math coprocessor (NDP) type + ; and hold that result in AX + + add AX,DX ; add the two results together and hold + ; 'em in AX for Ur return to the caller + + pop CX ; put things back the way that you + pop SI ; found 'em when you started this + pop DI ; little drill off..... + pop BP + ; AND + ret ; go back to where you came from.... + ; ( ===> the calling program ) + ; with Ur results sittin' in AX !! +_chips endp + + +cpu_type PROC + + pushf ; pump Ur flags register onto the stack + xor DX,DX ; blow out Ur DX and AX to start off + xor AX,AX ; with a clean slate + push AX ; put AX on the stack + popf ; bring it back in Ur flags + pushf ; try to set bits 12 thru 15 to a zero + pop AX ; get back Ur flags word in AX + and AX, 0f000h ; if bits 12 thru 15 are set then you got + cmp AX, 0f000h ; an Intel 8018x or a 808x or maybe even + jz dig ; a NEC V20/V30 ??? - gotta look more... + +; OTHERWISE.... +; Here's the BIG one.... 'tells the difference between an 80286 and +; an 80386 !! + + mov AX, 07000h ; try to set FLAG bits 12 thru 14 + ; - NT, IOPL + push AX ; put it onto the stack + popf ; and try to pump 07000H into Ur flags + pushf ; push Ur flags, again + pop AX ; and bring back AX for a compare + and AX,07000h ; if Ur bits 12 thru 14 are set + jnz got386 ; then Ur workin' with an 80386 + mov DX, 0280 ; save 280 in DX cuz it's an 80286 + jmp SHORT CPUbye ; and bail out + +got386: mov DX, 0380 ; save 380 in DX cuz it's an Intel 80386 + jmp SHORT CPUbye ; and bail out + +; here's we try to figger out whether it's an 80188/80186, an 8088/8086 +; or an NEC V20/V30 - 'couple of slick tricks from Clif Purkiser..... + +dig: mov AX, 0ffffh ; load up AX + mov CL, 33 ; HERE's the FIRST TRICK.... this will + ; shift everything 33 times if it's + ; 8088/8086, or once for a 80188/80186! + shl AX, CL ; on a shift of 33, all bits get zeroed + jz digmor ; out so if anything is left ON it's + ; gotta be an 80188/80186 + mov DX,0180 ; save 180 in DX cuz it's an 80188/80186 + jmp SHORT CPUbye ; and bail out + +digmor: xor AL,AL ; clean out AL to set ZF + mov AL,40h ; ANOTHER TRICK.... mul on an NEC duz NOT + mul AL ; effect the zero flag BUT on an Intel + jz gotNEC ; 8088/8086, the zero flag gets thrown + mov DX,0080 ; 80 into DX cuz it's an Intel 8088/8086 + jmp SHORT CPUbye ; and bail out + +gotNEC: mov DX,0200 ; it's an NEC V20/V30 so save 200 in DX + +CPUbye: popf ; putchur flags back to where they were + ret ; and go back to where you came from + ; (i.e., ===> _chips) with the CPU type + ; tucked away in DX for future reference +cpu_type endp + +; Check for an NDP. +; +; >>>>NOTE: If you are using an MASM version < 5.0, don't forget to +; use the /R option or you will bomb cuz of the coprocessor instruc- +; tions. /R is not needed for version 5.0.<<<<<<<<<<<<<<<<<<<<<<<<< + +ndp_type PROC + +do_we: fninit ; try to initialize the NDP + mov byte ptr control+1,0 ; clear memory byte + fnstcw control ; put control word in memory + mov AH,byte ptr control+1 ; iff AH is 03h, you got + cmp AH,03h ; an NDP on board !! + je chk_87 ; found somethin', keep goin' + xor AX,AX ; clean out AX to show a zero + jmp SHORT NDPbye ; return (i.e., no NDP) + +; 'got an 8087 ?? + +chk_87: and control,NOT 0080h ; turn ON interrupts (IEM = 0) + fldcw control ; load control word + fdisi ; turn OFF interrupts (IEM = 1) + fstcw control ; store control word + test control,0080h ; iff IEM=1, 8087 + jz chk287 ; 'guess not! March on.... + mov AX,0001 ; set up for a 1 return to + jmp SHORT NDPbye ; show an 8087 is on board + +; if not.... would you believe an 80287 maybe ?? + +chk287: finit ; set default infinity mode + fld1 ; make infinity + fldz ; by dividing + fdiv ; 1 by zero !! + fld st ; now make a + fchs ; negative infinity + fcompp ; compare Ur two infinities + fstsw control ; iff, for 8087 or 80287 + fwait ; sit tight 'til status word is put away + mov AX,control ; getchur control word + sahf ; putchur AH into flags + jnz got387 ; NO GOOD.... march on !! + mov AX,0002 ; gotta be a 80287 cuz we already tested + jmp SHORT NDPbye ; for an 8087 + +; We KNOW that there is an NDP on board otherwise we would have bailed +; out after 'do_we'. It isn't an 8087 or an 80287 or we wouldn't have +; gotten this far. It's gotta be an 80387 !! + +got387: mov AX,0003 ; call it an 80387 and return 3 + +NDPbye: ret ; and go back where you came from + ; (i.e., ===> _chips) carrying the NDP + ; type in Ur AX register +ndp_type endp + +_text ends + end \ No newline at end of file diff --git a/assembly/Circle.asm b/assembly/Circle.asm new file mode 100644 index 0000000..1b424d9 --- /dev/null +++ b/assembly/Circle.asm @@ -0,0 +1,83 @@ +cseg segment + assume cs:cseg, ds:cseg, ss:cseg + org 100h + .386 +start: + + mov ax, 13h + int 10h + + mov dx, 3c8h + xor al, al + out dx, al + inc dx + mov cx, 256 + xor al, al +lopp: out dx, al + out dx, al + out dx, al + inc al + dec cx + jnz lopp + + mov ax, 0a000h + mov es, ax + + + fild y_rad + fild x_rad + +loopdr: + fild angle + fsincos + + fmul st, st(2) + fistp x_co + + fmul st, st(2) + fistp y_co + + add x_co, 160 + add y_co, 100 + + xor di, di + mov ax, y_co + shl ax, 6 + add di, ax + shl ax, 2 + add di, ax + add di, x_co + + mov byte ptr es:[di], cl + inc cl + + fadd yvel + fxch st(1) + fadd xvel + fxch st(1) + + inc angle + jnz loopdr + + xor ax, ax + int 16h + + mov ax, 3 + int 10h + + int 20h + +x_co dw 0 +y_co dw 0 + +x_rad dw 10 +y_rad dw 10 + +xvel dq 0.001 +yvel dq 0.001 + +angle dw 0 + + +cseg ends + end start \ No newline at end of file diff --git a/assembly/Clock.asm b/assembly/Clock.asm new file mode 100644 index 0000000..2572f8c --- /dev/null +++ b/assembly/Clock.asm @@ -0,0 +1,137 @@ +CGROUP GROUP VECTOR,CODESEG +VECTOR SEGMENT AT 0H + DB 6CH DUP(?) ;FILLER +TIME_LO DW ? ;DOS TIME +TIME_HI DW ? ;DOS TIME +VEC_IP DW ;CLOCK UPDATE VECTOR IP +VEC_CS DW ;CLOCK UPDATE VECTOR CS +VECTOR ENDS + +CODESEG SEGMENT PARA + ASSUME CS:CODESEG,DS:CGROUP + ORG 100H +CLK PROC FAR + JMP SETUP ;ATTACH TO DOS +INTRPT LABEL DWORD +INT_IP DW 0 ;OLD UPDATE VECTOR IP +INT_CS DW 0 ;OLD UPDATE VECROR CS +TICKS DW 0 ;TICK COUNTER +SCR_OFF DB 0,0 ;SCREEN OFFSET IN BUFFER +CRT_PORT DW 0 ;SCREEN STATUS PORT +flag db 0 +TIME DB 8 DUP(':',0BH) ;TIME SAVE AREA +CLK_INT LABEL NEAR + PUSH AX ;SAVE REGISTERS + PUSH CX + PUSH DI + PUSH SI + PUSH DS + PUSH ES + PUSHF ; AND FLAGS + CALL CS:[INTRPT] ;DO OLD UPDATE INTERRUPT + MOV CX,0040H ;GET SEGMENT OF DOS TABLE + MOV DS,CX ;PUT IN DS + MOV CX,CS:TICKS ;GET TICK COUNT + INC CX ;INCREMENT IT + CMP CX,20 ;01F4H ;HAS A MINUTE GONE BY? + JB NO_MINUTE ;NO, MOVE ON + CALL UPDATE ;YES, UPDATE CLOCK AND + MOV CX,0 ; RESET TICK COUNTER +NO_MINUTE: + MOV CS:TICKS,CX ;SAVE UPDATED TICK COUNT + MOV CX,0B000H ;GET VIDEO SEGMENT + MOV ES,CX ;PUT IN ES + MOV DX,CS:CRT_PORT ;GET CRT STATUS PORT ADDR + MOV DI,WORD PTR CS:SCR_OFF ;GET SCREEN BUFFER OFFSET + LEA SI,CS:TIME ;GET DOS TIME + MOV CX,16 ;SET UP TO MOVE 10 BYTES + CLI ;DISABLE OTHER INTERRUPTS +WAIT1: IN AL,DX ;READ CRT STATUS + TEST AL,1 ;CHECK FOR VERTICAL RETRACE + JNZ WAIT1 ;WAIT FOR RETRACE LOW + MOV AH,CS:[SI] ;GET FIRST BYTE TO MOVE +WAIT2: IN AL,DX ;GET CRT STATUS + TEST AL,1 ;CHECK FOR VERTICAL RETRACE + JZ WAIT2 ;WAIT FOR RETRACE HIGH + MOV ES:[DI],AH ;MOVE BYTE TO SCREEN + INC DI ;INCREMENT INDEX + INC SI + LOOP WAIT1 ;MOVE NEXT BYTE + STI ;ENABLE INTERRUPTS + POP ES ;RESTORE REGISTERS + POP DS + POP SI + POP DI + POP CX + POP AX + IRET ;RETURN FROM INTERRUPT +CLK ENDP +UPDATE PROC NEAR + PUSH AX ;SAVE REGISTERS + PUSH BX + PUSH CX + PUSH DX + PUSH DS + MOV AX,0040H ;GET ADDRESS OF DOS TABLE + MOV DS,AX ;PUT IN DS + MOV AX,TIME_HI ;GET HIGH BYTE OF DOS TIME + mov flag,0 ;am flag +HOUR: CMP AX,0CH ;CONVERT TO HOURS + JLE H1 + mov flag,1 ;set to pm + SUB AX,0CH + JMP HOUR +H1: AAM ;CONVERT TO ASCII + ADD AX,3030H + LEA BX,CS:TIME ;GET ADDRESS OF TIME AREA + MOV CS:[BX],AH ;SAVE HOURS FIRST DIGIT + MOV CS:[BX+2],AL ;SAVE HOURS SECOND DIGIT + MOV AX,TIME_LO ;GET DOS TIME LOW BYTE + MOV CX,8H ;CONVERT TO MINUTES + SHR AX,CL + MOV DX,3CH + MUL DL + SHR AX,CL + AAM ;CONVERT TO ASCII + ADD AX,3030H + MOV CS:[BX+6],AH ;SAVE MINUTES FIRST DIGIT + MOV CS:[BX+8],AL ;SAVE MINUTES SECOND DIGIT + mov byte ptr cs:[bx+12],'a' + cmp flag,0 ;is it am? + jz goahead + mov byte ptr cs:[bx+12],'p' +goahead: + mov byte ptr cs:[bx+14],'m' + POP DS ;RESTORE REGISTERS + POP DX + POP CX + POP BX + POP AX + RET +UPDATE ENDP +SETUP: MOV AX,0 ;GET ADDRESS OF VECTOR TABLE + MOV DS,AX ;PUT IN DS + CLI ;DISABLE FURTHER INTERRUPTS + MOV AX,[VEC_IP] ;GET ADDRESS OF OLD UPDATE IP + MOV CS:[INT_IP],AX ;SAVE IT + MOV AX,[VEC_CS] ;GET ADDRESS OF OLD UPDATE CS + MOV CS:[INT_CS],AX ;SAVE IT + MOV VEC_IP,OFFSET CLK_INT ;PUT ADDRESS OF CLK IN VECTOR IP + MOV VEC_CS,CS ;PUT CS OF CLK IN VECTOR CS + STI ;ENABLE INTERRUPTS + MOV AH,0FH ;READ VIDEO STATUS + INT 10H + SUB AH,8 ;SUBTRACT 8 CHAR TIME FROM NCOLS + SHL AH,1 ;MULTIPLY BY 2 FOR ATTRIBUTE + MOV CS:SCR_OFF,AH ;SAVE SCREEN TIME LOCATION + MOV WORD PTR CS:CRT_PORT,03BAH ;SAVE MONO STATUS PORT ADDR + TEST AL,4 ;CHECK FOR COLOR MONITOR + JNZ MONO ;IF MONO, MOVE ON + ADD WORD PTR CS:SCR_OFF,8000H ;ADD COLOR OFFSET TO TIME OFFSET + MOV WORD PTR CS:CRT_PORT,03DAH ;SAVE COLOR STATUS PORT ADDR +MONO: CALL UPDATE ;DO FIRST UPDATE & PRINT TIME + MOV DX,OFFSET SETUP ;GET END ADDRESS OF NEW INTERRUPT + INT 27H ;TERMINATE AND REMAIN RESIDENT + DB 117 DUP(0) ;FILLER +CODESEG ENDS + END CLK \ No newline at end of file diff --git a/assembly/Colours routine.asm b/assembly/Colours routine.asm new file mode 100644 index 0000000..50e5652 --- /dev/null +++ b/assembly/Colours routine.asm @@ -0,0 +1,109 @@ +; for tasm +; +cseg segment +assume cs:cseg, ds:cseg +org 100H +begin: + mov es,cs:[video] + + mov ax,3 + int 10h + mov cs:[col],0fh + mov di,18 + lea si,colr2 + call mess + + mov cx,16 + mov di,160 + xor al,al +rec1: + push cx + + push di + lea si,colour + call mess + call hex2 + + mov bh,al + push cx + mov cx,16 +col2: + mov es:[di],byte ptr "#" + mov es:[di+1],bh + inc bh + add di,2 + + loop col2 + pop cx + + + pop di + add di,160 + add al,10h + + add cs:[col],10h + pop cx + loop rec1 + + + mov ah,2 + mov bh,0 + mov dh,17 + mov dl,0 + int 10h + + + mov ah,4ch + int 21h + +col db 0 +colour db "Colour ",0 +colr2 db "0123456789ABCDEF",0 +colnum db 0 + +video dw 0b800h + +hex2 proc near + push ax + and al,011110000b + shr al,4 + call hex1 + pop ax + push ax + and al,01111b + call hex1 + pop ax + ret +hex2 endp +hex1 proc near + mov ah,cs:[col] + cmp al,10 + jb hnum1 + add al,'A'-10 + jmp hnum2 +hnum1: + add al,'0' +hnum2: + mov es:[di],ax + add di,2 + ret +hex1 endp +mess proc + push ax + mov ah,cs:[col] +conmess: + mov al,cs:[si] + or al,al + jz endmess + mov es:[di],ax + inc si + add di,2 + jmp conmess +endmess: + pop ax + ret +mess endp + + +cseg ends +end begin \ No newline at end of file diff --git a/assembly/Command line program allows piping of output from other programs into Windows clipboard.asm b/assembly/Command line program allows piping of output from other programs into Windows clipboard.asm new file mode 100644 index 0000000..869e40a --- /dev/null +++ b/assembly/Command line program allows piping of output from other programs into Windows clipboard.asm @@ -0,0 +1,132 @@ +; toclip.asm +; +; This code may be assembled and linked using Borland's TASM: +; tasm /la /m2 toclip +; tlink /Tdc toclip +; +; It also works with Microsoft's MASM: +; ml /Fl toclip.asm +; +STDIN equ 00h ; handle of standard input device +STDOUT equ 01h ; handle of standard output device +STDERR equ 02h ; handle of standard error device + +DOS_READ_HANDLE equ 03fh ; read from handle +DOS_WRITE_HANDLE equ 040h ; write to handle +DOS_ALLOC_MEM equ 048h ; allocate memory block +DOS_RESIZE_MEM equ 04ah ; resize memory block +DOS_TERMINATE equ 04ch ; terminate with error code + +WIN_VERSION equ 01700h ; identify WinOldAp version +WIN_OPEN_CLIP equ 01701h ; open clipboard +WIN_EMPTY_CLIP equ 01702h ; empty clipboard +WIN_SET_CLIP equ 01703h ; set clipboard data +WIN_CLOSE_CLIP equ 01708h ; close clipboard + +; clipboard formats: +CLIP_FMT_TXT equ 01h ; text format +CLIP_FMT_BMP equ 02h ; bitmap format +CLIP_FMT_TIFF equ 06h ; TIFF +CLIP_FMT_OEMTXT equ 07h ; OEM text + + +WININT macro function + mov ax,(function) + int 2fh +endm + +DOSINT macro function, subfunction + IFB + mov ah,(function AND 0ffh) + ELSE + mov ax,(function SHL 8) OR (subfunction AND 0ffh) + ENDIF + int 21h ; invoke DOS function +endm + +ERRMSG macro tag, message + LOCAL nextmsg +tag db nextmsg-$ + db message +nextmsg = $ +endm + + .model small + .386 + .stack 100h + .data +ERRMSG cantresize, <"ERROR: can't resize memory",0dh,0ah> +ERRMSG noclipboard,<"ERROR: no clipboard",0dh,0ah> +ERRMSG emptyclip, <"ERROR: cannot empty clipboard",0dh,0ah> +ERRMSG openclip, <"ERROR: cannot open clipboard",0dh,0ah> +ERRMSG allocerror, <"ERROR: can't allocate 64K buffer",0dh,0ah> +ERRMSG readerr, <"ERROR: can't read data from stdin",0dh, 0ah> +ERRMSG pasteerr, <"ERROR: can't paste data to clipboard",0dh,0ah> + + .code +start proc + mov bx,ss ; stack segment + mov ax,ds ; - data segment + sub bx,ax ; = size of all but stack + add bx,10h ; add in stack size (in paragraphs) + DOSINT DOS_RESIZE_MEM ; + mov di,offset cantresize + jc error + WININT WIN_VERSION + cmp ax,WIN_VERSION + mov di,offset noclipboard + jz error ; + + WININT WIN_OPEN_CLIP ; open clipboard + or ax,ax ; nonzero status means error + mov di,offset openclip + jz error ; + + WININT WIN_EMPTY_CLIP ; empty clipboard + or ax,ax ; nonzero status means error + mov di,offset emptyclip + jz error ; + + ; allocate a big buffer + mov bx,1000h ; 1000h paragraphs = 64K + DOSINT DOS_ALLOC_MEM ; + mov di,offset allocerror + jc error ; + + + mov ds,ax ; + mov es,ax ; + ; read from the input file + mov bx,STDIN ; stdin + mov cx,0ffffh ; read a whole bunch of data +; ds:dx ==> data buffer + xor dx,dx ; + DOSINT DOS_READ_HANDLE ; + mov di,offset readerr + jc error ; + xor si,si ; + mov cx,ax ; size + + ; paste the file buffer into the clipboard +; mov es:bx ==> data + xor bx,bx +; mov si:cx, size of data + mov dx,CLIP_FMT_TXT ; text data + WININT WIN_SET_CLIP ; + or ax,ax + mov di,offset pasteerr ; + jz error ; + WININT WIN_CLOSE_CLIP ; close clipboard + DOSINT DOS_TERMINATE,0 ; exit with error code = 0 +error: + mov bx,@data ; + mov ds,bx ; + xor cx,cx ; + mov cl,byte ptr[di] ; fetch length + mov dx,di ; point to data + inc dx ; advance beyond length + mov bx,STDERR ; write to stderr + DOSINT DOS_WRITE_HANDLE ; write to handle + DOSINT DOS_TERMINATE,1 ; error exit +start endp + END start \ No newline at end of file diff --git a/assembly/Control-Break handler for Lattice C programs.asm b/assembly/Control-Break handler for Lattice C programs.asm new file mode 100644 index 0000000..c9481f7 --- /dev/null +++ b/assembly/Control-Break handler for Lattice C programs.asm @@ -0,0 +1,168 @@ + title Control-Break handler for Lattice C programs + name break + include dos.mac + +; Control-Break Interrupt Handler for Lattice C programs +; running on IBM PCs (and ROM BIOS compatibles) +; +; This module allows C programs running on the IBM PC +; to retain control when the user enters a Control-Break +; or Control-C. This is accomplished by taking over the +; Int 23H (MS-DOS Control-Break) and Int 1BH (IBM PC +; ROM BIOS Keyboard Driver Control-Break) interrupt +; vectors. The interrupt handler sets an internal +; flag (which must be declared STATIC INT) to TRUE within +; the C program; the C program can poll or ignore this +; flag as it wishes. +; +; The module follows the Lattice C parameter passing +; conventions, and also relies on the Lattice file DOS.MAC +; for the definition of certain constants and macros. +; +; The Int 23H Control-Break handler is a function of MS-DOS +; and is present on all MS-DOS machines, however, the Int 1BH +; handler is a function of the IBM PC ROM BIOS and will not +; necessarily be present on other machines. +; + if lprog +args equ 6 ;offset of arguments, Large models + else +args equ 4 ;offset of arguments, Small models + endif + +cr equ 0dh ;ASCII carriage return +lf equ 0ah ;ASCII line feed + + pseg + + public capture,release ;function names for C + + +; +; The function CAPTURE is called by the C program to +; take over the MS-DOS and keyboard driver Control- +; Break interrupts (1BH and 23H). It is passed the +; address of a flag within the C program which is set +; to TRUE whenever a Control-Break or Control-C +; is detected. The function is used in the form: +; +; static int flag; +; capture(&flag) +; + +capture proc near ;take over Control-Break + + push bp ;interrupt vectors + mov bp,sp + push ds + + mov ax,word ptr [bp+args] + mov cs:flag,ax ;save address of integer + mov cs:flag+2,ds ;flag variable in C program + + ;pick up original vector contents + mov ax,3523h ;for interrupt 23H (MS-DOS + int 21h ;Control-Break handler) + mov cs:int23,bx + mov cs:int23+2,es + + mov ax,351bh ;and interrupt 1BH + int 21h ;(IBM PC ROM BIOS keyboard driver + mov cs:int1b,bx ;Control-Break interrupt handler) + mov cs:int1b+2,es + + push cs ;set address of new handler + pop ds + mov dx,offset ctrlbrk + mov ax,02523H ;for interrupt 23H + int 21h + mov ax,0251bH ;and interrupt 1BH + int 21h + + pop ds ;restore registers and + pop bp ;return to C program + ret + +capture endp + + +; +; The function RELEASE is called by the C program to +; return the MS-DOS and keyboard driver Control-Break +; interrupt vectors to their original state. Int 23h is +; also automatically restored by MS-DOS upon the termination +; of a process, however, calling RELEASE allows the C +; program to restore the default action of a Control-C +; without terminating. The function is used in the form: +; +; release() +; + +release proc near ;restore Control-Break interrupt + ;vectors to their original state + push bp + mov bp,sp + push ds + + mov dx,cs:int1b ;set interrupt 1BH + mov ds,cs:int1b+2 ;(MS-DOS Control-Break + mov ax,251bh ;interrupt handler) + int 21h + + mov dx,cs:int23 ;set interrupt 23H + mov ds,cs:int23+2 ;(IBM PC ROM BIOS keyboard driver + mov ax,2523h ;Control-Break interrupt handler) + int 21h + + pop ds ;restore registers and + pop bp ;return to C program + ret + +release endp + + +; +; This is the actual interrupt handler which is called by +; the ROM BIOS keyboard driver or by MS-DOS when a Control-C +; or Control-Break is detected. Since the interrupt handler +; may be called asynchronously by the keyboard driver, it +; is severely restricted in what it may do without crashing +; the system (e.g. no calls on DOS allowed). In this +; version, it simply sets a flag within the C program to +; TRUE to indicate that a Control-C or Control-Break has +; been detected; the address of this flag was passed +; by the C program during the call to the CAPTURE function. +; + +ctrlbrk proc far ;Control-Break interrupt handler + + push bx ;save affected registers + push ds + + mov bx,cs:flag ;set flag within C program + mov ds,cs:flag+2 ;to "True" + mov word ptr ds:[bx],-1 + + pop ds ;restore registers and exit + pop bx + + iret + +ctrlbrk endp + + +flag dw 0,0 ;long address of C program's + ;Control-Break detected flag + +int23 dw 0,0 ;original contents of MS-DOS + ;Control-Break Interrupt 23H + ;vector + +int1b dw 0,0 ;original contents of ROM BIOS + ;keyboard driver Control-Break + ;Interrupt 1BH vector + + + endps + + end \ No newline at end of file diff --git a/assembly/Demo showing how to use 'flat real mode'.asm b/assembly/Demo showing how to use 'flat real mode'.asm new file mode 100644 index 0000000..d7824b3 --- /dev/null +++ b/assembly/Demo showing how to use 'flat real mode'.asm @@ -0,0 +1,44 @@ +; test1.asm +; +; This program uses flat real mode to read the contents of arbitrary +; memory locations to the screen. It assumes that flat real mode (4G +; limit) is already in place for the FS segment. +; +; This code is intended to be run on a Pentium or better. +; +; To assemble: +; +; using Microsoft's MASM 6.11 or better +; ml /Fl flatmode.asm +; +; or Borland's TASM version 4.0 or better +; tasm /la /m2 flatmode.asm +; tlink /Tdc flatmode +; +;---------------------------------------------------------------------- + .model tiny + .code + .586P + +;---------------------------------------------------------------------- + ORG 100h +start: + call fillscreen ; fill the screen using 4G descriptor + mov ax,4c00h ; do a standard DOS exit + int 21h ; +;---------------------------------------------------------------------- +fillscreen proc + mov esi,0FFFFFF70h ; point to ROM + mov edi,0B8000h ; point to screen + mov cx,160 ; just two lines + mov ah,1Eh ; yellow on blue screen attrib +myloop: + mov al,fs:[esi] ; read ROM byte + mov fs:[edi],ax ; store to screen with attribute + inc esi ; increment source ptr + inc edi ; increment dest ptr by two + inc edi ; + loop myloop ; keep going + ret ; and quit +fillscreen endp +end start \ No newline at end of file diff --git a/assembly/Determines the type of UART in each serial port.asm b/assembly/Determines the type of UART in each serial port.asm new file mode 100644 index 0000000..e84e8b8 --- /dev/null +++ b/assembly/Determines the type of UART in each serial port.asm @@ -0,0 +1,221 @@ +comment * + SERTYPE.ASM + Purpose: + Determines the type of UART in each serial port + +* + +dosseg + +bdseg segment at 40h ;bios data segment + com1 dw ? + com2 dw ? + com3 dw ? + com4 dw ? + ends + +_data segment para 'data' + uart1 db 0 + uart2 db 0 + uart3 db 0 + uart4 db 0 + portmsg db "COMx: $" + x8250 db "NS 8250 (non-FIFO)",13,10,"$" + x16450 db "NS 8250A/16450/16550 (non-FIFO)",13,10,"$" + xfifo db "NS 16550A/Intel 82510 (FIFO)",13,10,"$" + xdma db "IBM type 3 (FIFO/DMA)",13,10,"$" + pas_de_ports db "No serial ports detected",13,10,"$" + ends + +_stack segment para stack 'stack' + db 200h dup (?) + ends + +cseg segment para 'code' + mov ax, bdseg + mov es, ax ;ES := Bdseg + mov ax, _data + mov ds, ax ;DS := _data + assume cs:cseg, ds:_data, es:bdseg, ss:_stack + xor al, al ;# of serial ports = 0 + mov dx, [com1] + cmp dx, 0 + je eoproc + inc al ;# of serial ports = 1 + push ax + call uartdet + mov [uart1], al ;remember the type of this UART + pop ax + mov dx, [com2] + cmp dx, 0 + je eoproc + inc al ;# of serial ports = 2 + push ax + call uartdet + mov [uart2], al + pop ax + mov dx, [com3] + cmp dx, 0 + je eoproc + inc al ;# of serial ports = 3 + push ax + call uartdet + mov [uart3], al + pop ax + mov dx, [com4] + cmp dx, 0 + je eoproc + inc al ;# of serial ports = 4 + push ax + call uartdet + mov [uart4], al + pop ax + +eoproc: + call disp + mov ah, 4ch + int 21h + +delay macro + jmp $+2 + endm + +uartdet proc near + push bx + push cx + mov bx, dx ;save starting i/o addr + add dx, 4 ;point to modem ctrl reg + in al, dx ;disable interrupts + push ax + and al, 11111011b + out dx, al + mov ch, 0 ;assume type 0 + mov dx, bx + add dx, 7 ;see if scratch reg exists + mov al, 55h + cli + out dx, al ;write to scratch reg + delay + in al, dx ;read back + cmp al, 55h + jne endudet + mov al, 0AAh + out dx, al ;write to scratch reg + delay + in al, dx ;read back + sti + cmp al, 0AAh + jne endudet + inc ch ;assume type 1 + mov dx, bx + add dx, 2 ;point to FIFO ctrl reg + mov al, 7 ;attempt to enable FIFOs + cli + out dx, al + delay + in al, dx ;read interrupt ID reg + sti + and al, 0c0h ;strip all but FIFO bits + jz endudet ;if bits 0, 16450/16550 + inc ch ;assume type 2 + mov dx, bx + add dx, 8003h ;point to enhanced reg 1 + cli + in al, dx + push ax + or al, 01000000b ;enable DMA transmission + out dx, al + push dx + mov dx, bx + add dx, 2 + in al, dx + mov cl, al + pop dx ;restore enhanced reg 1 + pop ax + out dx, al + sti + and cl, 0c0h ;again mask all but FIFO ID + cmp cl, 40h + jne endudet ;must be type 2 (FIFO) + inc ch ;must be type 3 (DMA) + +endudet: + pop ax + mov dx, bx + add dx, 4 ;point to modem ctrl reg + out dx, al ;restore initial condition + xor ax, ax + mov al, ch + mov dx, bx + pop cx + pop bx + ret +uartdet endp + +disp proc near + push ax ;save AX + cmp al, 0 ;no serial ports? + je noports + mov bx, offset ds:[uart1] ;offset of UART type field + mov di, offset ds:[portmsg][3] ;offset of 4th char in message + mov cx, 0 + mov cl, al ;number of iterations + +@l1: + ; + ;write "COMx: " message substituting "x" for proper comport # + ; + mov dl, 4 + sub dl, cl + add dl, 30h ;convert to ASCII number + mov [di], dl + lea dx, portmsg + mov ah, 9 + int 21h + ; + ;write the UART type now + ; + mov dl, [bx] + cmp dl, 0 + jne @t2 + lea dx, x8250 + mov ah, 9 + int 21h + jmp @eot + +@t2: cmp dl, 1 + jne @t3 + lea dx, x16450 + mov ah, 9 + int 21h + jmp @eot + +@t3: cmp dl, 2 + jne @t4 + lea dx, xfifo + mov ah, 9 + int 21h + jmp @eot + +@t4: lea dx, xdma + mov ah, 9 + int 21h + +@eot: inc bx + loop @l1 + jmp eoproc2 + +noports: + lea dx, pas_de_ports + mov ah, 9 + int 21h + +eoproc2: + pop ax + ret +disp endp + + ends + end + +; EOF SERTYPE.ASM \ No newline at end of file diff --git a/assembly/Device Driver Header.asm b/assembly/Device Driver Header.asm new file mode 100644 index 0000000..5b1ac2a --- /dev/null +++ b/assembly/Device Driver Header.asm @@ -0,0 +1,233 @@ +;-----------------------------------------------------------------------| +; +; Device Driver Library +; Device Driver Header +; +;-----------------------------------------------------------------------| + PAGE +;-----------------------------------------------------------------------| +; Equates +;-----------------------------------------------------------------------| + +StkSiz EQU 2048 ; local stack size + + PAGE +;-----------------------------------------------------------------------| +; Group Selection +;-----------------------------------------------------------------------| + +PGROUP Group PROG, TAIL +DGROUP Group DATA, DTAIL + +PROG Segment Para Public 'PROG' +PROG EndS + +DATA Segment Para Public 'DATA' ; define first +DATA EndS + + Assume CS:PROG, DS:DATA, ES:DATA, SS:DATA + + PAGE +;-----------------------------------------------------------------------| +; Program Segment +;-----------------------------------------------------------------------| + +PROG Segment Para Public 'PROG' + + Extrn Init:Near, MediaChe:Near, BuildBPB:Near + Extrn IoCtlIn:Near, Input:Near, ndInput:Near + Extrn InputSta:Near, InputFlu:Near, Output:Near + Extrn OutVerif:Near, OutStatu:Near, OutFlush:Near + Extrn IoCtlOut:Near, DevOpen:Near, DevClose:Near + Extrn RemMedia:Near + + ORG 0 + +HDR Proc Far + +;-----------------------------------------------------------------------| +; Device Header +;-----------------------------------------------------------------------| + + DD -1 ; -> next device +; DW theAttribute ; you must enter attribute field + DW 8000H ; character only device + DW Strategy ; -> device strategy + DW Interrupt ; -> device interrupt +; DB theName ; you must put something here + DB "MON " ; mono + +;-----------------------------------------------------------------------| +; Code Segment Variables +;-----------------------------------------------------------------------| + +RHptr DD (?) ; -> Request Header +ssEntry DW (?) ; entry SS +spEntry DW (?) ; entry SP + + PAGE +;-----------------------------------------------------------------------| +; Device Strategy +; +; ENTRY : ES:BX -> Request Header +; +; EXIT : Request Header copied to ReqHdr +; all registers preserved +; +;-----------------------------------------------------------------------| + +Strategy: + + MOV Word Ptr CS:RHptr,BX ; save request header ptr + MOV Word Ptr CS:RHptr + 2,ES + + PUSHF ; (+1) save the world + PUSH ES ; (+2) + PUSH DS ; (+3) + PUSH SI ; (+4) + PUSH DI ; (+5) + PUSH CX ; (+6) + PUSH BX ; (+7) + + MOV SI,BX + MOV BX,ES + MOV DS,BX ; DS:SI -> Request Header + + MOV BX,Offset PGROUP:TAIL + MOV CL,4 + SHR BX,CL + MOV CX,CS + ADD BX,CX + MOV ES,BX + MOV DI,Offset DGROUP:ReqHdr ; ES:DI -> ReqHdr + + CLD + XOR CH,CH + MOV CL,[SI] + REP MOVSB ; copy Request Header + + POP BX ; (+6) restore + POP CX ; (+5) + POP DI ; (+4) + POP SI ; (+3) + POP DS ; (+2) + POP ES ; (+1) + POPF ; (+0) + RET + + PAGE +;-----------------------------------------------------------------------| +; Device Interrupt +; +; ENTRY : anything +; +; EXIT : all registers preserved +; +;-----------------------------------------------------------------------| + +Interrupt: + + PUSH DS ; (+1) save the world + PUSH ES ; (+2) + PUSH AX ; (+3) + PUSH BX ; (+4) + PUSH CX ; (+5) + PUSH DX ; (+6) + PUSH SI ; (+7) + PUSH DI ; (+8) + PUSH BP ; (+9) + + MOV CS:ssEntry,SS ; save entry SS + MOV CS:spEntry,SP ; and SP + + MOV AX,Offset PGROUP:TAIL ; set our DS, SS, BP, and SP + MOV CL,4 + SHR AX,CL + MOV CX,CS + ADD AX,CX + MOV BX,Offset DGROUP:MyStack + MOV DS,AX + MOV ES,AX + MOV SS,AX + MOV SP,BX + MOV BP,BX + + ; + ; call our function + ; + MOV AL,ReqHdr + 2 ; AL = Command Code + SHL AL,1 + CBW + MOV SI,Offset DGROUP:FuncTab + ADD SI,AX + CALL Word Ptr [SI] + + ; + ; copy back Request Header + ; + LES DI,RHptr ; ES:DI -> original space + MOV SI,Offset DGROUP:ReqHdr ; DS:SI -> our (updated) copy + CLD + XOR CH,CH + MOV CL,[SI] + REP MOVSB ; copy Request Header + + MOV SS,CS:ssEntry ; restore original stuff + MOV SP,CS:spEntry + + POP BP ; (+8) restore + POP DI ; (+7) + POP SI ; (+6) + POP DX ; (+5) + POP CX ; (+4) + POP BX ; (+3) + POP AX ; (+2) + POP ES ; (+1) + POP DS ; (+0) + RET + +HDR EndP + +PROG EndS + +TAIL Segment Public 'PROG' ; for finding end of code segment +TAIL EndS + + PAGE +;-----------------------------------------------------------------------| +; Data Segment +;-----------------------------------------------------------------------| + +DATA Segment Para Public 'DATA' + + Public ReqHdr + + DB StkSiz DUP (?) ; our stack, overflows into code +MyStack Label Word + +FuncTab Label Word + DW Offset PGROUP:Init + DW Offset PGROUP:MediaChe + DW Offset PGROUP:BuildBPB + DW Offset PGROUP:IoCtlIn + DW Offset PGROUP:Input + DW Offset PGROUP:ndInput + DW Offset PGROUP:InputSta + DW Offset PGROUP:InputFlu + DW Offset PGROUP:Output + DW Offset PGROUP:OutVerif + DW Offset PGROUP:OutStatu + DW Offset PGROUP:OutFlush + DW Offset PGROUP:IoCtlOut + DW Offset PGROUP:DevOpen + DW Offset PGROUP:DevClose + DW Offset PGROUP:RemMedia + +ReqHdr DB 256 DUP (?) ; copy of Request Header + +DATA EndS + +DTAIL Segment Public 'DATA' ; for finding end of data segment +DTAIL EndS + + END HDR ; of HDR.ASM diff --git a/assembly/Disables the cache on a 486 and Pentium processor.asm b/assembly/Disables the cache on a 486 and Pentium processor.asm new file mode 100644 index 0000000..740a3d8 --- /dev/null +++ b/assembly/Disables the cache on a 486 and Pentium processor.asm @@ -0,0 +1,41 @@ +; cache disable routine +; + public DisableCache + +code segment ; simple but effective for demonstration purposes +;* DisableCache() * +;* * +;* This routine disables cache(s) on a 486 or Pentium processor * +;* * +;* NOTE: due to the protection schemes incorporated into the 486 and * +;* Pentium processors, it will NOT work in virtual 8086 mode. * +;* * +;* written on Thursday, 2 November 1995 by Ed Beroset * +;* and released to the public domain by the author * + + .486P + +CR0_CD equ 040000000h ; Cache Disable bit of CR0 +CR0_NW equ 020000000h ; Not Write-through bit of CR0 + +DisableCache proc + pushf ; save the flags + push eax ; save eax + cli ; disable interrupts while we do this + mov eax,cr0 ; read CR0 + or eax,CR0_CD ; set CD but not NW bit of CR0 + mov cr0,eax ; cache is now disabled + wbinvd ; flush and invalidate cache + + ; the cache is effectively disabled at this point, but memory + ; consistency will be maintained. To completely disable cache, + ; the following two lines may used as well: + + or eax,CR0_NW ; now set the NW bit + mov cr0,eax ; turn off the cache entirely + pop eax ; restore eax + popf ; restore the flags + ret ; return to caller +DisableCache endp +code ends + end \ No newline at end of file diff --git a/assembly/Disk Watch.asm b/assembly/Disk Watch.asm new file mode 100644 index 0000000..c35f927 --- /dev/null +++ b/assembly/Disk Watch.asm @@ -0,0 +1,106 @@ +interrupts segment at 0h ; This is where the disk interrupt + org 13h*4 ; holds the address of its service routine +disk_int label dword +interrupts ends + +screen segment at 0B000h ; A dummy segment to use as the Extra +screen ends ; Segment so we can write to the display + +code_seg segment + assume cs:code_seg + org 0100h ; ORG = 100h to make this a .COM file +first: jmp load_watch ; First time through jump to initialize routine + + msg_part_1 db 'Disk error: ' ; Here are the error messages + msg_part_2 db 'No response Failed Seek NEC Error ' + db 'Bad CRC SeenDMA Overrun Impos Sector' + db 'No Addr MarkW. ProtectedErr Unknown ' + first_position dw ? ; Position of 1st char on screen + flags dw ? + screen_seg_offset dw 0 ; 0 for mono, 8000h for graphics + old_disk_int dd ? ; Location of old disk interrupt + ret_addr label dword ; Used in fooling around with + ret_addr_word dw 2 dup(?) ; the stack + +disk_watch proc far ; The disk interrupt will now come here + assume cs:code_seg + pushf ; First, call old disk interrupt + call old_disk_int + pushf ; Save the flags in memory location "FLAGS" + pop flags ; (cunning name) + jc error ; If there was an error, carry flag will have + jmp fin ; been set by Disk Interrupt +error: push ax ; AH has the status of the error + push cx ; Push all used registers for politeness + push dx + push di + push si + push es + lea si,msg_part_1 ; Always print "Disk Error: " part. + assume es:screen ; Use screen as extra segment + mov dx,screen + mov es,dx + mov di,screen_seg_offset ; DI will be pointer to screen position + add di,first_position ; Add to point to desired area on screen + call write_to_screen ; This writes 12 chars from [SI] to [DI] + mov dx,80h ; Initialize for later comparisons + mov cx,7 ; Loop seven times +e_loop: cmp ah,dh ; Are error code and DH the same? + je e_found ; If yes, Error has been found + add si,12 ; Point to next error message + shr dh,1 ; Divide DH by 2 + loop e_loop ; Keep going until matched DH = 0 + cmp ah,3 ; Error code no even number; 3 perhaps? + je e_found ; If yes, have found the error + add si,12 ; Err unknown; unknown error returned +e_found:call write_to_screen ; Write the error message to the screen + pop es ; Restore the registers + pop si + pop di + pop dx + pop cx + pop ax +fin: pop ret_addr_word ; Fooling with the stack. We want to + pop ret_addr_word[2] ; preserve the flags but the old flags + add sp,2 ; are still on the stack. First remove + push flags ; return address, then flags. Fill flags + popf ; from "FLAGS", return to correct addr. + jmp ret_addr +disk_watch endp + +write_to_screen proc near ; Puts 12 characters on screen + mov cx,12 ; Loop 12 times +w_loop: movs es:byte ptr[di],cs:[si] ; Move to the screen + mov al,7 ; Move screen attribute into screen buffer + mov es:[di],al + inc di ; Point to next byte in screen buffer + loop w_loop ; Keep going until done + ret +write_to_screen endp + +load_watch proc near ; This procedure initializes everything + assume ds:interrupts ; The data segment will be the interrupt area + mov ax,interrupts + mov ds,ax + + mov ax,disk_int ; Get the old interrupt service routine + mov old_disk_int,ax ; address and put it into our location + mov ax,disk_int[2] ; OLD_DISK_INT so we can call it. + mov old_disk_int[2],ax + + mov disk_int,offset disk_watch ; Now load the address of DskWatch + mov disk_int[2],cs ; routine into the disk interrupt + + mov ah,15 ; Ask for service 15 of INT 10h + int 10h ; This tells us how display is set up + sub ah,25 ; Move to twenty five places before edge + shl ah,1 ; Mult. by two (char & attribute bytes) + mov byte ptr first_position,ah ; Set screen cursor + test al,4 ; Is it a monochrome display? + jnz exit ; Yes - jump out + mov screen_seg_offset,8000h ; No, set up for graphics display +exit: mov dx,offset load_watch ; Set up everything but this program to + int 27h ; stay and attach itself to DOS +load_watch endp + code_seg ends + end first ; END "FIRST" so 8088 will go to FIRST first. \ No newline at end of file diff --git a/assembly/Drives Exist.asm b/assembly/Drives Exist.asm new file mode 100644 index 0000000..c79942a --- /dev/null +++ b/assembly/Drives Exist.asm @@ -0,0 +1,130 @@ +; Goes through drives A-Z and determines if they: +; 1) Exist +; 2) Are removable or fixed +; 3) Are local, remote, or shared +; 4) Are a floppy, hard, RAM, subst, or CD-ROM drive +; +; Callable from C as: void Drives_Exist(void); + +.model small +.286 + +DRIVEEXIST EQU 1 + +REMOVEDRV EQU 0 +FIXEDDRV EQU 1 + +LOCALDRV EQU 0 +REMOTEDRV EQU 1 +SHAREDRV EQU 2 + +FLOPPY EQU 0 +HARD EQU 1 +RAM EQU 2 +SUBST EQU 3 +CDROM EQU 4 + +.data +PUBLIC _drives + _drives db 26 dup(0,1,0,1) + ; default to not exist, fixed, local, hard drive + +.code + + PUBLIC _Drives_Exist +_Drives_Exist PROC NEAR + pusha + push es + + mov ah,19h + int 21h ; get start drive + push ax ; save start drive + + mov ax,40h + mov es,ax + mov bh,es:[10h] ; 40:10h is # of floppies-1 + shr bh,6 + inc bh ; # of actual floppy drives + mov bl,1 + mov di,offset _drives +nextchkfloppy: mov ax,4409h ; check if drive exists + int 21h + jc nextsetfloppy + test dh,10000000b ; check if SUBST drive + jz chkfloppy + dec bh ; dec actual drive count + mov byte ptr [di+3],SUBST +setfloppyexist: mov byte ptr [di],DRIVEEXIST + jmp nextsetfloppy +chkfloppy: dec bh ; dec actual drive count + js nextsetfloppy + mov byte ptr [di+1],REMOVEDRV + mov byte ptr [di+3],FLOPPY + jmp setfloppyexist +nextsetfloppy: add di,4 + inc bl + cmp bl,2 ; if B then jump back + je nextchkfloppy + + mov ch,24 ; loop 24 times (drives C - Z) + mov cl,3 ; start at C: +drivechkloop: mov ax,4409h ; check if drive exists + mov bl,cl ; set drive letter + int 21h ; 0 = default, 1 = A:, etc. + jc nextsetdrv + mov byte ptr [di],DRIVEEXIST + mov ax,4408h ; check if removable + int 21h + mov byte ptr [di+1],al ; set REMOVABLE or FIXED + mov bx,dx + mov dl,dh + shr dl,7 + and dh,00010000b + shr dh,4 + mov byte ptr [di+2],dh ; set REMOTE or LOCAL + or dl,dl ; if not SUBST, then jump + jz chkremote + mov byte ptr [di+3],SUBST + jmp nextsetdrv + +chkremote: cmp dh,REMOTEDRV ; if REMOTE, then check for CD ROM + je chkcdrom + + test bh,00000010b ; sharable? + jz drivenoshare + mov byte ptr [di+2],SHAREDRV +drivenoshare: test bl,00000010b ; RAM drive? + jnz nextsetdrv + mov byte ptr [di+3],RAM + jmp nextsetdrv + +chkcdrom: push cx + mov ax,1500h + xor bx,bx + int 2fh + pop cx + or bx,bx ; MSCDEX driver found? + jz nextsetdrv ; if not, jump to next drive setup + mov ax,150bh + dec cl ; 0=A:, etc. + int 2fh + inc cl + or ax,ax + jz nextsetdrv ; drive supported by MSCDEX? + mov byte ptr [di+3],CDROM + +nextsetdrv: add di,4 + inc cl + dec ch + jnz drivechkloop + + pop dx + mov ah,0eh + int 21h ; reset start drive + + pop es + popa + ret +_Drives_Exist ENDP + + END \ No newline at end of file diff --git a/assembly/Drives.asm b/assembly/Drives.asm new file mode 100644 index 0000000..55927f3 --- /dev/null +++ b/assembly/Drives.asm @@ -0,0 +1,161 @@ +; Goes thru drives A-Z and determines if they: +; 1) Exist +; 2) Are removable or fixed +; 3) Are local, remote, or shared +; 4) Are a floppy, hard, RAM, subst, or CD-ROM drive + +.model tiny +.286 + +DRIVEXISTS EQU 1 + +REMOVEDRV EQU 0 +FIXEDDRV EQU 1 + +LOCALDRV EQU 0 +REMOTEDRV EQU 1 +SHAREDRV EQU 2 + +FLOPPY EQU 0 +HARD EQU 1 +RAM EQU 2 +SUBST EQU 3 +CDROM EQU 4 + +.code + org 100h + +start: mov ah,19h + int 21h ; get start drive + mov [curdrive],al + + mov ax,40h + mov es,ax + mov bh,es:[10h] ; 40:10h is # of floppies-1 + shr bh,6 + inc bh ; # of actual floppy drives + mov bl,1 + mov di,offset drives +nextchkfloppy: mov ax,4409h ; check if drive exists + int 21h + jc nextsetfloppy + test dh,10000000b ; check if SUBST drive + jz chkfloppy + dec bh ; dec actual drive count + mov byte ptr [di+3],SUBST +setfloppyexist: mov byte ptr [di],DRIVEXISTS + jmp nextsetfloppy +chkfloppy: dec bh ; dec actual drive count + js nextsetfloppy + mov byte ptr [di+1],REMOVEDRV + mov byte ptr [di+3],FLOPPY + jmp setfloppyexist +nextsetfloppy: add di,4 + inc bl + cmp bl,2 ; if B then jump back + je nextchkfloppy + + mov ch,24 ; loop 24 times (drives C - Z) + mov cl,3 ; start at C: +drivechkloop: mov ax,4409h ; check if drive exists + mov bl,cl ; set drive letter + int 21h ; 0 = default, 1 = A:, etc. + jc nextsetdrv + mov byte ptr [di],DRIVEXISTS + mov ax,4408h ; check if removable + int 21h + mov byte ptr [di+1],al ; set REMOVABLE or FIXED + mov bx,dx + mov dl,dh + shr dl,7 + and dh,00010000b + shr dh,4 + mov byte ptr [di+2],dh ; set REMOTE or LOCAL + or dl,dl ; if not SUBST, then jump + jz chkremote + mov byte ptr [di+3],SUBST + jmp nextsetdrv + +chkremote: cmp dh,REMOTEDRV ; if REMOTE, then check for CD ROM + je chkcdrom + + test bh,00000010b ; sharable? + jz drivenoshare + mov byte ptr [di+2],SHAREDRV +drivenoshare: test bl,00000010b ; RAM drive? + jnz nextsetdrv + mov byte ptr [di+3],RAM + jmp nextsetdrv + +chkcdrom: push cx + mov ax,1500h + xor bx,bx + int 2fh + pop cx + or bx,bx ; MSCDEX driver found? + jz nextsetdrv ; if not, jump to next drive setup + mov ax,150bh + dec cl ; 0=A:, etc. + int 2fh + inc cl + or ax,ax + jz nextsetdrv ; drive supported by MSCDEX? + mov byte ptr [di+3],CDROM + +nextsetdrv: add di,4 + inc cl + dec ch + jnz drivechkloop + + mov ah,0eh + mov dl,[curdrive] + int 21h ; reset start drive + + mov cl,'A' ; output all existing drives + mov di,offset drives + mov ah,9 +drvdumploop: cmp byte ptr [di],DRIVEXISTS + jne nextdrvdump + mov al,cl + int 29h + xor dh,dh + mov dl,byte ptr [di+1] + shl dx,4 + add dx,offset removablemsg + int 21h + xor dh,dh + mov dl,byte ptr [di+2] + shl dx,3 + add dx,offset localmsg + int 21h + xor dh,dh + mov dl,byte ptr [di+3] + shl dx,3 + add dx,offset typemsg + int 21h + mov dx,offset crlf + int 21h + +nextdrvdump: add di,4 + inc cl + cmp cl,'Z' + jbe drvdumploop + + ret + +curdrive db 0 +drives db 26 dup(0,1,0,1) + ; default to not exist, fixed, local, hard drive +crlf db 10,13,'$' +removablemsg db ': Removable $' + db ': Fixed $' +localmsg db 'Local $' + db 'Remote $' + db 'Shared $' +typemsg db 'Floppy $' + db 'Hard $' + db 'RAM $' + db 'Subst $' + db 'CD-ROM $' + + end start diff --git a/assembly/EXECSUB - execute program from compiled BASIC - requires DOS 2.00.asm b/assembly/EXECSUB - execute program from compiled BASIC - requires DOS 2.00.asm new file mode 100644 index 0000000..4717b0f --- /dev/null +++ b/assembly/EXECSUB - execute program from compiled BASIC - requires DOS 2.00.asm @@ -0,0 +1,199 @@ +; This version allows one BASIC program to call another +; +; CALL EXECSUB(PROG$,PARM$,FCB1$,FCB2$,RETCD%) +; PROG$ is the program name (e.g. 'command.com') +; PARM$ is the parameter to be passed to the program (e.g. '/c dir *.bas') +; FCB1$ is the first file control block (required by some programs) +; FCB2$ is the second file control block (required by some programs) +; RETCD% is the error return code + + skip equ 2 ; 1 for interpretive, 2 for compiled + +cseg segment para public 'code' +public execsub +execsub proc far + + assume cs:cseg,ds:cseg,ss:nothing,es:nothing + +basicds equ 510h +i24ip equ 90h +i24cs equ 92h +i1bip equ 6ch +i1bcs equ 6eh +i1cip equ 70h +i1ccs equ 72h + +b24ip equ 51ah +b24cs equ 51ch +b1bip equ 516h +b1bcs equ 518h +b1cip equ 512h +b1ccs equ 514h + + push bp + mov bp,sp + jmp p010 + +stak equ this byte + dw 0 ; save sp + dw 0 ; save ss + +prm1 equ this byte + dw 0 ; environment +prm2 equ this word + dw 0 ; command line - ip & cs + dw 0 +prm3 equ this byte + dw 0 ; default FCB - ip & cs + dw 0 +prm4 equ this byte + dw 0 ; second default FCB - ip & cs + dw 0 + +p010: + xor ax,ax ; get psp + mov es,ax ; es=0 + mov bx,ds ; save ds + mov ds,ax ; ds=0 + cli + + push ds:[basicds] ; save basic's ds + + push ds:[i24ip] ; save int 24h and shadow + push ds:[b24ip] + push ds:[b24ip] + pop ds:[i24ip] + + push ds:[i24cs] + push ds:[b24cs] + push ds:[b24cs] + pop ds:[i24cs] + + push ds:[i1bip] ; save int 1bh and shadow + push ds:[b1bip] + push ds:[b1bip] + pop ds:[i1bip] + + push ds:[i1bcs] + push ds:[b1bcs] + push ds:[b1bcs] + pop ds:[i1bcs] + + push ds:[i1cip] ; save int 1ch and shadow + push ds:[b1cip] + push ds:[b1cip] + pop ds:[i1cip] + + push ds:[i1ccs] + push ds:[b1ccs] + push ds:[b1ccs] + pop ds:[i1ccs] + + sti + mov ds,bx ; restore ds + + mov di,4f2h ; point to dos comm. area + mov ax,es:[di] ; get psp segment + mov es,ax + mov di,2 + mov bx,es:[di] ; get top of memory + sub bx,ax ; subtract psp + mov ah,4ah + int 21h ; free memory + jnc p020 ; no error + mov ah,0 ; memory error + jmp p090 ; to error control + +p020: mov si,[bp+12] ; point to parm$ + add si,skip + mov ax,[si] + mov si,offset prm2 ; establish command line + mov cs:[si],ax + mov ax,ds + mov cs:[si+2],ax + + mov si,[bp+10] ; point to fcb1$ + add si,skip + mov ax,[si] + mov si,offset prm3 + mov cs:[si],ax + mov ax,ds + mov cs:[si+2],ax + + mov si,[bp+8] ; point to fcb2$ + add si,skip + mov ax,[si] + mov si,offset prm4 ; establish second fcb + mov cs:[si],ax + mov ax,ds + mov cs:[si+2],ax + + push bp ; save registers + push ds + push es + pushf + mov si,offset stak ; save stack + mov cs:[si],sp + mov cs:[si+2],ss + + mov ah,4bh ; load prog + mov al,0 ; load & execute + mov si,[bp+14] ; point to prog$ + add si,skip + mov dx,[si] + push cs + pop es + mov bx,offset prm1 ; point to parameter + int 21h ; load & execute program + jnc p050 ; no error + mov ah,1 ; set error code + jmp p060 + +p050: mov ax,0 ; clear error + +p060: mov bx,cs ; restore stack + mov ds,bx + mov si,offset stak + cli ; no interrupts + mov sp,cs:[si] + mov ss,cs:[si+2] + sti ; allow interrupts + + popf ; restore registers + pop es + pop ds + pop bp + + mov cx,ds ; save ds + xor bx,bx + mov ds,bx ; ds=0 + cli + + pop ds:[b1ccs] ; restore int 1ch + pop ds:[i1ccs] + pop ds:[b1cip] + pop ds:[i1cip] + + pop ds:[b1bcs] ; restore int 1bh + pop ds:[i1bcs] + pop ds:[b1bip] + pop ds:[i1bip] + + pop ds:[b24cs] ; restore int 24h + pop ds:[i24cs] + pop ds:[b24ip] + pop ds:[i24ip] + + pop ds:[basicds] ; restore basic's ds + sti + mov ds,cx + +p090: mov si,[bp+6] ; point to RETCD% + mov [si],ax ; return error, if any + + pop bp ; return to caller + ret 10 + +execsub endp +cseg ends +end diff --git a/assembly/Ejects a SCSI tape (or CD-ROM) from a drive.asm b/assembly/Ejects a SCSI tape (or CD-ROM) from a drive.asm new file mode 100644 index 0000000..21e35f9 --- /dev/null +++ b/assembly/Ejects a SCSI tape (or CD-ROM) from a drive.asm @@ -0,0 +1,106 @@ +; eject a tape (or CD) from a device +; +; note that this is a VERY terse code sample! It is assumed that the +; reader is already familiar with SCSI and ASPI to some degree. +; + .MODEL small + .STACK 1000h + .386 + +;* structures * +SCSIRequestBlock struc + CommandCode db 2 ; SCSI request + Status db 0 ; returned after command + HostAdapterNum db 0 ; default is 0 (first adapter) + SCSIReqFlags db 0 ; + Reserved1 db 4 dup (0) ; + TargetID db 0 ; set to device target ID + LUN db 0 ; defaults to 0 + DataLength dd 0 ; + SenseLength db 16 ; usu. sufficient length + DataPointer dd 0 ; no data + SRBLinkPointer dd 0 ; no linking + CDBLength db 10 ; always sufficient length + AdapterStatus db 0 ; + TargetStatus db 0 ; + PostRoutinePtr dd 0 ; no post routine is default + ASPIWorkspace db 34 dup (0) ; req'd but not used + CDB db 10 dup (0) ; SCSI Command Descriptor Blk + SenseData db 16 dup (0) ; +SCSIRequestBlock ends + + .DATA + +DOS_OPEN_HANDLE = 03dh +DOS_CLOSE_HANDLE = 03eh +DOS_IOCTL = 044h +IOCTL_RX_CTL_DATA = 02h +DOS_INT = 21h + +ASPI_Entry dd ? +SRB SCSIRequestBlock <> +crlf equ 13,10 +ErrMsg db "ERROR: no ASPI manager detected. ",crlf,'$' +OKMsg db "All is well.",crlf,'$' +SCSIMgrString db "SCSIMGR$",0 + + .CODE +begin proc + .STARTUP + call GetASPIAddress ; + jnb @@AllOK ; + mov dx, OFFSET ErrMsg ; + jmp @@ErrorExit ; +@@AllOK: +; +; here's the eject sequence +; + mov [(SRB.CDB) + 0],01Bh ; load/unload command + mov [(SRB.CDB) + 4],0 ; 00 = unload, 01=load, 02=retension + mov [(SRB.TargetID)], 2 ; SCSI ID of target device + push SEG SRB ; + push OFFSET SRB ; + call [ASPI_Entry] ; sometimes it takes 2 requests + call [ASPI_Entry] ; + add sp,4 ; + mov dx,OFFSET OKMsg ; + xor ah,ah ; + mov al,[(SRB.Status)] ; +@@ErrorExit: ; ds:dx ==> ASCIIZ error string + push ax + mov ah,9 ; + int 21h ; + pop ax ; +@@NoError: + .EXIT 0 +begin endp + +GetASPIAddress proc C + push bx + push cx + push ds + xor ax,ax ; + mov WORD PTR [ASPI_Entry],ax ; + mov WORD PTR [ASPI_Entry+2],ax ; + lea dx,[SCSIMgrString] ;ds:dx ==> 'SCSIMGR' string + mov ah,DOS_OPEN_HANDLE ; open request + int DOS_INT ; + jb @@exit ; + mov dx,ss ; + mov ds,dx ; + lea dx,[ASPI_Entry] ; + mov cx,4 ; + mov bx,ax ; + mov ax,DOS_IOCTL SHL 8 OR IOCTL_RX_CTL_DATA + int DOS_INT ; + jb @@exit ; + mov ah,DOS_CLOSE_HANDLE ; + int DOS_INT ; +@@exit: + pop ds + pop cx + pop bx + ret ; +GetASPIAddress endp + + END \ No newline at end of file diff --git a/assembly/FXN4BH --- demonstrate use of the PC-DOS 2.0 EXEC function call 4BH.asm b/assembly/FXN4BH --- demonstrate use of the PC-DOS 2.0 EXEC function call 4BH.asm new file mode 100644 index 0000000..6adc676 --- /dev/null +++ b/assembly/FXN4BH --- demonstrate use of the PC-DOS 2.0 EXEC function call 4BH.asm @@ -0,0 +1,162 @@ +; +cr equ 0dh ;ASCII carriage return +lf equ 0ah ;ASCII line feed + ; +cseg segment para public 'CODE' + ; + assume cs:cseg,ds:data,ss:stack + ; +demo proc far + ;at entry DS & ES = PSP + push ds ;Save address for final + xor ax,ax ;FAR RET to PC-DOS on stack + push ax + ;save copy of SS:SP for use + ;after return from overlay + mov cs:STK_SEG,ss + mov cs:STK_PTR,sp + ; + ;Reserve 1000H bytes for + ;this loader and release + ;the rest of memory for + ;use by the overlayed program. + mov bx,100h ;ES=segment of PSP of loader + mov ah,4ah ;BX=paragraphs to reserve + int 21h + ;make the messages in data + ;segment addressable + mov ax,seg DATA + mov ds,ax + mov es,ax + ;jump if memory + ;de-allocation failed + jc ALLOC_ERR + ;print memory successfully + ;released + mov dx,offset MSG2 + mov ah,9 + int 21h + ; + ;now load and execute + ;the overlaid program. + mov dx,offset PGM_NAME + mov bx,offset PAR_BLK + mov al,0 + mov ah,4bh + int 21h + ;restore stack pointers + ;to state before EXEC call + mov ss,cs:STK_SEG + mov sp,cs:STK_PTR + ;Make data segment + ;addressable again + mov ax,seg DATA + mov ds,ax + ;print message that loader + ;successfully regained control + mov dx,offset MSG3 + mov ah,9 + int 21h + ;now exit to PC-DOS + ret + +alloc_err: ;come here if memory + ;cannot be released + mov dx,offset MSG1 + mov ah,9 + int 21h ;print error message and + ret ;exit to PC-DOS + ; +demo endp + ; + ;these two variables must + ;reside in Code Segment so + ;that they are addressable + ;after return from overlay. +stk_seg dw 0 ;original SS contents +stk_ptr dw 0 ;original SP contents + ; +cseg ends + + ;declare a stack area + ;for use by this loader +stack segment para stack 'STACK' + ;allow 64 bytes in this case + db 64 dup (?) +stack ends + + ;declare data segment to + ;contain variables and tables +data segment para public 'DATA' +; +msg1 db cr,lf + db 'Unable to release memory.' + db cr,lf,'$' +msg2 db cr,lf + db 'Memory above loader released.' + db cr,lf,'Now loading CHKDSK.COM.' + db cr,lf,'$' +msg3 db cr,lf + db 'Loader regained control from CHKDSK,' + db cr,lf + db 'now making final exit to PC-DOS.' + db cr,lf,'$' +; + ;drive, path, and name of program + ;to be loaded and executed. +pgm_name db '\CHKDSK.COM',0 +; +par_blk dw ENVIR ;segment address of + ;environment descriptor + ; + ;full address of command line + ;to be passed at offset 80H + dw offset CMD_LINE ;in overlaid + dw seg CMD_LINE ;program's PSP + ; + ;full address of default + ;File Control Block to be + ;passed at offset 5CH in + dw offset FCB1 ;overlaid + dw seg FCB1 ;program's PSP + ; + ;full address of default + ;File Control Block to be + ;passed at offset 6CH in + dw offset FCB2 ;overlaid + dw seg FCB2 ;program's PSP +; + ;actual command line tail + ;to be passed to overlay +cmd_line db 4,' *.*',cr,0 +; + ;first default FCB to +fcb1 db 0 ;be passed to overlay + db 11 dup ('?') + db 25 dup (0) + + ;second default FCB to +fcb2 db 0 ;be passed to overlay + db 11 dup (' ') + db 25 dup (0) +; +data ends + + ;declare separate data + ;segment to contain + ;environment descriptor +envir segment para 'ENVIR' + ; + ;Search path used by PC-DOS + ;to look for commands or + ;batch files not found in + db 'PATH=',0 ;the current directory + ; + ;Search path used by PC-DOS + ;to locate COMMAND.COM + db 'COMSPEC=A:\COMMAND.COM',0 + db 0 ;extra 0 byte designates + ;end of environment +envir ends + + end demo \ No newline at end of file diff --git a/assembly/Fetches and prints the network serial number under Novell Netware 3.11.asm b/assembly/Fetches and prints the network serial number under Novell Netware 3.11.asm new file mode 100644 index 0000000..13995ef --- /dev/null +++ b/assembly/Fetches and prints the network serial number under Novell Netware 3.11.asm @@ -0,0 +1,97 @@ +TITLE "NetWare serial number routine" +; Net_SN.Asm +; +; I've tested this code with Netware 386 version 3.11, +; but it may also work with 2.15. It wasn't documented +; for 2.15, but it may still have existed. +; + + .MODEL SMALL + + .STACK 100h + .DATA +AAMn macro num + db 0d4h, num +endm + +STDOUT = 1 ; handle for stdout + + SNREQBUFF struc + MyLength DW 1 ; request structure length - 2 + Function DB 12h ; function number of GetNetworkSerialNumber + SNREQBUFF ends + + SNREPLYBUFF struc + MyLength DW 6 ; reply structure length - 2 + NetSN DD 0 ; network serial number in big endian packed BCD + AppNumber DW 0 ; Application number in same format + SNREPLYBUFF ends + + U_Request SNREQBUFF <> + U_Reply SNREPLYBUFF <> + SerialNum DB "00000000",0dh, 0ah + SerialLen = $ - SerialNum + + .CODE +; +; Test code gets network serial number and prints it to stdout +; +Start: + mov ax,@data + mov ds,ax ; set up the data segment + call NetworkSN +Exit: + mov ah,04ch ; return with error code preset in AL + int 21h + +; +; here's the Network stuff +; +NetworkSN proc + push ds + push si + push di + push es + push dx + push cx + + lea si,[U_Request] ; prepare to request data + lea di,[U_Reply ] ; prepare to receive data + mov ax,ds + mov es,ax + mov ah,0e3h ; Get File Server Serial Number + int 21h + jc @@NoMore + + lea si,[U_Reply.NetSN] ; point ds:si at binary data + lea di,[SerialNum] ; and point es:di at target ASCII string + mov cx,4 ; loop four times (once for each SN digit pair) + cld ; count up + +@@convbyte: + lodsb ; read a byte + AAMn 16 ; convert to two-digit BCD in ah,al + xchg ah,al ; swap so that memory image will be correct + or ax,3030h ; convert both to ASCII numbers + stosw ; put 'em in our table + loop @@convbyte + + lea dx,[SerialNum] ; we're going to point ds:dx to string + mov cx,SerialLen ; load the length of the string + mov bx,STDOUT ; print to STDOUT + mov ah,40h ; DOS function to print string + int 21h ; do it + mov al,0 ; return with appropriate error code + +@@NoMore: + pop cx + pop dx + pop es + pop di + pop si + pop ds + ret + +NetworkSN endp + + END Start diff --git a/assembly/Game Port.asm b/assembly/Game Port.asm new file mode 100644 index 0000000..7a19dbf --- /dev/null +++ b/assembly/Game Port.asm @@ -0,0 +1,37 @@ +; GAMEPORT.ASM +; + + .MODEL TINY + + .DATA + + yes DB 13,10,"Game port is installed.",13,10,"$" + no DB 13,10,"Game port is not installed.",13,10,"$" + + .CODE + ORG 100h + +start: mov al, 1 ;value to write to port + mov dx, 201h ;port number + out dx, al ;write to port + mov cx, 0F00h ;# of loops + +port_loop: + in al, dx ;read from port + and al, 0Fh ;if jstick present, then AL should be + cmp al, 0Fh ; 0Fh after ANDing with 0Fh. + je jstick_exists + loop port_loop + mov dx, OFFSET no ;gameport not installed + jmp SHORT done + +jstick_exists: + mov dx, OFFSET yes ;gameport installed + +done: mov ah, 9h + int 21h + + mov ax, 4c00h + int 21h + +END start \ No newline at end of file diff --git a/assembly/Get Space.asm b/assembly/Get Space.asm new file mode 100644 index 0000000..cfa3967 --- /dev/null +++ b/assembly/Get Space.asm @@ -0,0 +1,74 @@ +CSEG SEGMENT +PUBLIC GETSPACE +GETSPACE PROC FAR + + ASSUME CS:CSEG + PUSH BP + MOV BP,SP + MOV BX,[BP]+6 + MOV DI,[BX]+2 + MOV CX,8 + MOV AL,' ' + CLD + REP STOSB + MOV BX,[BP]+8 + MOV SI,[BX]+2 + MOV AX,[SI] + AND AL,0DFH + CMP AL,41H + JGE CKVER + JMP EXITSPC + +CKVER: + PUSH AX + MOV AH,30H + INT 21H + XCHG AL,AH + +SPACE20: + POP DX + XOR DL,40H + MOV AH,36H + INT 21H + CMP AX,0FFFFH + JE EXITSPC + XOR DX,DX + MUL CX + XCHG BX,CX + MUL CX + PUSH AX + PUSH DX + +ENDSPC: + MOV BX,[BP]+6 + MOV DI,[BX]+2 + ADD DI,7 + POP DX + POP AX + +HEXTODEC: + MOV SI,10 + PUSH AX + MOV AX,DX + XOR DX,DX + DIV SI + POP CX + PUSH AX + MOV AX,CX + DIV SI + POP SI + OR DL,30H + MOV BYTE PTR [DI],DL + DEC DI + XCHG DX,SI + OR AX,AX + JNZ HEXTODEC + +EXITSPC: + POP BP + RET 4 + RET + +GETSPACE ENDP +CSEG ENDS + END \ No newline at end of file diff --git a/assembly/Get current Segment Values.asm b/assembly/Get current Segment Values.asm new file mode 100644 index 0000000..0fe9335 --- /dev/null +++ b/assembly/Get current Segment Values.asm @@ -0,0 +1,79 @@ +; +; +; Synopsis getseg(pcs, pds, pes, pss, psi, pdi, psp, pflag); +; +; unsigned *cs Pointer to where code segment address goes +; unsigned *ds Pointer to data segment +; unsigned *es Pointer to extra segment +; unsigned *ss Pointer to stack segment +; unsigned *si Pointer to si register +; unsigned *di Pointer to di register +; unsigned *sp Pointer to sp register +; unsigned *flag Returns flag +; +; +; Returns cs value of Code segment +; ds value of Data segment +; es value of Extra segment +; ss value of Stack segment +; si value of SI register ****NOT RELIABLE**** +; di value of DI register +; sp value of Stack Pointer +; flag value of Flags register +; +; +; + + +pgroup group prog +prog segment byte public 'PROG' ; Combine with C 'PROG' program segment + assume cs:pgroup + public getseg +getseg proc near + push bp ; Save the frame pointer + mov bp,sp + mov si,[bp + 04] ; Get the values for the registers + mov ax,[si] + mov si,[bp + 06] + mov bx, [si] + mov si,[bp + 08] + mov cx, [si] + mov si,[bp + 10] + mov dx,[si] +;============================================================================== + mov ax, cs ;Get value of code segment + mov bx, ds ;data segment + mov cx, es ;extra segment + mov dx, ss ;stack segment + + +;============================================================================== + +uret: mov bp,sp ; Now recover the values of the + mov si,[bp + 04] ; parameters + mov [si],ax + mov si, [bp + 06] + mov [si], bx + mov si, [bp + 08] + mov [si], cx + mov si, [bp + 10] + mov [si], dx + mov si, [bp + 12] + mov [si], si + mov si, [bp + 14] + mov [si], di + mov si, [bp + 16] + mov [si], sp + mov al, 00 ;zero out al + lahf ;load flag into ah + mov si, [bp + 18] + mov [si], ax + + + mov ax,0 ; No error + +quit: pop bp ; Get the original frame pointer. + ret +getseg endp +prog ends + end \ No newline at end of file diff --git a/assembly/Get disk free space function.asm b/assembly/Get disk free space function.asm new file mode 100644 index 0000000..1f44ea1 --- /dev/null +++ b/assembly/Get disk free space function.asm @@ -0,0 +1,123 @@ +; CALL FRESPACE(AH,AL,BH,BL,CH,CL). CL SHOULD BE 0 for default +; drive 1 for A, 2 for B, 3 for C, etc. The value of the +; other variables does not matter. They will come back +; with a meaningful value. +; +; AN EXAMPLE PROGRAM: +; +; 10 defint a-z +; 20 color 7,1:cls +; 30 test1=1:ah=0:al=0:bh=0:ch=0:cl=1:test2=2 +; 35 INPUT"DRIVE 0=DEFAULT, 1=A, 2=B, 3=C";CL +; 37 PRINT"JUST BEFORE CALL" +; 40 CALL FRESPACE(AH,AL,BH,BL,CH,CL) +; 45 PRINT"JUST AFTER CALL" +; 50 PRINT" AH=";AH;" AL=";AL;" BH=";BH;" BL=";BL;" CH=";CH;" CL=";CL; +; 60 UFREE!=256*AH+AL +; 70 UBYTES!=256*BH+BL +; 80 USECTOR!=256*CH+CL +; 90 PRINT"UFREE!=";UFREE!;" UBYTES!=";UBYTES!;" USECTOR!=";USECTOR! +; 100 FRESPACE!=UFREE!*UBYTES!*USECTOR! +; 110 PRINT"FRESPACE!=";FRESPACE! +; 120 PRINT"THIS SHOULD BE 1",TEST1 +; 130 PRINT"THIS SHOULD BE 2",TEST2 +; + +get_spa equ 36h ;Get disk free space function call +doscall equ 21h ;DOS interrupt number + +dgroup group datarea +datarea segment para public 'DATA' + +ah_ret dw ? ;ah to be sent back +al_ret dw ? ;al to be sent back +bh_ret dw ? ;bh to be sent back +bl_ret dw ? ;bl to be sent back +ch_ret dw ? ;ch to be sent back +cl_ret dw ? ;cl to be sent back + +datarea ENDS +; +cseg segment 'CODE' + assume cs:cseg + public frespace +frespace proc far + push bp ;BP from BASIC + mov bp,sp ;set base for parm list + push ds ;DS from basic work area + push es ;ES from basic work area + mov ax,datarea ;establish data addressability + mov ds,ax ;now DS is local data + assume ds:datarea +; +; +; +; + push bp + sub ax,ax + mov si,ss:[bp+6] ;get addr of parameter + mov al,es:[si] ;get value of parm + mov dx,ax ;dl contains the drive number on call + ;dh will be zero + mov ah,get_spa ;get space function number + int doscall ;Call DOS + +; Move the values into local work area to prepare to send back to basic + xchg dx,ax ;must have a word. Want to zero out DH. + sub ax,ax ; produce the zero + xchg dx,ax ; DX is now zero. + ; DH is what we really want as zero. + + mov dl,ah ;want to send back a byte + mov ah_ret,dx ; prepare to return ah + + mov dl,al ;want to send back a byte + mov al_ret,dx ; prepare to return al + + mov dl,bh ;want to send back a byte + mov bh_ret,dx ; prepare to return bh + + mov dl,bl ;want to send back a byte + mov bl_ret,dx ; prepare to return bl + + mov dl,ch ;want to send back a byte + mov ch_ret,dx ; prepare to return ch + + mov dl,cl ;want to send back a byte + mov cl_ret,dx ; prepare to return cl + + +; Go back + pop bp ;get back Basic's workspace + mov ax,cl_ret + mov si,ss:[bp+6] + mov es:[si],ax ;return cl + + mov ax,ch_ret + mov si,ss:[bp+8] + mov es:[si],ax ;return ch + + mov ax,bl_ret + mov si,ss:[bp+10] + mov es:[si],ax ;return bl + + mov ax,bh_ret + mov si,ss:[bp+12] + mov es:[si],ax ;return bh + + mov ax,al_ret + mov si,ss:[bp+14] + mov es:[si],ax ;return al + + mov ax,ah_ret + mov si,ss:[bp+16] + mov es:[si],ax ;return ah +; + pop es + pop ds + pop bp + ret 12 ;return to basic 6 parameters were sent +frespace endp +;----------------------------------------------------------------------- +cseg ends + end ;end for assembler \ No newline at end of file diff --git a/assembly/Gets a list of Queue servers under Novell Netware 3.11.asm b/assembly/Gets a list of Queue servers under Novell Netware 3.11.asm new file mode 100644 index 0000000..dd278cd --- /dev/null +++ b/assembly/Gets a list of Queue servers under Novell Netware 3.11.asm @@ -0,0 +1,162 @@ +%PAGESIZE 55,200 +%SUBTTL "Get List of Queue Servers under Netware 3.11" +; Net_Q.Asm +; + + .MODEL SMALL + + + .STACK 100h + +DOSint macro function + mov ah,function + int 21h +ENDM + + .DATA + STDOUT = 1 ; the stdout device handle + + DOS_WRITE_TO_HANDLE = 040h ; Write to File Handle + DOS_TERMINATE_EXE = 04Ch ; Terminate Program + + NOVELL_FUNCTION = 0E3h +; +; Object Types +; note that they're all big endian +; + OT_USER = 0100h + OT_USER_GROUP = 0200h + OT_PRINT_QUEUE = 0300h ; Print Queue object type + OT_FILE_SERVER = 0400h + + +BragMsg DB 0dh,0ah,"NET_Q.EXE",9,"WWW" + DB 9,"Version 1.00",0dh,0ah + DB 9,9,"released to the public domain by the author",0dh,0ah,0dh,0ah +BragLen = $ - BragMsg + +Crlf DB 0dh,0ah,0 + + SCAN_REQ STRUC ; bindery ScanObject request packet structure + MyLength DW 55 ; the length of this buffer + Function DB 37h ; scan object subfunction number + ObjectID DD -1 ; all ones for initial object search + ObjectType DW -1 ; wild card -- looks for all objects + ObjNameLen DB 1 ; at least one character + ObjName DB 47 DUP ('*') ; fill with wildcards to start + SCAN_REQ ENDS + + SCAN_REP STRUC ; bindery ScanObject request packet structure + MyLength DW 57 + RObjectID DD 0 ; all ones for initial object search + RObjectType DW 0 ; wild card -- looks for all objects + RObjName DB 48 DUP (0) ; fill with wildcards to start + ObjFlag DB 0 + ObjSecurty DB 0 + ObjHasProp DB 0 + ENDS + + ScanObjReq SCAN_REQ <> + ScanObjRep SCAN_REP <> + + .CODE + +; +; This is the main part of the code +; +; Test code gets and prints the name of all print queues from the +; logged server -- NO ERROR CHECKING IS DONE, so be careful! +; + +Start: + mov ax,@data + mov ds,ax ; set up the data segment + mov dx,OFFSET BragMsg ; prepare to print out brag line(s) + mov cx,BragLen + mov bx,STDOUT ; print to STDOUT + DOSint DOS_WRITE_TO_HANDLE + jc Exit ; if carry is set, there was an error + + mov [ScanObjReq.ObjectType],OT_PRINT_QUEUE + ; + ; in this case the name is already set up, (a wildcard) but if a + ; specific name were desired, it would be moved to + ; ScanObjReq.ObjName, with the appropriate length (not including + ; optional terminating NULL char set up in ScanObjReq.ObjNameLen. + ; +@@MoreQueues: + call BindScan + jc Exit + + lea dx,[ScanObjRep.ObjName] + call Puts + lea dx,[Crlf] + call Puts + jmp @@MoreQueues + +Exit: + DOSint DOS_TERMINATE_EXE ; return with error code preset in AL + +; +; BindScan +; +; scans the bindery for the object name set in the request buffer +; +BindScan proc + push ds si di es dx ax + + lea si,[ScanObjReq] ; point DS:DI to request buffer + mov dx,ds + mov es,dx + lea di,[ScanObjRep] ; point ES:SI to reply buffer + DOSint NOVELL_FUNCTION + jb @@Exit + + cld ; make sure to count up + mov si,OFFSET ScanObjRep.ObjectID + mov di,OFFSET ScanObjReq.ObjectID + movsw + movsw + + clc + +@@Exit: + pop ax dx es di si ds + ret + +BindScan endp + +; Puts +; +; prints a NUL terminated string to stdout +; +; INPUTS: ds:dx points to ASCIIZ string +; +; OUTPUTS: prints string to stdout +; +; RETURNS: ax = number of bytes actually printed +; carry set on error +; +; DESTROYED: ax +; +Puts proc + push bx cx di es + + push ds + pop es + mov cx,0ffffh ; maximum length of string + mov di,dx + cld + mov al,0 ; we're looking for NUL + repne scasb + dec di + mov cx,di + sub cx,dx + mov bx,STDOUT ; write to this device + DOSint DOS_WRITE_TO_HANDLE + + pop es di cx bx + ret +Puts endp + + END Start \ No newline at end of file diff --git a/assembly/Inthand.asm b/assembly/Inthand.asm new file mode 100644 index 0000000..88642c4 --- /dev/null +++ b/assembly/Inthand.asm @@ -0,0 +1,44 @@ +; +progseg segment para public 'CODE' + public setcom + assume cs:progseg, ds:progseg, es:progseg + org 100h +doscall equ 21h +oldint equ 16h +; +startup proc far + jmp setup +; +setcom proc far +; jmp cs:[interupt] + pushf + call cs:[interupt] + RET 2 +setcom endp +; +save db 0 +interupt label dword +vector db 8 dup(0) ;only 4 needed 4 more for safety +; +setup: + mov ah,35h ;get interupt vector address function + mov al,oldint ;keyboard interupt vector + int doscall ;go get it +; + mov word ptr vector,bx ;save offset + mov bx,es ;get segment address + mov word ptr vector+2,bx ;save segment +; + mov dx,offset setcom ;get new vector address + mov ax,cs + mov ds,ax ;set segment + mov ah,25h ;set interupt vector address function + mov al,oldint ;set to our new interupt vector + int doscall ;set the interupt +; + mov dx,offset setup ;terminate and stay resident + int 27h +startup endp +progseg ends +; + end startup \ No newline at end of file diff --git a/assembly/Issues the CPUID instruction to fetch the family, model and stepping ID.asm b/assembly/Issues the CPUID instruction to fetch the family, model and stepping ID.asm new file mode 100644 index 0000000..2f6c99c --- /dev/null +++ b/assembly/Issues the CPUID instruction to fetch the family, model and stepping ID.asm @@ -0,0 +1,72 @@ +; pentid.asm +; +; this program issues the CPUID instruction (valid only on Pentium class +; processors!) and prints three hex digits which correspond to the +; family, model, and stepping ID. If you run this on a 8088, 80386, or +; 80486 processor, it will return to the command line without printing +; anything. If you run this on an 80286, NEC V20 or NEC V30, your machine +; will probably crash. If you're smart enough to run this program only +; on Pentium machines, you can remove all the code between Start and +; RealTest and you'll reduce the code size from 84 to 49 bytes. +; +; TASM /m2 pentid ; two pass mode +; TLINK /Tdc pentid ; link as COM file +; + .MODEL tiny + .586 ; allow Pentium instructions + + .CODE + ORG 100h +Start: + pushf ; assure this is a Pentium + pop ax ; flags in ax + rol ah,1 ; put EFLAGS reserved bit 15 in CF + sahf ; store in regular flags + jc BailOut ; if carry flag set, it's an 8088! + ; assume we're 80386+ (80286 users prepare for crash) + pushfd ; push EFLAGS + pop eax ; now pull them into reg + mov ecx,eax ; save original copy in ECX + xor eax,00200000h ; flip bit 21 (CPUID capable) + push eax ; pass altered flags back on stack + popfd ; allow cpu to balk + pushfd ; see what it did with our flag + pop eax ; let's test... + cmp eax,ecx ; if bit can't be flipped it's + je BailOut ; not a Pentium processor +RealTest: ; + xor eax,eax ; clear eax + inc al ; put a 1 in eax + cpuid ; opcode is 0fh 0a2h + mov bx,ax ; save the lower 16 bits + call hex ; convert low nybble (step ID) + mov ah,'$' ; add terminator char + push ax ; put it on stack + mov ax,bx ; recall other bits + shr al,4 ; get 'em all lined up + call hex ; convert middle nybble (model) + xchg al,ah ; swap results + call hex ; convert third nybble (family) + push ax ; put that on stack, too + mov dx,sp ; print the stack (!) + mov ah,9h ; print string function + int 21h ; DOS interrupt + pop eax ; restore stack + mov al,bl ; recall original value +BailOut: + mov ah,4Ch ; terminate program with + int 21h ; model & stepping ID as errcode + +; +; convert low nybble of al to ASCII char. +; al = {00h - 0Fh } becomes al = { '0'-'9', 'A'-'F' } +; +hex proc + and al,0Fh ; use only low nybble in al + cmp al,0Ah ; set CY flag appropriately + sbb al,69h ; al = al - 069h - (al > 10) + das ; al = 30h-39h or 41h-45h + ret ; pass back our result +hex endp + + END Start \ No newline at end of file diff --git a/assembly/MSDOS 2.00 Function Library for Lattice C.asm b/assembly/MSDOS 2.00 Function Library for Lattice C.asm new file mode 100644 index 0000000..d61e89b --- /dev/null +++ b/assembly/MSDOS 2.00 Function Library for Lattice C.asm @@ -0,0 +1,58 @@ +subttl - +;; +;;FUNCTION: Sets and returns switch char- +;; acter and device availability. +;; +;; +;;CALL: +;; +;; ret= _charop(al,dl) +;; int ret; DL return value, +;; int al; charoper function +;; int dl; charoper data +;; +;;RETURN: +;; See the DOS docs for details. +;;_charop(0,0) returns the ASCII switch char, +;;_charop(1,'-') sets the switch to -, +;;_charop(2,0) returns device availability, +;;_charop(3,i) sets device availability. +;; +;; +;;DESCRIPTION: +;; +;;EXAMPLE: +;; +;; +;;CAUTIONS: +;; +;; +;;ASSUMPTIONS: +;; +;;LONG 32 bits (4 bytes) +;;INT 16 bits (2 bytes) +;;CHAR 8 bits (1 byte) +;; +page +pgroup group prog +prog segment byte public 'prog' +assume cs:pgroup,ds:pgroup + +public _charop + +_charop proc near + push bp + mov bp,sp + mov al,[bp+4] + mov dl,[bp+6] + mov ah,55 + int 33 + mov al,dl + mov ah,0 + pop bp + ret +_charop endp + +prog ends + + end diff --git a/assembly/Multi-function fractal demonstration program which results in 255 byte program.asm b/assembly/Multi-function fractal demonstration program which results in 255 byte program.asm new file mode 100644 index 0000000..9528bc8 --- /dev/null +++ b/assembly/Multi-function fractal demonstration program which results in 255 byte program.asm @@ -0,0 +1,294 @@ +; teeny program displays the Mandelbrot set. +; +; Home Up PgUp +; Left Right correspond to 8 obvious directions +; End Dn PgDn +; + + .model TINY + ;JUMPS ; without this, see caveat under 8086 above + +NONE = 00h ; use this for no features +PRINTZOOM = 01h ; printout and beep features +MODECHANGE = 02h ; support video mode change? +SPEED = 04h ; use 386 instructions for speed +STARTCOORDS = 08h ; use starting coordinates (instead of 0,0) +HIRES = 10h ; use hi resolution (single mode version only) + +; choose the desired features from the feature list above, and OR them +; all together as shown below: + +FEATURES = PRINTZOOM OR MODECHANGE OR STARTCOORDS OR SPEED OR HIRES + + +if (FEATURES AND SPEED) + .386 +endif + +ifdef (FEATURES AND HIRES) + VIDMODE = 12h ; use mode 12h + PIXWIDTH = 640 ; ... which is 640x480 + PIXHEIGHT = 480 +else + VIDMODE = 13h ; use mode 13h + PIXWIDTH = 320 ; ... which is 320x200 + PIXHEIGHT = 200 +endif +TEXTMODE = 3 ; our exit video mode (80x25 color text mode) +ZOOMLIMIT = 13 ; can change to up to 13 for extended zoom in + +VIDEO_INT = 10h ; BIOS video services interrupt + WRITE_PIXEL = 0Ch ; write pixel video service + WRITE_CHAR = 0eh ; write char in TTY mode video service + CHANGE_MODE = 00h ; change mode video service + +KEYBD_INT = 16h ; BIOS keyboard services interrupt + +; ASCII codes +EXTENDED = 000h ; no ASCII code for extended key codes +BELL = 007h ; the ASCII bell char to make a beep +CR = 00dh ; a carriage return character +ESCAPE = 01bh ; the escape key +PLUS = 02bh ; ASCII code for '+' key +V_KEY = 'v' ; ASCII code for video mode switch + +; keyboard scan codes +MINUS = 04ah ; scan code for gray '-' key + +; feel free to experiment with the following constants: + +DELTA = 100 ; the unit of pan movement in pixels +THRESHOLD = 4 ; must be in the range of (0,255) +STARTSCALE = 7 ; a number from 0 to ZOOMLIMIT, inclusive +STARTX =-DELTA ; to the right by 1 delta unit (STARTCOORDS feature) +STARTY =-DELTA ; down by 1 delta unit (STARTCOORDS feature) +CHAR_COLOR = 0fh ; white on black background (for PRINTZOOM feature) + + .code + org 100h +;**************************************************************************** +; +; Here's the main routine, and it's a bit convoluted. +; +;**************************************************************************** +Start proc +ife (FEATURES AND MODECHANGE) + mov ax,VIDMODE + int VIDEO_INT +endif +if (FEATURES AND STARTCOORDS) + mov bp,STARTX + mov di,STARTY +else + xor bp,bp ; zero initial X offset + xor di,di ; initial Y offset is identical +endif +if (FEATURES AND MODECHANGE) + mov si,offset VidTbl; point to default video table + jmp @@ChgMode + +video STRUC +ScrnMode dw ? ; the mode number for BIOS' purposes +ScrnWidth dw ? ; pixel width of screen minus one +ScrnHeight dw ? ; full height of screen in pixels +NextMode dw ? ; pointer to next video structure +video ENDS + + +VidTbl video <54h, 800-1, 600, ($ + 2)> ; highest res + video <13h, 320-1, 200, ($ + 2)> ; lowest res + video <12h, 640-1, 480, offset VidTbl> ; next to lowest res + +else + jmp @@Render ; leap right in there and draw +endif +@@TryPlus: + cmp al,PLUS ; Q: gray + key? + mov al,[scale] ; get the scale factor in al now + jnz @@TryMinus ; N: maybe it's something else + dec al ; Y: it's plus so zoom out + js @@beep ; if AL<0, balk - can't zoom that far + sar bp,1 ; adjust offsets for new scale so + sar di,1 ; we stay in the same place + jmp @@AdjustScale +@@TryMinus: + cmp ah,MINUS ; Q: gray - key? + jnz @@ReadKey ; N: it's not a valid key + inc al ; Y: zoom in + cmp al,ZOOMLIMIT ; Q: have we zoomed too far? + ja @@beep ; Y: yes, so just beep and don't adjust + sal bp,1 ; adjust offsets for new scale so + sal di,1 ; we stay in the same place + +@@AdjustScale: + mov [scale],al ; update the scale value +@@Render: +if (FEATURES AND PRINTZOOM) + mov al,'0'+ZOOMLIMIT; maximum printable character + sub al,[scale] ; invert the sense + call PrintChar ; show the character + mov al,CR ; print a carriage return (no line feed - + call PrintChar ; we don't want to advance to next line) +endif +;**************************************************************************** +; Draw +; This routine is the fractal drawing engine. It has been +; optimized for size, sacrificing speed. +; +;**************************************************************************** +if (FEATURES AND MODECHANGE) + mov cx,(video ptr [si]).ScrnHeight + push si ; we do this because it's very slow + ; if we read the Width from memory + ; every inner loop iteration + mov si,(video ptr [si]).ScrnWidth +else + mov cx, PIXHEIGHT ; height of screen in pixels +endif + sub di,cx ; adjust our Y offset +@@CalcRow: + push cx ; save the row pointer on the stack +if (FEATURES AND MODECHANGE) + mov cx,si ; fetch the screen width +else + mov cx, PIXWIDTH-1 ; width of screen in pixels +endif + sub bp,cx ; +@@CalcPixel: + push cx ; save the column counter on stack + xor cx, cx ; clear out color loop counter + xor bx, bx ; zero i coefficient + xor dx, dx ; zero j coefficient +@@CycleColors: + push dx ; save j value for later + mov ax, bx ; ax = i + sub ax, dx ; ax = i - j + add dx, bx ; dx = i + j + stc ; one additional shift, please + call Shifty ; ax = ((i+j)*(i-j)) shifted right + pop dx ; retrieve our saved value for j + add ax,bp ; account for base offset... + cmp ah,THRESHOLD ; Q: is i > THRESHOLD * 256? + xchg bx,ax ; now swap new i with old i + jg @@draw ; Y: draw this pixel + clc ; no additional shifts here, please + call Shifty ; now dx:ax = old i * j + xchg dx,ax ; + add dx,di ; account for base offset... + inc cl ; increment color + jnz @@CycleColors ; keep going until we're done +@@draw: + xchg ax, cx ; mov color into al + pop cx ; retrieve our column counter + pop dx ; fetch row (column already in cx) + push dx ; must leave a copy on the stack + xor bx,bx ; write to video page zero + mov ah,WRITE_PIXEL ; write pixel command + int VIDEO_INT ; video BIOS call + inc bp ; adjust our X base value + loop @@CalcPixel ; keep going until we've done a line + inc di ; adjust our Y base value + pop cx ; keep going until we've done 'em all + loop @@CalcRow ; more rows? + +if (FEATURES AND MODECHANGE) + pop si ; restore vid ptr if we use one +endif +@@beep: +if (FEATURES AND PRINTZOOM) + mov al,BELL ; + call PrintChar ; +else + mov ax,((WRITE_CHAR SHL 8) OR BELL) ; make a beep + int VIDEO_INT ; (bx=0 -- any video page, any char attr) +endif +@@ReadKey: + xor ax,ax ; fetch a keystroke + int KEYBD_INT ; keyboard request + cmp al,ESCAPE ; Q: does the user want to exit? + jz @@exit ; Y: do so immediately +if (FEATURES AND MODECHANGE) + cmp al,V_KEY ; request for video mode change? + jnz @@TestExt ; if not, go on +@@ChgMode: + mov si,(video PTR [si]).NextMode ; change pointers + mov ax,(video PTR [si]).ScrnMode ; load new video mode + int VIDEO_INT ; change modes + jmp @@Render ; draw new screen +@@TestExt: +endif + cmp al,EXTENDED ; Q: is it an extended key code? + jnz @@TryPlus ; N: it's not so see if it's '+' +@@ArrowKey: + inc ah ; increment it to make indexing easier + add ah,ah ; multiply by two + mov bl,6 ; fix template (bh is already zero) + and bl,ah ; now bx contains address of delta +if (FEATURES AND MODECHANGE) + push si ; save video ptr if we're using one +endif + mov si,offset Deltas; fetch the delta value + add bp,[bx+si] ; add it to the X offset + shr ah,2 ; now look at the Y value of keystroke + mov bl,6 ; turn it into a table offset + and bl,ah ; do it now + sub di,[bx+si] ; and subtract from Y offset +if (FEATURES AND MODECHANGE) + pop si ; restore video ptr if we're using one +endif + jmp @@Render ; go draw this thing. +@@exit: + mov ax,TEXTMODE ; back to normal now + int VIDEO_INT ; change modes + ret ; and exit via old style +Start endp + +Deltas dw +DELTA,0,-DELTA,0 ; handy table for calculating + ; changes in X and Y offsets + +;**************************************************************************** +; Shifty +; +; This routine multiplies AX by DX and shifts the result (in +; DX:AX) to the right by scale bits (or scale+1 bits if CY is +; set). The resulting value is left in AX. DX is destroyed. +; +;**************************************************************************** +Shifty proc near + push cx ; save middle bits (i*i - j*j) + db 0b1h ; code for mov cl,immed8 +scale db STARTSCALE + adc cl,0 ; adjust per CY flag + imul dx ; do the multiply +if (@Cpu AND 8) ; is is a 386 or better? + xchg ax,dx ; + shl eax,16 ; put hi part in hi 16 bits + xchg ax,dx + shr eax,cl ; +else +@@Rotate: + rcr dx,1 ; + rcr ax,1 ; + loop @@Rotate ; ch is always zero so this is OK +endif + pop cx ; + ret ; +Shifty endp + +if (FEATURES AND PRINTZOOM) +;**************************************************************************** +; PrintChar +; +; This simple subroutine prints a single character (in AL) to the +; screen using a BIOS call. AH and BX are destroyed. +; +;**************************************************************************** +PrintChar proc + mov ah,WRITE_CHAR ; write a character in TTY mode + mov bx,CHAR_COLOR AND 07fh ; use page 0 (bh), non-xor color (bl) + int VIDEO_INT ; do it up + ret +PrintChar endp +endif + + end Start \ No newline at end of file diff --git a/assembly/Program to prevent CTRL+ALT+DEL from restarting the system.asm b/assembly/Program to prevent CTRL+ALT+DEL from restarting the system.asm new file mode 100644 index 0000000..10f59f6 --- /dev/null +++ b/assembly/Program to prevent CTRL+ALT+DEL from restarting the system.asm @@ -0,0 +1,150 @@ +To use it just type, from the dos prompt: + + MASM NOCAD; (of course you need MASM) + LINK NOCAD; (and of course you need a linker) + NOCAD + + If you type NOCAD once it has been loaded, it will tell you so. + I've used it with DOS 3.30, but it works just as well under DOS + 2.00 and above. + If you have any comment of any kind please let me know. + And have a nice new decade everybody. + +cut here: ************************************************************ +page 255,132 ;just to get a nice list file +comment : + Program to prevent CTRL+ALT+DEL from restarting the system + WARNING: Once loaded, you only have three choices: + 1) Turn power off + 2) Use a reset button (not all the machines have one) + 3) Generate INT 19h + + WARNING: If you have a program that uses INT 0CDh, change + this value in the equates line below to the number + of a not used INT. This method is used because + there are too many programs that hook INT 9 Vector and + we can't be sure it always points to the end of our + notice (and start of our ISR). + + NOTE: For memory references i use parentheses instead of + square brackets because of ASCII-EBCDIC translations. + It works the same under Microsoft's MASM 4.0 + + NOTE: NOCAD won't work if you press CTRL+ALT+DEL from + a program that hooked to INT 9 before NOCAD + (example: SideKick). Solution: Load NOCAD before + everything else. + + +ctrl equ 0100b ;bit map for ctrl key +alt equ 1000b ;bit map for alt key +free_vector equ 0CDh ;vector used to prevent double loading + ;change it if your system uses INT 0CDh + nocad segment byte 'CODE' + assume cs:nocad, ds:msgs, es:nothing, ss:stack + Copyright db 'Antonio Quezada-Duarte ITESM ISC 296641 Monterrey ' + db 'Nuevo Leon MEXICO' + Cright_Len equ $-Offset Copyright + new_int_9h proc near + push ax + push ds ;save registers + xor ax,ax + mov ds,ax ;point DS to BIOS data area + ;well, actually BIOS data area + ;starts at 0040:0000, but + ; XOR AX,AX is faster than MOV AX,40h + mov al,ds:(417h) ;get keyboard flags + and al,ctrl+alt ;clear non relevant bits + cmp al,ctrl+alt ;compare to our map + jne go_ahead ;NO CTRL+ALT keys pressed + and byte ptr ds:(417h),not alt ;CTRL+ALT pressed + ;clear ALT key bit to simulate + ;ALT key is not pressed +go_ahead: + pushf ;old ISR returns with IRET + COMMENT : + The Following code stands for + + CALL OLD_INT_9 + Where OLD_INT_9 is a FAR PROC + this is faster than having the address of OLD_INT_9 + stored in memory and doing a + CALL CS:(OLD_INT_9) + : + DB 9Ah + OLD_INT_9_OFS DW 0 + OLD_INT_9_SEG DW 0 ;call old INT 9 ISR + + pop ds + pop ax ;restore registers + iret ;return to caller + new_int_9h endp + begin proc near + push es ;save psp base address + mov dx,seg msgs + mov ds,dx + mov dx,offset msg_0 + mov ah,9 + int 21h + mov ax,3500h + free_vector + int 21h + mov di,bx ;ES:DI ===> start of INT 0CDh ISR + mov si,offset copyright + mov ax,cs + mov ds,ax ;DS:SI ===> THIS code copyright notice + mov cx,cright_len + cld + repe cmpsb ;compare + je loaded ;if equal then already loaded + mov ax,2500h + free_vector + mov dx,cs + mov ds,dx + mov dx,offset copyright + int 21h ;point free_vector INT vector to + ;our copyright notice + mov ax,3509h + int 21h ;get pointer to INT 9 ISR + mov cs:old_int_9_ofs,bx + mov cs:old_int_9_seg,es ;put it IN the new INT 9 ISR + mov ax,2509h + mov dx,offset new_int_9h + push cs + pop ds + int 21h ;point INT 9 vector to our ISR + mov dx,seg msgs + mov ds,dx + mov dx,offset msg_1 + mov ah,9 + int 21h ;print loaded msg + pop ds ;get saved psp base address + mov es,ds:(2Ch) + mov ah,49h + int 21h ;free environment's memory + ;assume no error + mov dx,offset begin ;everything up to BEGIN + add dx,10Fh ;and all the bytes needed to + mov cl,4 ;make a full paragraph ... + shr dx,cl + mov ax,3100h ;... stay resident + int 21h ;and return exit code = 0 +loaded: pop ax ;get psp address out of stack + ;any register will do + mov dx,seg msgs + mov ds,dx ;point DS to our data area + mov dx,offset msg_2 + mov ah,9 + int 21h ;print already loaded msg + mov ax,4C01h + int 21h ;terminate with exit code = 1 + begin endp + nocad ends + msgs segment word 'DATA' + msg_0 db 10,13,'NOCAD: Prevent CTRL+ALT+DEL from restarting the ' + db 'system',10,13,'Author: Antonio Quezada-Duarte',10,13,'$' + msg_1 db 10,13,'NOCAD Loaded OK.',10,13,'$' + msg_2 db 10,13,'NOCAD Already Loaded.',10,13,'$' + msgs ends + stack segment para stack 'STACK' + dw 1024 dup (?) + stack ends + end begin \ No newline at end of file diff --git a/assembly/Report installed device drivers.asm b/assembly/Report installed device drivers.asm new file mode 100644 index 0000000..cec1e6e --- /dev/null +++ b/assembly/Report installed device drivers.asm @@ -0,0 +1,231 @@ +name dev + page 60,132 + title 'DEV --- Report installed device drivers' + +; DEV --- a utility to report device header information for +; all installed device drivers +; +; Requires PC-DOS or MS-DOS 2.0. +; +; Used in the form: +; A>DEV +; + +cr equ 0dh ;ASCII carriage return +lf equ 0ah ;ASCII line feed +blank equ 20h ;ASCII space code +eom equ '$' ;end of string marker + + +cseg segment para public 'CODE' + + assume cs:cseg,ds:data,es:data,ss:stack + + +dev proc far ;entry point from PC-DOS + + push ds ;save DS:0000 for final + xor ax,ax ;return to PC-DOS + push ax + mov ax,data ;make our data segment + mov ds,ax ;addressable via DS and ES. + mov es,ax + mov ah,30h ;check version of PC-DOS. + int 21h + cmp al,2 + jae dev1 ;proceed, DOS 2.0 or greater. + mov dx,offset msg2 ;DOS 1.x --- print error message. + jmp dev6 + +dev1: mov cx,ax ;save DOS version number. + mov ah,15 ;now try and open the "NUL" device. + mov dx,offset nulfcb + int 21h + or al,al ;opened successfully? + jz dev2 ;yes, jump. + mov dx,offset msg1 ;no, print error msg and exit. + jmp dev6 + +dev2: ;Pick up double pointer to device + ;driver chain out of reserved + ;area in fcb. This area is mapped + ;differently in DOS 2.x and DOS 3.x. + cmp cl,2 ;is this DOS 2.x? + ja dev3 ;no, jump. + mov bx,word ptr nulfcb+25 + mov es,word ptr nulfcb+27 + jmp dev4 + +dev3: ;come here if DOS 3.0 or greater. + mov bx,word ptr nulfcb+26 + mov es,word ptr nulfcb+28 + +dev4: call header ;print sign-on message and + ;column headings. + +dev5: ;trace through the device chain + + call prdev ;print device header information + ;for driver pointed to by ES:BX. + ;pick up addr of next header. + les bx,dword ptr es:[bx] + cmp bx,-1 ;found last one yet? + jne dev5 ;no, try next. + + mov dx,offset msg3 ;yes, print "end of device chain". + +dev6: mov ah,9 ;print the string whose address + int 21h ;is in DX. + ret ;then return to DOS. + +dev endp + + +header proc near ;print out headings for device + mov dx,offset hdr ;driver information. + mov ah,9 + int 21h + ret +header endp + + +prdev proc near ;print out device driver info. + ;ES:BX is pointer to device header, + ;which must be preserved. + mov ax,es ;convert segment of device header + mov di,offset inf1 + call hexasc + mov ax,bx ;convert offset of device header. + mov di,offset inf2 + call hexasc + mov ax,es:[bx+4] ;get attribute word, save a + push ax ;copy of it, then convert it. + mov di,offset inf3 + call hexasc + mov ax,es:[bx+6] ;convert ptr to device strategy. + mov di,offset inf4 + call hexasc + mov ax,es:[bx+8] ;convert ptr to device int handler. + mov di,offset inf5 + call hexasc + + ;if not char device, clear out name + ;field and set number of units. + pop ax ;get back attribute word. + test ax,08000h ;is bit 15 = 1 ? + jnz prdev7 ;yes, it's character dev, jump. + ;no, it's block device. + ;set flag to skip device name. + mov byte ptr inf8,eom + mov al,es:[bx+10] ;pick up number of units. + aam ;convert to ASCII decimal and + add ax,'00' ;store into output string. + mov byte ptr inf7+1,al + mov byte ptr inf7,ah + ;set type = B for Block + mov byte ptr inf6,'B' + jmp prdev9 + +prdev7: ;if char device, move its 8-character + ;name into the output string. + xor si,si +prdev8: mov al,es:[si+bx+10] + mov [si+inf8],al + inc si + cmp si,8 + jne prdev8 + ;remove # of units field. + mov word ptr inf7,' ' + ;set type = C for Character. + mov byte ptr inf6,'C' + +prdev9: mov dx,offset inf ;now print device information + mov ah,9 ;and exit. + int 21h + ret +prdev endp + +hexasc proc near ;convert binary word to hex ASCII. + ;call with AX=binary value + ; DI=addr to store string + ;returns AX, CX, DI destroyed. + push ax ;save copy of original value. + mov al,ah + call btoa ;convert upper byte. + add di,2 ;increment output address. + pop ax + call btoa ;convert lower byte. + ret ;return to caller. +hexasc endp + +btoa proc near ;convert binary byte to hex ASCII. + ;call with AL=binary value + ; DI=addr to store string + ;returns AX, CX destroyed. + mov ah,al ;save lower nibble. + mov cx,4 ;shift right 4 positions + shr al,cl ;to get upper nibble. + call ascii ;convert 4 bits to ASCII equivalent + mov [di],al ;store into output string. + mov al,ah ;get back lower nibble. + and al,0fh + call ascii ;convert 4 bits to ASCII + mov [di+1],al ;and store into output string. + ret ;back to caller. +btoa endp + +ascii proc near ;convert 4 lower bits of AL + add al,'0' ;into the equivalent ASCII char. + cmp al,'9' ;in the range {0...9,A...F} + jle ascii2 ;and return char. in AL. + add al,'A'-'9'-1 ;"fudge factor" for range A-F. +ascii2: ret ;return to caller. +ascii endp + +cseg ends + + +data segment para public 'DATA' + +msg1 db cr,lf + db 'Failed to open NUL device.' + db cr,lf,eom + +msg2 db cr,lf + db 'Requires DOS version 2 or greater.' + db cr,lf,eom + +msg3 db cr,lf + db 'End of device chain.' + db cr,lf,eom + +hdr db cr,lf + db 'Addr Attr ' + db 'Str Int Type Units Name ' + db eom + + +inf db cr,lf +inf1 db 'XXXX:' ;seg device header +inf2 db 'XXXX ' ;offs device header +inf3 db 'XXXX ' ;attribute +inf4 db 'XXXX ' ;strategy +inf5 db 'XXXX ' ;interrupt handler +inf6 db 'X ' ;type (block or char) +inf7 db 'XX ' ;units (if block device) +inf8 db ' ' ;name (if char device) + db eom + + ;fcb to open NUL device +nulfcb db 0 ;drive + db 'NUL' ;name of NUL device + db 8 dup (' ') + db 25 dup (0) +data ends + + +stack segment para stack 'STACK' + db 64 dup (?) +stack ends + + end dev \ No newline at end of file diff --git a/assembly/Serial communications port interupt intercepter AHA 8502.27.asm b/assembly/Serial communications port interupt intercepter AHA 8502.27.asm new file mode 100644 index 0000000..5ab23ff --- /dev/null +++ b/assembly/Serial communications port interupt intercepter AHA 8502.27.asm @@ -0,0 +1,96 @@ +; +; Functions: +; al=0 then Disable communications interupt vector +; al=1 then Enable communications interupt vector +; Issue and int 44h +; +progseg segment para public 'CODE' + public setcom + assume cs:progseg, ds:progseg, es:progseg + org 100h +doscall equ 21h +; +startup proc far + jmp setup +; +setcom proc far + push ds + push es + push dx + push ax + mov ax,cs + mov ds,ax + mov es,ax + pop ax + cmp al,1 ;is function 1 + jz enable ;then enable +; +disable: + mov dx,offset interupt ;get new vector address + mov ax,cs + mov ds,ax ;set segment + mov ah,25h ;set interupt vector address function + mov al,14h ;communications interupt vector + int doscall ;set the interupt + jmp exit ;exit +enable: + mov dx,word ptr vector ;set old segment + mov ds,vector+2 ;set old communications vector + mov ah,25h ;set interupt vector address function + mov al,14h ;communications interupt vector + int doscall +exit: + pop dx + pop es + pop ds +; +interupt proc far + sub ax,ax ;zero return status + iret +interupt endp +setcom endp +; +msg db 'Serial communications intercepter installed',0ah,0dh,'$' +msg1 db 'Serial communications intercepter is already installed',0ah,0dh,'$' +vector db 8 dup(0) ;only 4 needed 4 more for safety +; +setup: + mov ah,35h ;get interupt vector address function + mov al,44h ;communications interupt vector + int doscall ;go get it + cmp bx,0 ;check if vector used + jnz lderr ;if used then exit + mov ax,es ;check segment + cmp ax,0 + jnz lderr +; + mov dx,offset msg + mov ah,9 + int doscall +; + mov ah,35h ;get interupt vector address function + mov al,14h ;communications interupt vector + int doscall ;go get it +; + mov word ptr vector,bx ;save offset + mov bx,es ;get segment address + mov word ptr vector+2,bx ;save segment +; + mov dx,offset setcom ;get new vector address + mov ax,cs + mov ds,ax ;set segment + mov ah,25h ;set interupt vector address function + mov al,44h ;set to our new interupt vector + int doscall ;set the interupt +; + mov dx,offset setup ;terminate and stay resident + int 27h +lderr: + mov dx,offset msg1 + mov ah,9 + int doscall + int 20h +startup endp +progseg ends +; + end startup \ No newline at end of file diff --git a/assembly/Sets up 'flat real mode'.asm b/assembly/Sets up 'flat real mode'.asm new file mode 100644 index 0000000..8035268 --- /dev/null +++ b/assembly/Sets up 'flat real mode'.asm @@ -0,0 +1,96 @@ +; flatmode.asm +; +; This program demonstrates flat real mode, which is simply real mode +; with 4G descriptors for some segments. In this code it's done by +; going into protected mode, setting the FS register to a descriptor +; with 4G limits and then returning to real mode. The protected mode +; limit stays in effect, giving "flat real mode." +; +; The demonstration part of this code writes the first 160 bytes from +; the system ROM at F0000h (linear) to the color screen which is assumed +; to be at B8000h (linear) using a flat real mode selector. Since that +; range of the system ROM typically contains a copyright notice, one +; can easily see that the code is truly working as advertised. +; +; This code is intended to be run on a Pentium or better. +; +; To assemble: +; +; using Microsoft's MASM 6.11 or better +; ml /Fl flatmode.asm +; +;---------------------------------------------------------------------- + .model tiny + .code + .586P + +DESC386 STRUC + limlo dw ? + baselo dw ? + basemid db ? + dpltype db ? ; p(1) dpl(2) s(1) type(4) + limhi db ? ; g(1) d/b(1) 0(1) avl(1) lim(4) + basehi db ? +DESC386 ENDS + +;---------------------------------------------------------------------- + ORG 100h +start: + call flatmode ; go into flat real mode (fs reg only) +; mov dx,5 ; +; mov fs,dx ; + call fillscreen ; fill the screen using 4G descriptor + mov ax,4c00h ; do a standard DOS exit + int 21h ; +;---------------------------------------------------------------------- +fillscreen proc + mov esi,0F0050h ; point to ROM +ifdef BEROSET + mov edi,0B8000h ; point to screen +else + mov di,0b800h ; + mov es,di ; + xor edi,edi ; +endif + mov cx,160 ; just two lines + mov ah,1Eh ; yellow on blue screen attrib +myloop: + mov al,fs:[esi] ; read ROM byte +ifdef BEROSET + mov fs:[edi],ax ; store to screen with attribute +else + mov es:[di],ax ; store to screen with attribute +endif + inc esi ; increment source ptr + inc edi ; increment dest ptr by two + inc edi ; + loop myloop ; keep going + ret ; and quit +fillscreen endp +;---------------------------------------------------------------------- +flatmode proc + ; first, calculate the linear address of GDT + xor edx,edx ; clear edx + xor eax,eax ; clear edx + mov dx,ds ; get the data segment + shl edx,4 ; shift it over a bit + add dword ptr [gdt+2],edx ; store as GDT linear base addr + + ; now load the GDT into the GDTR + lgdt fword ptr gdt ; load GDT base (286-style 24-bit load) + mov bx,1 * size DESC386 ; point to first descriptor + mov eax,cr0 ; prepare to enter protected mode + or al,1 ; flip the PE bit + cli ; turn off interrupts + mov cr0,eax ; we're now in protected mode + mov fs,bx ; load the FS segment register + and al,0FEh ; clear the PE bit again + mov cr0,eax ; back to real mode + sti ; resume handling interrupts + ret ; +flatmode endp +;---------------------------------------------------------------------- +GDT DESC386 ; the GDT itself + DESC386 <0ffffh, 0, 0, 091h, 0cfh, 0> ; 4G data segment +GDT_END: +end start \ No newline at end of file diff --git a/assembly/Show Memory.asm b/assembly/Show Memory.asm new file mode 100644 index 0000000..696705a --- /dev/null +++ b/assembly/Show Memory.asm @@ -0,0 +1,283 @@ +kbd equ 16h ;keyboard irq +msdos equ 21h ;MSDOS irq + +reset equ 0dh ;disk reset +dfopen equ 0fh ;open disk file +dfclose equ 10h ;close disk file +searchf equ 11h ;search first +searchn equ 12h ;search next +seqread equ 14h ;sequential disk read +seqwrite equ 15h ; " " write +setdta equ 1ah ;set disk transfer area address +createf equ 3ch ;create file with handle +openf equ 3dh ;open file with handle +closef equ 3eh ;close file with handle +readf equ 3fh ;read from file with handle +writef equ 40h ;write to file with handle +setfp equ 42h ;set file pointer +allocmem equ 48h ;allocate memory +freemem equ 49h ;free memory +changebs equ 4ah ;change block size +findfirst equ 4eh ;find first file +exit equ 4c00h ;msdos exit + +[BITS 16] ;NASM stuff +[ORG 0x100] + +s1: + mov ax,cs ;get code segment + mov ds,ax ;use it now + mov [comseg],ds ;save it there + + mov si,0080h ;DOS command line page 0 + lodsb ;load size of command line + cmp al,0 ;anything on command line ? + jbe usage ;noo, show usage + cbw ;extend AL to AX + xchg bx,ax ;swap size to bx for indexing + mov byte [bx+si],0 ;null terminate command line + call parse ;parse command line + jmp main ;go on with main +usage: mov bx,utext ;pointer usage text + jmp errout ;skip this +main: + mov si,inbuff ;check for valid HEX input + mov bx,errt1 ;proper text +ishex: lodsb ;get the char + cmp al,'0' + jb errout + and al,0dfh ;force UPPERCASE + cmp al,'F' ;>F ? + ja errout ;yeahh, dump this + loop ishex + call hexbin ;make hex bin + ;start address now in EDX + mov ax,dx ;get low word (segment) + mov es,ax ;start segment + shr edx,16 ;shift in offset + mov di,dx ;start offset +dopage: + push es ;save registers + push di + push ds + push si + mov ax,es + mov ds,ax ;make ds=es + mov si,di ;and si=di + + call showpage ;show it + + pop si ;restore registers + pop ds + pop di + pop es + add di,512 ;adjust memory position + + ;xor ah,ah ;wait for ANY key + ;int kbd + + mov bx,text ;show message + call write + mov ah,0 ;wanna see next screen ? + int kbd ;chek out keyboard buffer + and al,0DFh ;force UPPER CASE + cmp al,"Q" ;wanna quit ? + je quit ;yeahh + jmp dopage +errout: + call write +quit: + mov ax,exit + int msdos + +;*********************************************************** +;* Convert ascii hex to 32 bit binary +;* Input = command line buffer, output EDX +;*********************************************************** +hexbin: + mov si,inbuff ;pointer command line buffer + xor edx,edx ;clear binary output +aschexbin: + lodsb + cmp al,'0' ;< 0 + jb notasc ;yes invalid character + cmp al,'9' ;<= 9 + jbe astrip ;yes, strip high 4 bits + and al,05fh ;force upper case + cmp al,'A' ;< ascii A + jb notasc ;yes, invalid character + cmp al,'F' ;> ascii F + ja notasc ;yes, invalid character + add al,9 ;ok, add 9 for strip +astrip: + and al,0fh ;strip high 4 bits + mov cx,4 ;set shift count + shl edx,cl ;rotate EDX 4 bits + xor ah,ah ;zero out AH + cbw + add edx,eax ;add digit to value + jmp aschexbin ;continue +notasc: ret + +;********************************************************************* +;* Format and show the stuff in a "sector" +;* Input SI +;********************************************************************* +showpage: + mov cx,32 ;32*16=512 +arow: push cx + mov di,outline ;output buffer + mov cx,16 ;process 16 bytes +hexrow: push cx + lodsb ;load al with byte + mov dl,al ;get value + mov cx,2 ;2 nibbles +chexb: push cx ;save that + mov cl,4 ;4 bits + rol dl,cl ;rotate source left + mov al,dl ;move digit into AL + and al,15 ;clear high nibble + daa ;adjust AL if A through F + add al,240 ;bump the carry + adc al,40h ;convert HEX to ASCII + stosb ;copy to buffer + pop cx ;get digit counter + loop chexb ;next digit + mov al,32 ;copy a SPACE + stosb + pop cx ;restore loop counter + loop hexrow ;loop on + mov al,32 ;copy 2 spaces + stosb + stosb + sub si,16 ;adjust source back + mov cx,16 ;copy ASCII bytes +cccp: lodsb + cmp al,32 ;< SPACE ? + jb noa ;yeahh, skip it + stosb ;no, store in buffer + jmp next +noa: mov al,'.' + stosb +next loop cccp + mov al,13 + stosb + mov al,10 + stosb + mov al,0 ;null terminate line + stosb + mov bx,outline ;show the line + call write + pop cx + cmp cx,17 + jne nopause + push ds + mov ax,cs + mov ds,ax + mov bx,text1 + call write + pop ds + xor ah,ah + int kbd +nopause: + loop arow ;next 16 bytes + ret + +;************************************************************************' +;* Convert bin WORD to HEX ascii. Input DX. Result in Numbuff * +;************************************************************************ +binhex: pusha + mov di,numbuff ;destination buffer + mov dx,[count] ;binary number + mov cx,4 ;four nibbles +convhex: + push cx ;save counter + mov cl, 4 ;4 bits + rol dx, cl ;rotate source left + mov al, dl ;move digit into AL + and al, 15 ;clear high nibble + daa ;adjust AL if A through F + add al, 240 ;bump the carry + adc al, 40h ;convert HEX to ASCII + stosb ;copy to buffer + pop cx ;get digit counter + loop convhex ;next digit + mov al,32 ;copy a space + stosb + mov al,0 ;null terminate + stosb + popa + ret + +;************************************************************************* +;* Writes out the NULL terminated text supplied in BX. * +;* OR writes out data,BX and size,CX if called at lwrite. * +;************************************************************************* +write: pusha + mov si,bx ;copy to SI + mov cx,0 ;clear count +wloop: lodsb ;load AL with SI + cmp al,0 ;end of line ? + je lwrite ;yeahh + inc cx ;no, incrase byte count + jmp wloop ;test next byte +lwrite: mov dx,bx ;text address in DX + mov bx,1 ;filehandle standard output = 1 + mov ah,writef ;MS-DOS writefile with handle is 040 + int msdos ;write buffer to standard output + popa + ret ;done + +;************************************************************************* +;* My kind of command line parsing. It just checks if there�s +;* any blankspaces between the options. The parameters ends up +;* in the inbuff separated by 0:s, binary zeroes. +;************************************************************************* +parse: + mov di,inbuff ;our buffer +ifspc: cmp byte [si],32 ;leading space ? + jne nospc ;noo + inc si ;yeahh, dump that + jmp ifspc ;check next +nospc: mov cx,1 ;were here, so we got one arg +copy1: lodsb ;load byte SI to AL + cmp al,0 ;0 ?(end of line) + je done ;yeahh + cmp al,32 ;SPACE ? + je cop2 ;yeah + stosb ;noo, move AL to DI, incrase DI + jmp copy1 ;go on +cop2: mov byte [di],0 ;null terminate + add cx,1 + inc di ;dump that byte(SPACE) + jmp copy1 ;back +done: mov byte [di],0 ;null terminate + ret ;return + + +;*************************** DATA STUFF ********************************** + +XMS_SEGMENT dw 0 +XMS_OFFSET dw 0 + +inbuff times 64 dw 0 ;128 byte command line buffer +outline times 40 dw 0 ;buffer output line +numbuff times 7 dw 0 ;word ascii number buffer +comseg dw 0 +count dw 0 +bcount dw 0 +acount dw 0 + +;outbuff times 512 db 0 + + +utext db 'WWW',13,10 + db 'Usage: Showmem [start address].',13,10 + db 'Start address = Hexadecimal.',13,10,0 +text: db 13,10,'Q = Quit. Any key = Next page.',13,10,0 +text1: db 13,10,'Any Key = Next 256 Bytes.',13,10,0 +errt1: db 'That address is not hexadecimal.',13,10,0 + +s2: + +END \ No newline at end of file diff --git a/assembly/Shows a demonstration of a routine which scrolls a window on a text mode screen.asm b/assembly/Shows a demonstration of a routine which scrolls a window on a text mode screen.asm new file mode 100644 index 0000000..e36720d --- /dev/null +++ b/assembly/Shows a demonstration of a routine which scrolls a window on a text mode screen.asm @@ -0,0 +1,188 @@ +%SUBTTL "Scroll Window Left routine with sample driver" +; +; Scroll2.Asm +; +; see ScrollLeft description for complete explanation of this program +; + MODEL small + IDEAL + STACK 200h ; this is more than enough stack + CODESEG +start: +; +; this test stub scrolls the window at (4,3)-(22,68) left 9 columns, +; filling in with spaces of attribute white on black (07) +; + mov al,9 ; number of columns to scroll + mov bh,07 ; attribute to use for blanked chars + mov ch,4 ; row of upper left hand corner of window + mov cl,3 ; col of upper left hand corner of window + mov dh,22 ; row of lower right hand corner of window + mov dl,68 ; col of lower right hand corner of window + + call ScrollLeft + + mov ah,4ch ; exit with errorlevel from scroll routine + int 21h +; +; ScrollLeft +; +; PURPOSE: scrolls a rectangular region of a text screen (window) to the +; left by a variable number of columns +; +; +; INPUTS: AL = number of columns to scroll (if zero, no effect) +; BH = attribute to use for blanked characters +; CH,CL = row, col for upper left hand corner of window +; DH,DL = row, col for lower right hand corner of window +; +; NOTES: upper left hand corner of screen (home) is (0,0) +; video adapter is checked to see if it's in text mode +; screen dimensions are taken from BIOS data +; calling sequence is nearly identical to BIOS scroll routine +; display pages supported +; dual monitors supported +; MDA/CGA/EGA/VGA supported +; +; RETURNS: On error, Carry flag set, AX contains error number +; otherwise carry is clear, AX contains 0 +; +; Error codes: 0 - no error +; -1 - some error occurred +; +PROC ScrollLeft + ScrRows equ 0484h ; location of BIOS rows data + ScrCols equ 044ah ; location of BIOS cols data + ScrMode equ 0449h ; location of BIOS mode data + ScrOffs equ 044eh ; location of BIOS scrn offset data + +; first, save all of the registers we're going to trash + push bx + push cx + push dx + push si + push di + push bp + push es + push ds + + mov bl,al ; stow cols in BL + xor ax,ax + mov ds,ax ; point data seg to 0000 to read BIOS data + cmp ch,dh ; srow > erow ? + ja @@badcoords + cmp cl,dl ; scol > ecol ? + ja @@badcoords +; +; now we need to load ScrRows, if we haven't got EGA or better +; + mov al,[ScrRows] ; is MAXROWS = 0 ? + cmp al,0 ; if so, then assume we've got MDA or CGA + jne @@ega_plus ; if not, we've got correct value already + mov al,24 ; otherwise, assume 25 rows (and load 25-1) +@@ega_plus: + cmp dh,al ; erow >= MAXROWS? +; +; note that BIOS actually stores MAXROWS-1 in this location, so the +; actual jump instruction is (correctly) written as ja +; + ja @@badcoords + cmp dl,[ScrCols] ; ecol >= MAXCOLS? + jae @@badcoords + mov ah,bl ; remember cols + add ah,cl ; cols + scol + cmp ah,dl ; (cols + scol) > ecol ? + ja @@badcoords + +; figure out where the video buffer starts + mov bp,0b800h ; first guess + mov al,[ScrMode] ; get mode from BIOS' RAM + cmp al,4 ; if mode is 0 through 3, we're all set + jb @@modeOK + mov bp,0b000h ; second guess + cmp al,7 ; is it mode 7 (monochrome 80 col) ? + je @@modeOK ; if so, we're still OK +@@badcoords: + mov ax,-1 ; set error code + stc ; and set error (carry) flag + jmp @@exit +@@modeOK: + mov es,bp ; set up our video pointer segment + +; ES:DI = endloc = Screen + 2 * (MAXCOLS * srow + scol) + + mov di,[ScrOffs] ; offset of screen buffer + xor ah,ah ; clear out high half of AX + mov al,[ScrCols] ; get the width of the screen + mul ch ; multiply width by the row number + add al,cl ; now add the column number + adc ah,0 ; propagate carry bit to other half of AX + shl ax,1 ; now multiply by 2 bytes/char + add di,ax ; add the offset to the screen start address + +; DS:DI = startloc = endloc + 2 * cols + + xor ah,ah ; clear top half of ax + mov al,bl ; recall cols + mov si,di ; start address = end address + add si,ax ; add cols + add si,ax ; and again + +; start on count calculation (figure ecol-scol+1) + sub dl,cl ; ecol - scol + inc dl ; now dl = ecol - scol + 1 + +; calculate increment and stow in BP +; increment = (MAXCOLS - (ecol - scol + 1)) * 2 + xor ah,ah ; clear top half of ax + mov al,dl ; use partial count calculation + neg ax + add al,[ScrCols] ; now add in screen width + adc ah,0 ; propagate carry bit to hi half of AX + shl ax,1 ; now double it (2 bytes/char) + mov bp,ax + +; finish count calculations and put in DL +; count = (ecol - scol + 1) - cols + + sub dl,bl ; figure in cols + + mov ax,es ; recall our video pointer + mov ds,ax ; now duplicate it + +; load up AX with char and attribute for blank space + mov al,32 ; ASCII space character + mov ah,bh ; passed attribute byte + + sub dh,ch ; get row count + mov dh,bh ; save loop count (rows to move) in bh + xor ch,ch ; zero out hi half of CX + cld ; assure that we move the right direction (up) +@@looptop: + mov cl,dl ; load in count (words to move) + rep movsw ; move the line over + mov cl,bl ; recall cols (blanks to insert) + rep stosw ; fill in the rest of the line + add di,bp ; advance to next line by adding increment + mov si,di ; now set up the other (source) pointer + mov cl,bl ; recall cols + add si,cx ; add in cols + add si,cx ; and again (because 2 bytes/char) + dec bh ; decrement loop counter + ja @@looptop ; skip back if we're not done yet + mov ax,0 ; set error code to zero (all OK) + clc ; and clear error (carry) flag +@@exit: + pop ds ; restore all of our registers + pop es + pop bp + pop di + pop si + pop dx + pop cx + pop bx + ret ; mosey on home again + +ENDP ScrollLeft + END start +-+------- cut here ----------- diff --git a/assembly/Shows one possible method for checking the type of video card installed in a system.asm b/assembly/Shows one possible method for checking the type of video card installed in a system.asm new file mode 100644 index 0000000..564a360 --- /dev/null +++ b/assembly/Shows one possible method for checking the type of video card installed in a system.asm @@ -0,0 +1,154 @@ +comment ^ + Sample code to show how one might detect video cards by + using search strings. +^ + .model small + .stack 400h + .data +;/*************************************************************************** +; some handy equates +;***************************************************************************/ +VID_BIOS_SEG equ 0c000h ; the video BIOS segment + +SEARCH_AREA equ 0400h ; when we look for the video BIOS + ; ID, we only seach this many bytes + +CMP_LENGTH equ 7 ; the number of "significant" + ; characters to compare in each + ; string + +DOS_INT equ 21h ; DOS' interrupt +VIDEO_INT equ 10h ; BIOS' video services int + +VID_80x25 equ 03h ; 80x25 text mode number + +;/*************************************************************************** +; data +;***************************************************************************/ +UnknownCardMsg db 'Your video card is not supported.',13,10,'$' + +mode1 db 053h ; 640 x 480 x 256 mode for Oak +card1 db 'OAK VGA','$' +mode2 db 05dh ; 640 x 480 x 256 mode for Trident +card2 db 'TRIDENT','$' + +cards dw card1, card2, 0 + +;/*************************************************************************** +; some handy macros +;***************************************************************************/ +@DosPrint MACRO msgptr + mov dx,msgptr ; handy macro for printing + mov ah,9 ; '$' terminated strings + int DOS_INT ; under DOS +ENDM + +@SetVidMode MACRO vmode + ifnb + mov ax,(vmode AND 0ffh) + else + xor ah,ah + endif + int VIDEO_INT +ENDM + + .code +;/*************************************************************************** +; main +; This is the main procedure in the code. It identifies (or +; attempts to identify) the type of video card, then switches into +; the appropriate video mode for that type of card. Right now, it +; doesn't actually do anything in that mode, but simply returns +; and restores the video mode to a fairly standard 80x25 text +; mode. Mostly as an aid to troubleshooting, the current version +; also prints out the name of the video card as discovered in the +; video BIOS area. +; +;***************************************************************************/ +main proc + .STARTUP ; do the usual startup stuff + call IDVideoBios ; identify video BIOS + or si,si ; Q: unknown card? + jz NoSupport ; Y: tell the user the bad news + dec si ; point to video mode (mode1, mode2) + lodsb ; load into al & increment si + @SetVidMode ; change video mode +; +; snazzy graphics code goes here +; + @SetVidMode ; switch back to 80x25 text mode + @DosPrint ; print ID string + .EXIT 0 ; exit with error code = 0 + +NoSupport: + @DosPrint ; print unknown card message + .EXIT 1 ; exit with error code = 1 +main endp + +;/*************************************************************************** +; IDVideoBios +; +; This procedure searches the first SEARCH_AREA bytes in the video +; BIOS for a byte sequence which uniquely identifies a video +; card's manufacturer. If no known card name is found, the +; function returns a null pointer. +; +; Entry: DS contains the segment of the cards array +; +; Exit: If a match was found, +; DS:SI ==> matching sequence +; otherwise +; SI = 0 +; +; Destroyed: none +; +;***************************************************************************/ +IDVideoBios proc + push ax ; save used regs + push bx ; + push cx ; + push es ; + mov ax,VID_BIOS_SEG ; point to video BIOS + mov es,ax ; + mov bx,OFFSET cards ; point to first card entry + cld ; we'll be scanning forward +next_card: + mov si,[bx] ; + or si,si ; Q: is it a NULL pointer? + jz @@exit ; Y: we're done, so exit now + xor di,di ; es:di ==> video BIOS area + mov cx,SEARCH_AREA ; + mov al,[si] ; get the first letter +scan: + repne scasb ; scan for AL in es:di + jnz nofind ; if we didn't find it, skip over +; +; if we got here, ES:DI points to one letter after the matching letter +; in the video BIOS. We need to compare the rest to assure that we have +; a complete match. +; + push cx ; temporarily save regs + push di ; + push si ; + inc si ; point to next letter + mov cx,CMP_LENGTH-1 ; compare the rest the string + repe cmpsb ; do it + pop si ; restore regs + pop di ; + pop cx ; + jz @@exit ; if match, we're done +nofind: + or cx,cx ; Q: is the count down to zero? + jnz scan ; N: keep scanning + inc bx ; Y: point to next card + inc bx ; point to next card entry + jmp next_card ; go back for more +@@exit: + pop es ; restore used registers + pop cx ; + pop bx ; + pop ax ; + ret ; +IDVideoBios endp + + end \ No newline at end of file diff --git a/assembly/Subroutine called by a basic program to scroll a window.asm b/assembly/Subroutine called by a basic program to scroll a window.asm new file mode 100644 index 0000000..3d34c7b --- /dev/null +++ b/assembly/Subroutine called by a basic program to scroll a window.asm @@ -0,0 +1,117 @@ +; +; +DGROUP GROUP DATASEG +DATASEG SEGMENT PARA PUBLIC 'DATA' +FUNCT DW 0 ;function 1=6,0=7 +FG_COLR DW 0 ;forground color +BG_COLR DW 0 ;backround color +LINES DW 0 ;number of lines to scroll or 0 for clear +ULROW DW 0 ;upper left row +ULCOL DW 0 ;upper left column +LRROW DW 0 ;lower right row +LRCOL DW 0 ;lower left column +ATTRIB DB 0 ;temp hold for attribute byte +CALNU DB 0 ;temp hold for call function 6 or 7 +DATASEG ENDS +; +CSEG SEGMENT 'CODE' + ASSUME CS:CSEG + PUBLIC CLR +CLR PROC FAR + PUSH BP ;BP unknown (don't care) + MOV BP,SP ;set base for parm list + PUSH DS ;DS -> basic work area + PUSH ES ;ES -> basic work area + MOV AX,DATASEG ;establish data addressability + MOV DS,AX ;now DS -> my data + ASSUME DS:DATASEG +; +; + MOV SI,SS:[BP+6] ;get addr of parameter + MOV AX,ES:[SI] ;get value of parm + MOV FUNCT,AX + MOV SI,SS:[BP+8] ;get addr of parameter + MOV AX,ES:[SI] ;get value of parm + MOV BG_COLR,AX + MOV SI,SS:[BP+10] ;get addr of parameter + MOV AX,ES:[SI] ;get value of parm + MOV FG_COLR,AX + MOV SI,SS:[BP+12] ;get addr of parameter + MOV AX,ES:[SI] ;get value of parm + MOV LINES,AX + MOV SI,SS:[BP+14] ;get addr of parameter + MOV AX,ES:[SI] ;get value of parm + MOV ULROW,AX + MOV SI,SS:[BP+16] ;get addr of parameter + MOV AX,ES:[SI] ;get value of parm + MOV ULCOL,AX + MOV SI,SS:[BP+18] ;get addr of parameter + MOV AX,ES:[SI] ;get value of parm + MOV LRROW,AX + MOV SI,SS:[BP+20] ;get addr of parameter + MOV AX,ES:[SI] ;get value of parm + MOV LRCOL,AX +; + MOV AX,1 + SUB LRROW,AX ;convert 1-80 cols + SUB LRCOL,AX ; and 1-25 rows into + SUB ULROW,AX ; 0-79 cols and + SUB ULCOL,AX ; 0-24 rows +; +; change forground & backround colors into single attribute byte +; + MOV BX,FG_COLR ;move foreground color to bx + MOV AL,BL ;move lower byte to al + MOV BX,BG_COLR ;move backround color to bx + MOV AH,BL ;move lower byte to ah + CMP AL,15 ;check for color > 15 ie blinking + JG BLNK ;if > 15 then set blink bit + AND AL,15 ;set normal fg color + JMP N_BLNK ; +BLNK: OR AL,128 ;set blink bit 7 + AND AL,143 ;zero out bit 6,5,4 used for backround +N_BLNK: AND AH,7 ;zero out bit 7,6,5,4,3 used for forground + MOV CL,4 ;4 bit shift count + SHL AH,CL ;shift right 3 bits to pos 6,5,4 + OR AL,AH ;combine for & back to form attribute byte + MOV ATTRIB,AL ;move it to STORAGE + +; +; convert 1 and 0 to 6 and 7 for routine call +; + MOV BX,FUNCT ;move function into bx + CMP BL,0 ;compare to one + JG F6 ;if 1 then function is 6 + MOV AH,7H ;set function 7 + JMP OUT1 ;jump around +F6: MOV AH,6H ;set function 6 +OUT1: MOV CALNU,AH ;move it to storage +; +; +; set up for bios rom call 10 function 6 (scroll up ) +; + PUSH BX + MOV BX,LINES ;set # of lines to scroll or 0 to clear + MOV AL,BL ;put in pass register + MOV BX,ULROW ;set upper left row of block 0-24 + MOV CH,BL ;put in pass register + MOV BX,ULCOL ;set upper left column of block 0-79 + MOV CL,BL ;put in pass register + MOV BX,LRROW ;set lower right row of block 0-24 + MOV DH,BL ;put in pass register + MOV BX,LRCOL ;set lower right column of block 0-79 + MOV DL,BL ;put in pass register + MOV BL,CALNU ;set call number 6 to scroll up 7 down + MOV AH,BL ;put in pass register + MOV BL,ATTRIB ;set color attribute byte + MOV BH,BL ;put in pass register + INT 10H ; make bios call + POP BX +; +FINISH: POP ES + POP DS + POP BP + RET 16 ;return to basic +CLR ENDP +CSEG ENDS + END \ No newline at end of file diff --git a/assembly/Tests for the well documented Pentium divide bug.asm b/assembly/Tests for the well documented Pentium divide bug.asm new file mode 100644 index 0000000..47eece4 --- /dev/null +++ b/assembly/Tests for the well documented Pentium divide bug.asm @@ -0,0 +1,41 @@ +; pentbug.asm +; +; tests for the existence of the well-documented Pentium NPU bug +; +; assemble and run this program using Borland's TASM and run under DOS: +; +; TASM pentbug ; one pass assemble +; TLINK /Tdc pentbug ; link as COM file +; PENTBUG ; run the program... +; + .MODEL tiny + .386 + .387 + + .CODE + ORG 100h +Start: + mov dx,OFFSET okmsg ; start out optimistically + fild [first] ; load the first number (x) + fild [second] ; and the second (y) + fdiv st(1),st ; perform y/x + fmulp st(1),st ; now st(0) = (y/x)*x + fild [first] ; reload y + fcompp ; compare the two + fnstsw ax ; put status word into ax + sahf ; load into CPU flags + jz short @@NoBug ; if they're equal, no bug + mov dx,OFFSET bugmsg ; load bad news message... +@@NoBug: + mov ah,9 ; print appropriate message + int 21h ; + mov ah,4ch ; and exit + int 21h ; + +first DD 4195835 ; "magic numbers" culled from +second DD 3145727 ; the net. There are others... + +okmsg DB "No " +bugmsg DB "Pentium bug found.",13,10,'$' + + END Start \ No newline at end of file diff --git a/assembly/The venerable IBM-370 had a numeric format called packed decimal.asm b/assembly/The venerable IBM-370 had a numeric format called packed decimal.asm new file mode 100644 index 0000000..24b6966 --- /dev/null +++ b/assembly/The venerable IBM-370 had a numeric format called packed decimal.asm @@ -0,0 +1,92 @@ +; bcd.asm +comment ^ + This is a small demonstration program to show how one might + handle the addition of IBM 370-style packed decimal numbers + (which are similar to BCD). This particular program imposes an + arbitrary simplifying limitation by only allowing the addition + of numbers which are both the same sign, but it would be easy to + extend by either converting all negative operands to ten's + complement and adding or by implementing a subtraction routine + (which would use SBB, DAS instead of ADC, DAA). + +^ + .MODEL small ; DOS - small model + .STACK 200h ; allocate a bit of stack + + .DATA +OPLEN equ 4 ; the size of operands & result (bytes) +first db 00h, 01h, 23h, 4Ch ; 1234 in packed decimal +second db 00h, 00h, 00h, 9Ch ; 9 in packed decimal +result db OPLEN dup (?) ; allocate space for result + + .CODE + .STARTUP + mov si,offset first + OPLEN - 1 ; point to first op + mov bx,offset second + OPLEN - 1 ; second op + mov di,ds ; + mov es,di ; load es + mov di,offset result + OPLEN - 1 ; point to result area + mov cx,OPLEN ; how big are they? + call AddPackedDecimal ; add 'em up! + .EXIT 0 +;**************************************************************************** +; AddPackedDecimal +; +; add two 370-style packed decimal numbers with identical signs +; +; Entry: +; DS:SI ==> end of first operand +; DS:BX ==> end of second operand +; ES:DI ==> end of pre-allocated result space +; CX = size of operands, result (in bytes) +; +; Exit: +; if CY set, error occurred +; otherwise, result of addition is in result space +; +; Trashed: +; none +; +;**************************************************************************** +AddPackedDecimal proc + push ax ; save used regs + push bx + push cx + push dx + push di + push si + mov al,[si] ; + mov ah,[bx] ; + mov dx,ax ; + and dx,00f0fh ; use only low nybbles in DX + and ax,0f0f0h ; save high nybbles in AX + cmp dl,dh ; are they identical? + stc ; (assume they're not) + jnz Done ; if not, it's an error + std ; set dir flag (decrement ptrs) + clc ; clear carry flag + push di ; save original DI for later +AddEmUp: ; + adc al,ah ; add (with carry) + daa ; decimal adjust packed BCD + stosb ; save result + lahf ; save carry flag + dec si ; adjust pointer for first op + dec bx ; adjust pointer for second op + sahf ; restore flag + mov al,[si] ; fetch next digits of first op + mov ah,[bx] ; fetch next digits of second op + loop AddEmUp ; do 'em all (CX is counter) + pop di ; restore original DI + jc Done ; if carry, it's an overflow + or [di],dl ; place sign nybble (and clear CY) +Done: ; + pop si ; restore used registers + pop di + pop dx + pop cx + pop bx + pop ax + ret ; +AddPackedDecimal endp + END \ No newline at end of file diff --git a/assembly/This is a simple litte assembler program that cleans out.asm b/assembly/This is a simple litte assembler program that cleans out.asm new file mode 100644 index 0000000..026ea26 --- /dev/null +++ b/assembly/This is a simple litte assembler program that cleans out.asm @@ -0,0 +1,218 @@ +;* This is a simple litte assembler program that cleans out * +;* the documents folder in the start menu. * +;* This is version 1.2 * +;* There's no command line switches and stuff. * +;* It gives NO messages if everything goes allright. * +;* It check for a environment variable called CLEANDIR and CD:s * +;* down to that dir if the variable is found. If not it uses * +;* the default WINDOWS\RECENT directory and deletes(UNLINKS) * +;* EVERYTHING it finds there, and CD:s back to where it started * +;* from. * +;************************************************************************ + + ;some euqates for readability +kbd equ 16h ;keyboard irq +msdos equ 21h ;MSDOS irq + +reset equ 0dh ;disk reset +dfopen equ 0fh ;open disk file +dfclose equ 10h ;close disk file +searchf equ 11h ;search first +searchn equ 12h ;search next +seqread equ 14h ;sequential disk read +seqwrite equ 15h ; " " write +getdisk equ 19h ;get current disk(default) +setdta equ 1ah ;set disk transfer area address +setdir equ 3bh ;set current directory +createf equ 3ch ;create file with handle +openf equ 3dh ;open file with handle +closef equ 3eh ;close file with handle +readf equ 3fh ;read from file with handle +writef equ 40h ;write to file with handle +unlink equ 41h ;UNLINK(delete file) +getdir equ 47h ;get current directory +allocmem equ 48h ;allocate memory +freemem equ 49h ;free memory +changebs equ 4ah ;change block size +findfirst equ 4eh ;find first file +findnext equ 4fh ;find next file +exit equ 4c00h ;msdos exit + +envir equ 2ch ;offset ENVIRONMENT block + +[BITS 16] ;NASM STUFF !? +[ORG 100h] + + mov ax,cs ;get code segment + mov ds,ax ;use it now + mov [comseg],ds + mov [extseg],es + +;************************ setup and preparing *************************** +main: + mov ah,setdta ;set our DTA-area + mov dx,mydta ;buffer for it + int msdos ;call dos + + mov ah,getdisk ;get default drive + int msdos ;call dos + add al,41h ;drive in al, make it ASCII + mov byte [curdir],al ;fill buffer with name (A:..etc) + mov byte [path],al ;and default path + + mov word [curdir+1],":\" ;copy separator to path + mov si,curdir ;pointer path buffer + add si,3 ;offset doscall part + mov ah,getdir ;get current dir + mov dl,0 ;0 = default + int msdos ;call dos + jnc diskok ;ok + mov bx,errt0 ;could not find current dir ?? If You + jmp errout ;get an error here You probably have +diskok: ;forgot to turn on Your computer. + call getenv ;check out if any ENV var + cmp dx,-1 ;was it there + je findfile ;yeahh + mov dx,path ;noo way, use default path + mov ah,setdir ;cd down + int msdos ;call dos + jnc findfile ;all ok + mov bx,errt1 ;error + jmp errout ;skip + +;*************************** the delete file loop *********************** +findfile: + mov ah,findfirst ;see if the files out there + mov cx,0fh ;all files + mov dx,files ;our NULL terminated filname(*.*) + int msdos ;do the stuff + jnc delit ;all ok, must delete first file + jmp goback ;error, CD back and skip +found: ;found something + mov dx,files ;files (*.*) + mov ah,findnext ;the function + int msdos ;call dos + jc goback ;no more files, quit +delit: + mov ah,unlink ;UNLINK (delete) file + mov dx,mydta ;pointer Disk Transfer Area + add dx,30 ;offset Filename + int msdos ;delete it + jnc found ;deleted ok + + mov bx,errt2 ;could not delete it ???? + call write ;let us know + mov bx,mydta ;show wich file + add bx,30 ;offset filename in DTA + call write ;write out filename + mov bx,linefeed ;linefeed + jmp errout ;and skip +goback: + mov ah,setdir ;CD back to origin + mov dx,curdir ;path to dir + int msdos ;do it + jnc quit ;all ok, proceed + mov bx,errt1 ;error, get text + +;*************************** errorexit *********************** +errout: call write ;show errormessage +quit: + xor eax,eax ;clean out that + mov ax,exit ;MS-DOS successful exit + int msdos ;back to the operating system + +;***************** get ENVIRONMENT var if any ***************** +getenv: + push es ;now check if there's any + push ds ;environment variable + + mov es,[es:+2Ch] ;ES:DI points at environment + xor di,di ;which is paragraph-aligned +floop: + cmp byte [es:di],0 ;if we got 2 zeroes in a row + jne goon ;we are at the end of the ENV + cmp byte [es:di+1],0 ;variables + je eout +goon: +equal: cmp byte [es:di],'C' ;is it our variable ? + jne flop + inc byte di + cmp byte [es:di],'L' + jne flop + inc byte di + cmp byte [es:di],'E' + jne flop + inc byte di + cmp byte [es:di],'A' + jne flop + inc byte di + cmp byte [es:di],'N' + jne flop + inc byte di + cmp byte [es:di],'D' + jne flop + inc byte di + cmp byte [es:di],'I' + jne flop + inc byte di + cmp byte [es:di],'R' + jne flop +sign: inc byte di ;dump the R + inc byte di ;dump the = + + mov ax,es ;make DS:DX point to string we found + mov ds,ax + mov si,di + mov bx,si + mov dx,bx + mov ah,setdir ;func Set Current Directory(CD) + int msdos ;do it + jnc envok ;all ok, proceed + mov dx,0 ;clear flag (use default dir) + jmp eout ;return + +flop: inc byte di ;next byte + cmp byte [es:di],0 ;a 0 ? + jne flop ;noo + inc byte di ;yeahh, dump it + jmp floop ;check if two +envok: mov dx,-1 +eout: pop ds + pop es + ret + +;************************************************************************* +;* Writes out the NULL terminated text supplied in BX. * +;* OR writes out data,BX and size,CX if called at lwrite. * +;************************************************************************* +write: pusha + mov si,bx ;copy to SI + mov cx,0 ;clear count +wloop: lodsb ;load AL with SI + cmp al,0 ;end of line ? + je lwrite ;yeahh + inc cx ;no, incrase byte count + jmp wloop ;test next byte +lwrite: mov dx,bx ;text address in DX + mov bx,1 ;filehandle standard output = 1 + mov ah,writef ;MS-DOS writefile with handle is 040 + int msdos ;write buffer to standard output + popa + ret ;done + +;************************ DATA and BSS stuff *************************** + +comseg: dw 0 +extseg: dw 0 +utext: db "XXX",13,10,0 +errt0: db "Could not find current directory !",13,10,0 +errt1: db "Directory not found.",13,10,0 +errt2: db "Could not delete ",0 +path: db " :\WINDOWS\RECENT",0 ;default path without DRIVE +files: db "*.*",0 +linefeed: db 13,10,0 + +mydta times 128 db 0 ;use 128 bytes as DTA NASM stuff ! +curdir times 68 db 0 ;use 64 + 4 bytes for current dir + + END \ No newline at end of file diff --git a/assembly/This is a small sound example for the IBM PC.asm b/assembly/This is a small sound example for the IBM PC.asm new file mode 100644 index 0000000..7913c4e --- /dev/null +++ b/assembly/This is a small sound example for the IBM PC.asm @@ -0,0 +1,90 @@ +; It will play 12 notes of the octave starting at middle C. +;----------------------------------------------------------------------------- +; How to generate sound on the IBM PC : +; +; The 8255 (port 61H) bit 0 controls the 8253 timer +; bit 1 controls the speaker +; +; The output channel 2 from the 8253 timer will be ANDed with the +; speaker control bit in order to turn on/off the speaker. +; +; Timer channel 2 internal count register (port 42h) is loaded in +; two successive OUT operations with the lower byte being loaded first. +; For this to work properly, timer command register has to be loaded first +; with B6H. +; +; Since the input clock to the timer chip is 1.19318 MHz, the counter value +; to generate the frequency X can be calculated by 1193180 / X. +;----------------------------------------------------------------------------- +; CX is used as a note counter with the frequency effectively being +; incremented by a half tone and the corresponding count being loaded +; into the count register on each iteration. +; +; No stack segment is needed for this small program, so don't panic +; when you receive the 'No stack segment' warning. +; +; Arne Asplem 880731 (MASM 4.0) + + + +dseg segment ; data segment +notes dw 262,277,294,311,330,349,370,392,415,440,466,494 +dseg ends + +cseg segment + +sound proc far + assume cs:cseg, ds:dseg, ss:nothing + +start: + mov ax, dseg + mov ds, ax ; set up data segment (DS) reg. + xor si, si + mov bx, 12 ; note count + +; set up timer command register and counter register + + mov al, 0b6h ; set 8253 command register + out 43h, al ; for channel 2, mode 3 + +nloop: + mov ax, 34dch ; low part of clock freq. + mov dx, 12h ; hight part of clock freq. + div [notes + si] ; get note from data segment + out 42h, al ; 8253 command register (low byte) + mov al, ah + out 42h, al ; 8253 command regsieter (high byte) + +; turn on low bits in 8255 output port + + in al, 61h ; read current value of 8255 port + or al, 3 ; clear low bits + out 61h, al ; send new value to port + +; loop while note is sounding + + mov cx, 6d60h + +rpta: + loop rpta ; 1/10 sec delay + +; turn off speaker, check note count, set up next note + + xor al, 3 + out 61h, al ; turn off speaker + mov cx, 0af0h + +rptb: + loop rptb ; 1/100 sec delay + inc si ; increment note pointer + inc si + dec bx ; decrement note counter + + jnz nloop ; loop until bx = 0 + + mov ax, 4c00h ; terminate program + int 21h + +sound endp +cseg ends + end start \ No newline at end of file diff --git a/assembly/This program is used to set the PSP address for a compiled BASIC program The PSP segment is saved at 0-4F2H.asm b/assembly/This program is used to set the PSP address for a compiled BASIC program The PSP segment is saved at 0-4F2H.asm new file mode 100644 index 0000000..dcab3a0 --- /dev/null +++ b/assembly/This program is used to set the PSP address for a compiled BASIC program The PSP segment is saved at 0-4F2H.asm @@ -0,0 +1,94 @@ +extrn $$main:far +cseg segment para public 'code' + + +; It can also be used to limit the maximum memory available to a compiled +; BASIC program. The option '/M:nnn' is used on the command line, where +; nnn is the number of K-bytes the program is limited to. If no, /M option +; is specified, no memory limitation takes place. For example, '/M:64' would +; limit the program to 64*1024 bytes. The range for nnn is 64 to 1024. + +; This routine gets control before BASIC, does its handiwork, and then +; passes control to the BASIC program. It must be linked as follows: +; LINK BASMAIN+yourprog,yourprog,NUL.MAP,BASCOM + +; If BASMAIN is unable to limit memory as requested, a message is displayed +; and the execution of the program is continued. + +public basmain +basmain proc far + assume cs:cseg,ds:cseg,ss:nothing,es:nothing + + push ds ; save ds + xor ax,ax + mov ds,ax ; ds=0 + mov si,4f2h ; dos communications area + mov ax,es ; get psp seg + mov [si],ax ; save psp in dos comm area + pop ds ; restore ds + mov si,80h ; point to command line + mov ch,0 + mov cl,[si] ; get length of command line + jcxz p025 ; it's zero + +p010: inc si + mov al,[si] ; get char from command line + cmp al,'/' ; is it a slash? + jnz p020 ; no + mov ax,[si+1] ; get next 2 chars + cmp ax,':M' ; is it M: ? + jz p030 ; yes + cmp ax,':m' ; is it m: ? + jz p030 ; yes + +p020: loop p010 ; check next char +p025: jmp p080 ; no /m: or /M: found + +p030: ; found /m: or /M: + add si,3 ; point to first number + mov ax,0 + mov bx,0 + mov cx,10 +p040: mov bl,[si] ; get character + cmp bl,'0' ; out of range? + jb p050 ; yes + cmp bl,'9' ; out of range? + ja p050 ; yes + sub bl,'0' ; convert to binary + mul cx ; multiply ax by 10 + add ax,bx ; add new digit + inc si ; point to next char + jmp p040 ; continue + +p050: ; got value in ax + cmp ax,64 ; less than 64K? + jb p060 ; yes - print msg + cmp ax,1024 ; greater than 1024K? + ja p060 ; yes - print msg + mov cl,6 + sal ax,cl ; convert from KB to paragraphs (*64) + mov bx,es ; get psp + add bx,ax ; new top of memory + mov si,2 ; point to top of memory in psp + mov ax,[si] ; get current top of memory + cmp ax,bx ; is new setting larger? + jae p055 ; no + mov dx,offset msg2 ; yes - print msg + jmp p065 + +p055: mov [si],bx ; save new top of memory + jmp p080 + +p060: mov dx,offset msg1 ; print the message +p065: add dx,100h ; fudge for the psp + mov ah,9 + int 21h + +p080: jmp $$main ; jump to BASIC's start point + +msg1 db 'Memory specification must be from 64 to 1024',7,10,13,'$' +msg2 db 'Unable to limit memory',7,10,13,'$' + +basmain endp +cseg ends +end basmain ; must be a main program! diff --git a/assembly/This program provides BASIC programs with access to the program loader (LOAD) by passing parameters via the system parameter area (SYSPARM).asm b/assembly/This program provides BASIC programs with access to the program loader (LOAD) by passing parameters via the system parameter area (SYSPARM).asm new file mode 100644 index 0000000..857d394 --- /dev/null +++ b/assembly/This program provides BASIC programs with access to the program loader (LOAD) by passing parameters via the system parameter area (SYSPARM).asm @@ -0,0 +1,85 @@ +;BASLOAD.ASM +;---------------------------------------------------------------------------- +; +;Inputs: +; FILE SPEC 1 - A string (len <= 80) with the complete name, including +; path, of the file to be loaded and executed. +; Example: 'MAINMENU.EXE' or 'C:\FORMAT.COM' +; PARAMETER 1 - A string (len <= 80) with the command line parameters +; to be passed to the program specified in FILE SPEC 1. +; Example: '' or 'A:' +; FILE SPEC 2 - Same as 1. +; PARAMETER 2 - Same as 1. +; +;Outputs: +; This program gives control to LOAD. +;---------------------------------------------------------------------------- + + +CODE SEGMENT 'CODE' + ASSUME CS:CODE + + + PUBLIC BASLOAD ;make known to BASIC at link time +BASLOAD PROC FAR + + ;prologue + PUSH BP ;save BP + MOV BP,SP ;set base for parm list + PUSH DS ;DS -> basic work area + PUSH ES ;ES -> basic work area + MOV DX,'dk' ;interrupt verification switch + INT 77H ;get seg address of sysparm area in AX + MOV ES,AX ;ES -> sysparm area + CLD ;set direction for all moves + + ;move file spec 1 to sysparm + MOV BX,SS:[BP+12] ;get addr of string descriptor + MOV CX,DS:[BX] ;get length of string into CX + MOV SI,DS:[BX+2] ;get addr of string into SI + MOV DI,0 ;offset into sysparm + REP MOVSB ;move string + MOV BYTE PTR ES:[DI],0 ;make it asciiz string + + ;move parameter 1 to sysparm + MOV BX,SS:[BP+10] ;get addr of string descriptor + MOV CX,DS:[BX] ;get length of string into CX + MOV SI,DS:[BX+2] ;get addr of string into SI + MOV DI,81 ;offset into sysparm + INC CL ;adjust for cr to be added at end + MOV BYTE PTR ES:[DI],CL ;1st byte is length of string + DEC CL ;re-adjust for move operation + INC DI + REP MOVSB ;move string + MOV BYTE PTR ES:[DI],13 ;add cr to end + + ;move file spec 2 to sysparm + MOV BX,SS:[BP+8] ;get addr of string descriptor + MOV CX,DS:[BX] ;get length of string into CX + MOV SI,DS:[BX+2] ;get addr of string into SI + MOV DI,163 ;offset into sysparm + REP MOVSB ;move string + MOV BYTE PTR ES:[DI],0 ;make it asciiz string + + ;move parameter 2 to sysparm + MOV BX,SS:[BP+6] ;get addr of string descriptor + MOV CX,DS:[BX] ;get length of string into CX + MOV SI,DS:[BX+2] ;get addr of string into SI + MOV DI,244 ;offset into sysparm + INC CL ;adjust for cr to be added at end + MOV BYTE PTR ES:[DI],CL ;1st byte is length of string + DEC CL ;re-adjust for move operation + INC DI + REP MOVSB ;move string + MOV BYTE PTR ES:[DI],13 ;add cr to end + + ;exit to BASIC + POP ES + POP DS + POP BP + RET 8 + +BASLOAD ENDP + +CODE ENDS + END BASLOAD \ No newline at end of file diff --git a/assembly/This program provides COBOL programs with access to the program loader (LOAD).asm b/assembly/This program provides COBOL programs with access to the program loader (LOAD).asm new file mode 100644 index 0000000..d72f5c5 --- /dev/null +++ b/assembly/This program provides COBOL programs with access to the program loader (LOAD).asm @@ -0,0 +1,107 @@ +;by passing parameters via the system parameter area (SYSPARM). +; +;Inputs: +;01 COBLOAD-PARMS +; 05 FILE-SPEC-1 PIC X(80). Contains complete drive, path and filename. +; 05 PARAMETER-1 PIC X(80). Contains command line parameters. +; 05 FILE-SPEC-2 PIC X(80). Same as 1. +; 05 PARAMETER-2 PIC X(80). Same as 1. +; +;Outputs: +; None. +;---------------------------------------------------------------------------- + + +CL_CODE_SEG SEGMENT PUBLIC 'CODE' + ASSUME CS:CL_CODE_SEG,DS:CL_CODE_SEG,ES:CL_CODE_SEG + +STACK_PARM STRUC +PUSHED_SI DW ? +PUSHED_DI DW ? +PUSHED_DS DW ? +PUSHED_ES DW ? +PUSHED_BP DW ? +RETURN_IP DW ? +RETURN_CS DW ? +PARM1_OFFSET DW ? +PARM1_DS DW ? +STACK_PARM ENDS + + PUBLIC COBLOAD ;make known to COBOL at link time +COBLOAD PROC FAR + + ;prologue + PUSH BP + PUSH ES + PUSH DS + PUSH DI + PUSH SI + MOV BP,SP ;set base for stack parm structure + + ;address caller's parameter block + MOV AX,[BP].PARM1_DS + MOV DS,AX ;DS -> cobol data seg + MOV SI,[BP].PARM1_OFFSET ;SI -> offset to parm block + + ;address load's parameter block in sysparm + MOV DX,'dk' ;verification switch + INT 77H ;get seg addr in AX + MOV ES,AX ;ES -> sysparm + MOV DI,0 ;DI -> offset to LOAD parms + + ;move cobol's parm block to load's parm block (in sysparm) + CLD ;set direction for moves + + MOV CX,80 ;length of move + REP MOVSB ;move file spec 1 +ASCIIZ1: MOV BYTE PTR ES:[DI],0 ;make asciiz string + DEC DI + MOV AL,BYTE PTR ES:[DI] + CMP AL,' ' ;nullify trailing spaces + JE ASCIIZ1 + + MOV BX,81 ;point to parm length byte + MOV BYTE PTR ES:[BX],82 ;init length of parm, + 2 + MOV DI,82 ;point to 1st parm position + MOV CX,80 ;length of move + REP MOVSB ;move parm +ADD_CR_1: MOV BYTE PTR ES:[DI],13 ;add carriage return + DEC BYTE PTR ES:[BX] ;sub 1 from length of parm + DEC DI + MOV AL,BYTE PTR ES:[DI] + CMP AL,' ' ;put cr in trailing spaces + JE ADD_CR_1 + + MOV DI,163 + MOV CX,80 ;length of move + REP MOVSB ;move file spec 2 +ASCIIZ2: MOV BYTE PTR ES:[DI],0 ;make asciiz string + DEC DI + MOV AL,BYTE PTR ES:[DI] + CMP AL,' ' ;nullify trailing spaces + JE ASCIIZ2 + + MOV BX,244 ;point to parm length byte + MOV BYTE PTR ES:[BX],82 ;init length of parm, + 2 + MOV DI,245 ;point to 1st parm position + MOV CX,80 ;length of move + REP MOVSB ;move parm +ADD_CR_2: MOV BYTE PTR ES:[DI],13 ;add carriage return + DEC BYTE PTR ES:[BX] ;sub 1 from length of parm + DEC DI + MOV AL,BYTE PTR ES:[DI] + CMP AL,' ' ;put cr in trailing spaces + JE ADD_CR_2 + + ;return to caller + POP SI + POP DI + POP DS + POP ES + POP BP + RET 4 + +COBLOAD ENDP + +CL_CODE_SEG ENDS + END \ No newline at end of file diff --git a/assembly/This program removes all control codes except for line feeds.asm b/assembly/This program removes all control codes except for line feeds.asm new file mode 100644 index 0000000..b269edd --- /dev/null +++ b/assembly/This program removes all control codes except for line feeds.asm @@ -0,0 +1,412 @@ +; +; CLEAN --- a utility to filter text files. +; This program removes all control codes except +; for line feeds, carriage returns, and form +; feeds, strips off the high bit of all characters, +; and expands tabs. Can be used to make a Wordstar +; file acceptable for other screen or line editors, +; and vice versa. +; + + +cr equ 0dh ;ASCII carriage return +lf equ 0ah ;ASCII line feed +ff equ 0ch ;ASCII form feed +eof equ 01ah ;End of file marker +tab equ 09h ;ASCII tab character + +command equ 80h ;buffer for command tail + +blksize equ 1024 ;blocking/deblocking size + + +cseg segment para public 'CODE' + + assume cs:cseg,ds:data,es:data,ss:stack + + +clean proc far ;entry point from PC-DOS + + push ds ;save DS:0000 for final + xor ax,ax ;return to PC-DOS + push ax + mov ax,data ;make our data segment + mov es,ax ;addressable via ES register + call infile ;get path and file spec. + ;for input file + mov ax,es ;set DS=ES for remainder + mov ds,ax ;of program + jnc clean1 ;jump, got acceptable name + mov dx,offset msg4 ;missing or illegal filespec, + jmp clean9 ;print error message and exit. + +clean1: call outfile ;set up output file name + call open_input ;now try to open input file + jnc clean2 ;jump,opened input ok + mov dx,offset msg1 ;open of input file failed, + jmp clean9 ;print error msg and exit. + +clean2: + call open_output ;try to open output file. + jnc clean25 ;jump,opened ok + mov dx,offset msg2 ;open of output file failed, + jmp clean9 ;print error message and exit. + +clean25: ;set up buffers + call init_buffs + call sign_on ;print ident and file names + + ;files successfully opened, +clean3: ;now filter the file. + call get_char ;read 1 character from input. + and al,07fh ;strip off the high bit + cmp al,20h ;is it a control code? + jae clean4 ;no,write it to new file + ;yes it is control code, + cmp al,eof ;is it end of file marker? + je clean6 ;yes,jump to close files. + cmp al,tab ;is it a tab command? + jz clean5 ;yes,jump to special processing. + cmp al,cr ;if control code other than + je clean35 ;tab or end-of-file mark, throw + cmp al,ff ;it away unless it is a + je clean35 ;form feed, carriage return, + cmp al,lf ;or line feed. + jne clean3 +clean35: ;If it is one of those three, + mov column,0 ;incidentally initialize + jmp clean45 ;column count for tab processor. + +clean4: ;count alphanumeric chars. sent. + inc column + +clean45: ;write this character to + call put_char ;output file, + jnc clean3 ;if CY not set, write was + ;ok so go get next char. +clean47: + call close_input ;if CY set, disk is full + call close_output ;so close files and exit + mov dx,offset msg5 ;with error message. + jmp clean9 + +clean5: ;process tab character + mov ax,column ;let DX:AX=column count + cwd + mov cx,8 ;divide it by eight... + idiv cx + sub cx,dx ;remainder is in DX. + add column,cx ;update column pointer. +clean55: ;8 minus the remainder + push cx ;gives us the number of + mov al,20h ;spaces to send out to + call put_char ;move to the next tab position + pop cx ;restore space count + jc clean47 ;jump if disk is full + loop clean55 + jmp short clean3 ;get next character + +clean6: ;end of file detected, + call put_char ;write end-of-file marker, + jc clean47 ;jump if disk was full + call flush_buffs ;write remaining data to disk + jc clean47 ;if CY set,disk was full + ;otherwise file was written ok + call close_input ;close input and output + call close_output ;files. + mov dx,offset msg3 ;addr of success message, + +clean9: ;print message and return + mov ah,9 ;control to PC-DOS + int 21h + ret + +clean endp + + +infile proc near ;process name of input file + ;DS:SI <- addr command line + mov si,offset command + ;ES:DI <- addr filespec buffer + mov di,offset input_name + cld + lodsb ;any command line present? + or al,al ;return error status if not. + jz infile4 +infile1: ;scan over leading blanks + lodsb ;to file name + cmp al,cr ;if we hit carriage return + jz infile4 ;filename is missing. + cmp al,20h ;is this a blank? + jz infile1 ;if so keep scanning. + +infile2: ;found first char of name, + stosb ;move last char. to output + ;file name buffer. + lodsb ;check next character, found + cmp al,cr ;carriage return yet? + je infile3 ;yes,exit with success code + cmp al,20h ;is this a blank? + jne infile2 ;if not keep moving chars. + +infile3: ;exit with carry =0 + clc ;for success flag + ret + +infile4: ;exit with carry =1 + stc ;for error flag + ret +infile endp + +outfile proc near ;set up path and file + cld ;name for output file. + mov cx,64 ;length to move + mov si,offset input_name ;source addr + mov di,offset output_name ;dest addr + rep movsb ;transfer the string + mov di,offset output_name +outfile1: ;scan string looking for + mov al,[di] ;"." marking start of extension + or al,al ;or zero byte marking name end. + jz outfile2 ;if either is found,jump. + cmp al,'.' + je outfile2 ;bump string pointer, loop + inc di ;if neither '.' or zero found. + jmp outfile1 +outfile2: ;found zero or '.',force the + ;extension of the output file + ;to '.CLN' + mov si,offset outfile_ext + mov cx,5 + rep movsb + ret ;back to caller +outfile endp + +open_input proc near ;open input file + ;DS:DX=addr filename + mov dx,offset input_name + mov al,0 ;AL=0 for read only + mov ah,3dh ;function 3dh=open + int 21h ;handle returned in AX, + mov input_handle,ax ;save it for later. + ret ;CY is set if error +open_input endp + +open_output proc near ;open output file + ;DS:DX=addr filename + mov dx,offset output_name + mov al,1 ;AL=1 for write only + mov ah,3ch ;function 3ch=MAKE or + int 21h ;truncate existing file + ;handle returned in AX + mov output_handle,ax;save it for later. + ret ;return CY=true if error +open_output endp + +close_input proc near ;close input file + mov bx,input_handle ;BX=handle + mov ah,3eh + int 21h + ret +close_input endp + +close_output proc near ;close output file + mov bx,output_handle;BX=handle + mov ah,3eh + int 21h + ret +close_output endp + +get_char proc near ;get one character from input buffer + mov bx,input_ptr + cmp bx,blksize + jne get_char1 + call read_block + mov bx,0 +get_char1: + mov al,[input_buffer+bx] + inc bx + mov input_ptr,bx + ret +get_char endp + +put_char proc near ;put one character into output buffer + mov bx,output_ptr + mov [output_buffer+bx],al + inc bx + mov output_ptr,bx + cmp bx,blksize ;buffer full yet? + jne put_char1 ;no,jump + call write_block ;yes,write the block + ret ;return CY as status code +put_char1: + clc ;return CY clear for OK status + ret +put_char endp + +read_block proc near + mov bx,input_handle ;read first block of input + mov cx,blksize + mov dx,offset input_buffer + mov ah,3fh + int 21h + jnc read_block1 ;jump if no error status + mov ax,0 ;simulate a zero length read if error +read_block1: + cmp ax,blksize ;was full buffer read in? + je read_block2 ;yes,jump + mov bx,ax ;no, store End-of-File mark + mov byte ptr [input_buffer+bx],eof +read_block2: + xor ax,ax ;initialize input buffer pointer + mov input_ptr,ax + ret +read_block endp + +write_block proc near ;write blocked output (blksize bytes) + mov dx,offset output_buffer + mov cx,blksize + mov bx,output_handle + mov ah,40h + int 21h + xor bx,bx ;initialize pointer to blocking buffer + mov output_ptr,bx + cmp ax,blksize ;was correct length written? + jne write_block1 ;no,disk must be full + clc ;yes,return CY=0 indicating all OK + ret +write_block1: ;disk is full, return CY =1 + stc ;as error code + ret +write_block endp + +init_buffs proc near + call read_block ;read 1st block of input + xor ax,ax ;initialize pointer to output + mov output_ptr,ax ;output blocking buffer + ret +init_buffs endp + +flush_buffs proc near ;write any data in output buffer to disk + mov cx,output_ptr + or cx,cx + jz flush_buffs1 ;jump,buffer is empty + mov bx,output_handle + mov dx,offset output_buffer + mov ah,40h + int 21h + cmp ax,output_ptr ;was write successful? + jnz flush_buffs2 ;no,jump +flush_buffs1: + clc ;yes,return CY=0 for + ret ;success flag +flush_buffs2: ;disk was full so write failed, + stc ;return CY=1 as error flag + ret +flush_buffs endp + +sign_on proc near ;print sign-on message + mov dx,offset msg6 ;title... + mov ah,9 + int 21h + mov dx,offset msg7 ;input file: + mov ah,9 + int 21h + mov dx,offset input_name + call pasciiz + mov dx,offset msg8 ;output file: + mov ah,9 + int 21h + mov dx,offset output_name + call pasciiz + mov dx,offset msg9 + mov ah,9 + int 21h + ret +sign_on endp + +pasciiz proc near ;call DX=offset of ASCIIZ string + mov bx,dx ;which will be printed on standard output +pasciiz1: + mov dl,[bx] + or dl,dl + jz pasciiz9 + cmp dl,'A' + jb pasciiz2 + cmp dl,'Z' + ja pasciiz2 + or dl,20h +pasciiz2: + mov ah,2 + int 21h + inc bx + jmp pasciiz1 +pasciiz9: + ret +pasciiz endp + +cseg ends + + +data segment para public 'DATA' + +input_name db 64 dup (0) ;buffer for input filespec +output_name db 64 dup (0) ;buffer for output filespec + +input_handle dw 0 ;token returned by PCDOS +output_handle dw 0 ;token returned by PCDOS + +input_ptr dw 0 ;pointer to input blocking buffer +output_ptr dw 0 ;pointer to output blocking buffer + +outfile_ext db '.CLN',0 ;extension for filtered file + +column dw 0 ;column count for tab processing + +msg1 db cr,lf + db 'Cannot find input file.' + db cr,lf,'$' + +msg2 db cr,lf + db 'Failed to open output file.' + db cr,lf,'$' + +msg3 db cr,lf + db 'File processing completed' + db cr,lf,'$' + +msg4 db cr,lf + db 'Missing file name.' + db cr,lf,'$' + +msg5 db cr,lf + db 'Disk is full.' + db cr,lf,'$' + +msg6 db cr,lf + db 'Clean Word Processing File' + db cr,lf + db 'WWW.' + db cr,lf,'$' + +msg7 db cr,lf,'Input file: $' + +msg8 db cr,lf,'Output file: $' + +msg9 db cr,lf,'$' + + +input_buffer db blksize dup (?) ;buffer for deblocking of data + ;from input file + +output_buffer db blksize dup (?) ;buffer for blocking of data + ;sent to output file + +data ends + + +stack segment para stack 'STACK' + db 64 dup (?) +stack ends + + end clean \ No newline at end of file diff --git a/assembly/Writes a boot sector to the floppy disk.asm b/assembly/Writes a boot sector to the floppy disk.asm new file mode 100644 index 0000000..c1c79b2 --- /dev/null +++ b/assembly/Writes a boot sector to the floppy disk.asm @@ -0,0 +1,182 @@ +; sector.asm +; +; writes a boot sector out to the floppy disk in the A: drive +; +; The input file is assumed to be a binary file with the relevant code +; at offset 7C00h relative to the beginning of the file. This is because +; when the sector loader transfers control to the boot sector, it's at +; address 0:7C00h. Rather than clutter up the boot loader source with +; a bunch of ugly offsets, we simply use an ORG 7C00h instead and let +; the linker insert a bunch of empty space which this program skips over. +; +; Style Note: +; There aren't any hardwired numbers in this code. That is to say, +; equates and macros are used to render gibberish like this: +; mov ax,4c00h +; int 33 +; +; into somewhat self-documenting code like this: +; DosInt DOS_TERMINATE, 0 +; +; This is done to make the code more readable, and comprehensible, and +; to aid in maintenance by not littering mysterious constants throughout +; the code. Please be kind to animals (specifically your fellow +; programmers) and use this practice in your own code. +; +; + +STACKSIZE = 200h ; this is how much stack we'll allocate + +SECTORSIZE = 200h ; size of the boot sector on a floppy + +CMD_LINE_LEN = 80h ; offset of the command line length (one byte) + ; relative to the beginning of the PSP. + +CMD_LINE = 81h ; the offset relative to the beginning of the + ; PSP that is the start of the command line + ; arguments. + + +DOS_OPEN_HANDLE = 03dh ; open file + READ_ONLY_DENY_NONE = 020h ; file open mode +DOS_MOVE_HANDLE = 042h ; move file pointer + WHENCE_BEGIN = 0 ; move pointer relative to beginning + WHENCE_CURRENT = 1 ; move pointer relative to current location + WHENCE_EOF = 2 ; move pointer relative to end of file +DOS_READ_HANDLE = 03fh ; read from an open file handle +DOS_CLOSE_HANDLE = 03eh ; close an open file handle +DOS_WRITE_HANDLE = 040h ; write to open file +DOS_TERMINATE = 04ch ; terminate and exit + +DOS_INT = 021h + +; various named character constants +NUL = 0 +CR = 13 +LF = 10 +SPACE = ' ' + +GenericInt macro function, subfunction + ifb + mov ah,function + else + mov ax,(function SHL 8) OR (subfunction AND 0ffh) + endif +endm + +DosInt macro function, subfunction + GenericInt , + int DOS_INT +endm + +BDISK_WRITE_SECTOR = 03h + +BDISK_INT = 013h + +; constants unique to this program + +FILE_OFFS_LO = 7C00h ; +FILE_OFFS_HI = 0000h ; + +BOOT_DRIVE = 0 ; we'll be writing to drive A: +BOOT_HEAD = 0 ; head 0 is the boot head +BOOT_CYLSECT = 0001h ; a word value with the following format + ; bits 15-8 low bits of cylinder + ; bits 7-6 high two bits of cylinder + ; bits 5-0 sector +NUM_SECTORS = 1 ; number of sector to write to disk + + model small + .386 + .stack STACKSIZE + .code +;********************************************************************** +; program code start +;********************************************************************** +Start: +; parse the command line args + mov cl,byte ptr [DGROUP:CMD_LINE_LEN] ; read the length byte + ; NOTE that the command line length isn't really part of the + ; DGROUP group, but DS currently points to the PSP, and if we + ; omit the DGROUP override, the assembler thinks we're trying + ; to load a constant instead of the contents of the memory loc. + ; In other words, it's ugly but it has a purpose. + or cl,cl ; check for zero + jz Usage ; no command line args + mov si,CMD_LINE ; + mov al,' ' ; + repe cmpsb ; burn off leading spaces + mov dx,si ; save that starting point + repne cmpsb ; scan for next space (if any) + cmp byte ptr [si],SPACE ; if it's > space char, + ja skip ; skip the nul termination + mov byte ptr [si],NUL ; terminate with a NUL char +skip: +; first, open the file + DosInt DOS_OPEN_HANDLE, READ_ONLY_DENY_NONE + mov si,seg DGROUP ; + mov ds,si ; + mov es,si ; point 'em all over there + mov si,offset err_fopen ; can't open input file + jc ErrorExit +; the file's open, so move the file pointer to offset 7C00h + mov bx,ax ; fetch the file handle + mov cx,FILE_OFFS_HI + mov dx,FILE_OFFS_LO + DosInt DOS_MOVE_HANDLE, WHENCE_BEGIN + mov si,offset err_fmove ; + jc ErrorExit ; +; read the data + mov cx,SECTORSIZE ; max number of bytes to read + mov dx,offset buffer ; point ds:dx to buffer + DosInt DOS_READ_HANDLE ; + mov si,offset err_fread ; + jc ErrorExit ; +; close the file + DosInt DOS_CLOSE_HANDLE ; close this file + +; now write it out to the floppy disk's boot sector + mov bx,offset buffer ; + mov cx,BOOT_CYLSECT ; + mov dx,(BOOT_HEAD SHL 8) OR (BOOT_DRIVE) + GenericInt BDISK_WRITE_SECTOR, NUM_SECTORS + int BDISK_INT + mov si,offset err_write ; + jc ErrorExit ; + mov si,offset msg_ok ; +ErrorExit: + mov cx,[si] ; + inc si ; + inc si ; + mov dx,si ; + mov bx,1 ; write to stdout + DosInt DOS_WRITE_HANDLE ; write to that file + DosInt DOS_TERMINATE, 0 + +Usage: + mov si,seg DGROUP ; + mov ds,si ; load correct data segment + mov si,offset use_msg + jmp ErrorExit ; + + +;********************************************************************** +; program data starts +;********************************************************************** + .data +msgstruc macro msglabel, msgstring + local alpha +msglabel dw (alpha - $) - 2 + db msgstring +alpha = $ +endm + +msgstruc err_fopen ,<"ERROR: couldn't open input file",CR,LF> +msgstruc err_fmove ,<"ERROR: unable to move file pointer",CR,LF> +msgstruc err_fread ,<"ERROR: couldn't read from input file",CR,LF> +msgstruc err_write ,<"ERROR: unable to write to floppy disk",CR,LF> +msgstruc msg_ok ,<"Boot sector was successfully written to floppy",CR,LF> +msgstruc use_msg ,<"Usage: SECTOR infile.bin",CR,LF> + +buffer db SECTORSIZE dup (?) ; sector buffer + end Start \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Perform to a 2D FFT Inplace Given a Complex 2D Array.cpp b/c++/11_Numerical_Problems/C++ Perform to a 2D FFT Inplace Given a Complex 2D Array.cpp new file mode 100644 index 0000000..deba0a7 --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Perform to a 2D FFT Inplace Given a Complex 2D Array.cpp @@ -0,0 +1,70 @@ +/*This is a C++ Program to perform 2D FFT. A fast Fourier transform (FFT) is an algorithm to compute the discrete Fourier transform (DFT) and its inverse. Fourier analysis converts time (or space) to frequency and vice versa; an FFT rapidly computes such transformations by factorizing the DFT matrix into a product of sparse (mostly zero) factors.*/ + +#include +#include + +using namespace std; + +#define PI 3.14159265 +int n; + +int main(int argc, char **argv) +{ + cout << "Enter the size: "; + cin >> n; + double inputData[n][n]; + cout << "Enter the 2D elements "; + for (int i = 0; i < n; i++) + for (int j = 0; j < n; j++) + cin >> inputData[i][j]; + double realOut[n][n]; + double imagOut[n][n]; + double amplitudeOut[n][n]; + int height = n; + int width = n; + // Two outer loops iterate on output data. + for (int yWave = 0; yWave < height; yWave++) + { + for (int xWave = 0; xWave < width; xWave++) + { + // Two inner loops iterate on input data. + for (int ySpace = 0; ySpace < height; ySpace++) + { + for (int xSpace = 0; xSpace < width; xSpace++) + { + // Compute real, imag, and ampltude. + realOut[yWave][xWave] += (inputData[ySpace][xSpace] * cos( + 2 * PI * ((1.0 * xWave * xSpace / width) + (1.0 + * yWave * ySpace / height)))) / sqrt( + width * height); + imagOut[yWave][xWave] -= (inputData[ySpace][xSpace] * sin( + 2 * PI * ((1.0 * xWave * xSpace / width) + (1.0 + * yWave * ySpace / height)))) / sqrt( + width * height); + amplitudeOut[yWave][xWave] = sqrt( + realOut[yWave][xWave] * realOut[yWave][xWave] + + imagOut[yWave][xWave] + * imagOut[yWave][xWave]); + } + cout << realOut[yWave][xWave] << " + " << imagOut[yWave][xWave] + << " i (" << amplitudeOut[yWave][xWave] << ")\n"; + } + } + } +} + +/* +Enter the size: +2 +Enter the 2D elements +2 3 +4 2 + +2.5 + 0.0 i +5.5 + 0.0 i +-0.5 + -1.8369701987210297E-16 i +0.5 + -3.0616169978683826E-16 i +2.5 + 0.0 i +-0.5 + -3.6739403974420594E-16 i +-0.5 + -1.8369701987210297E-16 i +-1.5 + -1.8369701987210297E-16 i \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Check Multiplicability of Two Matrices.cpp b/c++/11_Numerical_Problems/C++ Program to Check Multiplicability of Two Matrices.cpp new file mode 100644 index 0000000..e0ca7bf --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Check Multiplicability of Two Matrices.cpp @@ -0,0 +1,40 @@ +#include +#include +#include + +using namespace std; + +int main(int argc, char **argv) +{ + cout<<"Enter the dimension of the matrix:\n "; + int rowA; + cin>>rowA; + int colA; + cin>>colA; + cout<<"Enter the dimension of the other matrix:\n "; + int rowB; + cin>>rowB; + int colB; + cin>>colB; + if(colA == rowB) + { + cout<<"Matrices are multipilcable"; + } + else + { + cout<<"Matrices are not multipilcable"; + } +} + +/* +Enter the dimension of the matrix: + 2 4 +Enter the dimension of the other matrix: + 2 5 +Matrices are not multipilcable + +Enter the dimension of the matrix: + 4 5 +Enter the dimension of the other matrix: + 5 6 +Matrices are multipilcable \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Check if a Matrix is Invertible.cpp b/c++/11_Numerical_Problems/C++ Program to Check if a Matrix is Invertible.cpp new file mode 100644 index 0000000..516edbd --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Check if a Matrix is Invertible.cpp @@ -0,0 +1,76 @@ +#include +#include +#include + +using namespace std; +double d = 0; +double det(int n, double mat[10][10]); +double det(int n, double mat[10][10]) +{ + double submat[10][10]; + if (n == 2) + return ((mat[0][0] * mat[1][1]) - (mat[1][0] * mat[0][1])); + else + { + for (int c = 0; c < n; c++) + { + int subi = 0; //submatrix's i value + for (int i = 1; i < n; i++) + { + int subj = 0; + for (int j = 0; j < n; j++) + { + if (j == c) + continue; + submat[subi][subj] = mat[i][j]; + subj++; + } + subi++; + } + d = d + (pow(-1, c) * mat[0][c] * det(n - 1, submat)); + } + } + return d; +} +int main(int argc, char **argv) +{ + cout << "Enter the dimension of the matrix:\n"; + int n; + cin >> n; + double mat[10][10]; + cout << "Enter the elements of the matrix:\n"; + for (int i = 0; i < n; i++) + { + for (int j = 0; j < n; j++) + { + cin >> mat[j][i]; + } + } + if (det(n, mat) != 0) + { + cout << "The given matrix is invertible"; + } + else + { + cout << "The given matrix is not invertible"; + } +} + +/* +Enter the dimension of the matrix: +3 +Enter the elements of the matrix: +1 2 3 +4 5 6 +7 8 9 +The given matrix is not invertible + +Enter the dimension of the matrix: +5 +Enter the elements of the matrix: +1 2 3 4 5 +6 7 8 9 0 +0 9 8 7 6 +5 4 3 2 1 +1 3 5 7 9 +The given matrix is invertible \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Check if it is a Sparse Matrix.cpp b/c++/11_Numerical_Problems/C++ Program to Check if it is a Sparse Matrix.cpp new file mode 100644 index 0000000..75dada5 --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Check if it is a Sparse Matrix.cpp @@ -0,0 +1,54 @@ +#include +#include + +using namespace std; +int main(int argc, char **argv) +{ + cout<<"Enter the dimensions of the matrix: "; + int m, n; + cin>>m>>n; + double mat[m][n]; + int zeros = 0; + cout<<"Enter the elements of the matrix: "; + for(int i=0; i>mat[i][j]; + if(mat[i][j] == 0) + { + zeros++; + } + } + } + if(zeros > (m*n)/2) + { + cout<<"The matrix is a sparse matrix"; + } + else + { + cout<<"The matrix is not a sparse matrix"; + } +} + +/* +Enter the dimensions of the matrix: +3 3 + +Enter the elements of the matrix: +1 2 3 +4 5 6 +0 0 0 + +The matrix is not a sparse matrix + + +Enter the dimensions of the matrix: +3 3 + +Enter the elements of the matrix: +1 1 0 +0 0 1 +1 0 0 + +The matrix is a sparse matrix \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Compute DFT Coefficients Directly.cpp b/c++/11_Numerical_Problems/C++ Program to Compute DFT Coefficients Directly.cpp new file mode 100644 index 0000000..97ea26e --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Compute DFT Coefficients Directly.cpp @@ -0,0 +1,65 @@ +/*This is a C++ Program to compute the coefficients of the DFT (Discrete Fourier Transform) directly. In mathematics, the discrete Fourier transform (DFT) converts a finite list of equally spaced samples of a function into the list of coefficients of a finite combination of complex sinusoids, ordered by their frequencies, that has those same sample values. It can be said to convert the sampled function from its original domain (often time or position along a line) to the frequency domain.*/ + +#include +#include + +using namespace std; + +#define PI 3.14159265 + +class DFT_Coefficient +{ +public: + double real, img; + DFT_Coefficient() + { + real = 0.0; + img = 0.0; + } +}; +int main(int argc, char **argv) +{ + int N = 10; + cout << "Calculation DFT Coefficients\n"; + cout << "Enter the coefficient of simple linear function:\n"; + cout << "ax + by = c\n"; + double a, b, c; + cin >> a >> b >> c; + double function[N]; + for (int i = 0; i < N; i++) + { + function[i] = (((a * (double) i) + (b * (double) i)) - c); + //System.out.print( " "+function[i] + " "); + } + cout << "Enter the max K value: "; + int k; + cin >> k; + double cosine[N]; + double sine[N]; + for (int i = 0; i < N; i++) + { + cosine[i] = cos((2 * i * k * PI) / N); + sine[i] = sin((2 * i * k * PI) / N); + } + DFT_Coefficient dft_val; + cout << "The coefficients are: "; + for (int i = 0; i < N; i++) + { + dft_val.real += function[i] * cosine[i]; + dft_val.img += function[i] * sine[i]; + } + cout << "(" << dft_val.real << ") - " << "(" << dft_val.img << " i)"; +} + +/* +Calculation DFT Coefficients +Enter the coefficient of simple linear funtion: +ax + by = c +1 2 3 +Enter the max K value: +2 +The coefficients are: (-15) - (-20.6457 i) + +------------------ +(program exited with code: 0) +Press return to continue \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Compute Determinant of a Matrix.cpp b/c++/11_Numerical_Problems/C++ Program to Compute Determinant of a Matrix.cpp new file mode 100644 index 0000000..9ed3484 --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Compute Determinant of a Matrix.cpp @@ -0,0 +1,69 @@ +#include +#include +#include + +using namespace std; +double d = 0; +double det(int n, double mat[10][10]); +double det(int n, double mat[10][10]) +{ + double submat[10][10]; + if (n == 2) + return ((mat[0][0] * mat[1][1]) - (mat[1][0] * mat[0][1])); + else + { + for (int c = 0; c < n; c++) + { + int subi = 0; //submatrix's i value + for (int i = 1; i < n; i++) + { + int subj = 0; + for (int j = 0; j < n; j++) + { + if (j == c) + continue; + submat[subi][subj] = mat[i][j]; + subj++; + } + subi++; + } + d = d + (pow(-1, c) * mat[0][c] * det(n - 1, submat)); + } + } + return d; +} +int main(int argc, char **argv) +{ + cout << "Enter the dimension of the matrix:\n"; + int n; + cin >> n; + double mat[10][10]; + cout << "Enter the elements of the matrix:\n"; + for (int i = 0; i < n; i++) + { + for (int j = 0; j < n; j++) + { + cin >> mat[j][i]; + } + } + cout << "The determinant of the given matrix is: " << det(n, mat); + return 0; +} + +/* +Enter the dimension of the matrix: +3 +Enter the elements of the matrix: +3 5 2 +8 4 8 +2 4 7 +The determinant of the given matrix is: -164 + +Enter the dimension of the matrix: +4 +Enter the elements of the matrix: +9 5 2 5 +9 5 3 7 +6 5 4 8 +1 5 3 7 +The determinant of the given matrix is: 0 \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Compute Discrete Fourier Transform Using Naive Approach.cpp b/c++/11_Numerical_Problems/C++ Program to Compute Discrete Fourier Transform Using Naive Approach.cpp new file mode 100644 index 0000000..809a995 --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Compute Discrete Fourier Transform Using Naive Approach.cpp @@ -0,0 +1,84 @@ +/*This is a C++ Program to perform Discrete Fourier Transform using Naive approach. In mathematics, the discrete Fourier transform (DFT) converts a finite list of equally spaced samples of a function into the list of coefficients of a finite combination of complex sinusoids, ordered by their frequencies, that has those same sample values. It can be said to convert the sampled function from its original domain (often time or position along a line) to the frequency domain.*/ + +#include +#include + +using namespace std; + +#define PI 3.14159265 + +class DFT_Coefficient +{ +public: + double real, img; + DFT_Coefficient() + { + real = 0.0; + img = 0.0; + } +}; +int main(int argc, char **argv) +{ + int N = 10; + cout << "Discrete Fourier Transform using naive method\n"; + cout << "Enter the coefficient of simple linear function:\n"; + cout << "ax + by = c\n"; + double a, b, c; + cin >> a >> b >> c; + double function[N]; + for (int i = 0; i < N; i++) + { + function[i] = (((a * (double) i) + (b * (double) i)) - c); + //System.out.print( " "+function[i] + " "); + } + cout << "Enter the max K value: "; + int k; + cin >> k; + double cosine[N]; + double sine[N]; + for (int i = 0; i < N; i++) + { + cosine[i] = cos((2 * i * k * PI) / N); + sine[i] = sin((2 * i * k * PI) / N); + } + DFT_Coefficient dft_val[k]; + cout << "The coefficients are: "; + for (int j = 0; j < k; j++) + { + for (int i = 0; i < N; i++) + { + dft_val[j].real += function[i] * cosine[i]; + dft_val[j].img += function[i] * sine[i]; + } + cout << "(" << dft_val[j].real << ") - " << "(" << dft_val[j].img << " i)\n"; + } +} + +/* + +Discrete Fourier Transform using naive method +Enter the coefficient of simple linear function: +ax + by = c +1 2 3 +Enter the max K value: 20 +The coefficients are: +(105) - (-1.03386e-005 i) +(105) - (-1.03386e-005 i) +(105) - (-1.03386e-005 i) +(105) - (-1.03386e-005 i) +(105) - (-1.03386e-005 i) +(105) - (-1.03386e-005 i) +(105) - (-1.03386e-005 i) +(105) - (-1.03386e-005 i) +(105) - (-1.03386e-005 i) +(105) - (-1.03386e-005 i) +(105) - (-1.03386e-005 i) +(105) - (-1.03386e-005 i) +(105) - (-1.03386e-005 i) +(105) - (-1.03386e-005 i) +(105) - (-1.03386e-005 i) +(105) - (-1.03386e-005 i) +(105) - (-1.03386e-005 i) +(105) - (-1.03386e-005 i) +(105) - (-1.03386e-005 i) +(105) - (-1.03386e-005 i) \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Compute Discrete Fourier Transform Using the Fast Fourier Transform Approach.cpp b/c++/11_Numerical_Problems/C++ Program to Compute Discrete Fourier Transform Using the Fast Fourier Transform Approach.cpp new file mode 100644 index 0000000..49830c2 --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Compute Discrete Fourier Transform Using the Fast Fourier Transform Approach.cpp @@ -0,0 +1,73 @@ +/*This is a C++ Program to perform Fast Fourier Transform. A fast Fourier transform (FFT) is an algorithm to compute the discrete Fourier transform (DFT) and its inverse. Fourier analysis converts time (or space) to frequency and vice versa; an FFT rapidly computes such transformations by factorizing the DFT matrix into a product of sparse (mostly zero) factors.*/ + +#include +#include +#include +#include +using namespace std; + +unsigned int bitReverse(unsigned int x, int log2n) + +{ + int n = 0; + int mask = 0x1; + for (int i = 0; i < log2n; i++) + { + n <<= 1; + n |= (x & 1); + x >>= 1; + } + return n; +} +const double PI = 3.1415926536; +template +void fft(Iter_T a, Iter_T b, int log2n) +{ + typedef typename iterator_traits::value_type complex; + const complex J(0, 1); + int n = 1 << log2n; + for (unsigned int i = 0; i < n; ++i) + { + b[bitReverse(i, log2n)] = a[i]; + } + for (int s = 1; s <= log2n; ++s) + { + int m = 1 << s; + int m2 = m >> 1; + complex w(1, 0); + complex wm = exp(-J * (PI / m2)); + for (int j = 0; j < m2; ++j) + { + for (int k = j; k < n; k += m) + { + complex t = w * b[k + m2]; + complex u = b[k]; + b[k] = u + t; + b[k + m2] = u - t; + } + w *= wm; + } + } +} +int main(int argc, char **argv) +{ + typedef complex cx; + cx a[] = { cx(0, 0), cx(1, 1), cx(3, 3), cx(4, 4), cx(4, 4), cx(3, 3), cx( + 1, 1), cx(0, 0) + }; + cx b[8]; + fft(a, b, 3); + for (int i = 0; i < 8; ++i) + cout << b[i] << "\n"; +} + +/* + +(16,16) +(-4.82843,-11.6569) +(0,0) +(-0.343146,0.828427) +(0,0) +(0.828427,-0.343146) +(0,0) +(-11.6569,-4.82843) \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Emulate N Dice Roller.cpp b/c++/11_Numerical_Problems/C++ Program to Emulate N Dice Roller.cpp new file mode 100644 index 0000000..bbbb506 --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Emulate N Dice Roller.cpp @@ -0,0 +1,25 @@ +#include +#include + +using namespace std; + +int main(int argc, char **argv) +{ + cout << "Enter the number of dice: "; + int n; + cin >> n; + cout << "The values on dice are: ( "; + for (int i = 0; i < n; i++) + cout << (rand() % 6) + 1<<" "; + cout<<")"; +} + +/* +Enter the number of dice: 5 +The values on dice are: ( 6 6 5 5 6 ) + +Enter the number of dice: 1 +The values on dice are: ( 6 ) + +Enter the number of dice: 3 +The values on dice are: ( 6 6 5 ) \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Find Basis and Dimension of a Matrix.cpp b/c++/11_Numerical_Problems/C++ Program to Find Basis and Dimension of a Matrix.cpp new file mode 100644 index 0000000..183fa0c --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Find Basis and Dimension of a Matrix.cpp @@ -0,0 +1,74 @@ +#include +#include +#include + +using namespace std; +double d = 0; +double det(int n, double mat[10][10]); +double det(int n, double mat[10][10]) +{ + double submat[10][10]; + if (n == 2) + return ((mat[0][0] * mat[1][1]) - (mat[1][0] * mat[0][1])); + else + { + for (int c = 0; c < n; c++) + { + int subi = 0; //submatrix's i value + for (int i = 1; i < n; i++) + { + int subj = 0; + for (int j = 0; j < n; j++) + { + if (j == c) + continue; + submat[subi][subj] = mat[i][j]; + subj++; + } + subi++; + } + d = d + (pow(-1, c) * mat[0][c] * det(n - 1, submat)); + } + } + return d; +} +int main(int argc, char **argv) +{ + cout << "Enter the number of vectors:\n"; + int n; + cin >> n; + double mat[10][10]; + cout << "Enter the vectors one by one:\n"; + for (int i = 0; i < n; i++) + { + for (int j = 0; j < n; j++) + { + cin >> mat[j][i]; + } + } + d = det(n, mat); + if (d != 0) + cout << "The vectors forms the basis of R" << n + << " as the determinant is non-zero"; + else + cout << "The vectors doesn't form the basis of R" << n + << " as the determinant is zero"; +} + +/* +Enter the number of vectors: +3 +Enter the vectors one by one: +1 2 3 +2 3 4 +3 4 5 +The vectors doesn't form the basis of R3 as the determinant is zero + +Enter the number of vectors: +4 +Enter the vectors one by one: +2 3 5 8 +1 6 2 9 +3 4 2 7 +2 5 3 9 +The vectors forms the basis of R4 as the determinant is non-zero \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Find Closest Pair of Points in an Array.cpp b/c++/11_Numerical_Problems/C++ Program to Find Closest Pair of Points in an Array.cpp new file mode 100644 index 0000000..5f7a36a --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Find Closest Pair of Points in an Array.cpp @@ -0,0 +1,137 @@ +/* + * C++ Program to Find Closest Pair of Points in an Array + */ +#include +#include +#include +#include +using namespace std; + +/* + * Point Declaration + */ +struct Point +{ + int x, y; +}; + +/* + * sort array of points according to X coordinate + */ +int compareX(const void* a, const void* b) +{ + Point *p1 = (Point *)a, *p2 = (Point *)b; + return (p1->x - p2->x); +} +/* + * sort array of points according to Y coordinate + */ +int compareY(const void* a, const void* b) +{ + Point *p1 = (Point *)a, *p2 = (Point *)b; + return (p1->y - p2->y); +} +/* + * find the distance between two points + */ +float dist(Point p1, Point p2) +{ + return sqrt((p1.x - p2.x) * (p1.x - p2.x) + (p1.y - p2.y) * (p1.y - p2.y)); +} +/* + * return the smallest distance between two points + */ +float small_dist(Point P[], int n) +{ + float min = FLT_MAX; + for (int i = 0; i < n; ++i) + { + for (int j = i + 1; j < n; ++j) + { + if (dist(P[i], P[j]) < min) + min = dist(P[i], P[j]); + } + } + return min; +} +/* + * find the distance beween the closest points of strip of given size + */ +float stripClosest(Point strip[], int size, float d) +{ + float min = d; + for (int i = 0; i < size; ++i) + { + for (int j = i + 1; j < size && (strip[j].y - strip[i].y) < min; ++j) + { + if (dist(strip[i],strip[j]) < min) + min = dist(strip[i], strip[j]); + } + } + return min; +} +/* + * find the smallest distance. + */ +float closestUtil(Point Px[], Point Py[], int n) +{ + if (n <= 3) + return small_dist(Px, n); + int mid = n / 2; + Point midPoint = Px[mid]; + Point Pyl[mid + 1]; + Point Pyr[n - mid - 1]; + int li = 0, ri = 0; + for (int i = 0; i < n; i++) + { + if (Py[i].x <= midPoint.x) + Pyl[li++] = Py[i]; + else + Pyr[ri++] = Py[i]; + } + float dl = closestUtil(Px, Pyl, mid); + float dr = closestUtil(Px + mid, Pyr, n-mid); + float d = min(dl, dr); + Point strip[n]; + int j = 0; + for (int i = 0; i < n; i++) + { + if (abs(Py[i].x - midPoint.x) < d) + strip[j] = Py[i], j++; + } + return min(d, stripClosest(strip, j, d)); +} +/* + * finds the smallest distance + */ +float closest(Point P[], int n) +{ + Point Px[n]; + Point Py[n]; + for (int i = 0; i < n; i++) + { + Px[i] = P[i]; + Py[i] = P[i]; + } + qsort(Px, n, sizeof(Point), compareX); + qsort(Py, n, sizeof(Point), compareY); + return closestUtil(Px, Py, n); +} + +/* + * Main + */ +int main() +{ + Point P[] = {{2, 3}, {12, 30}, {40, 50}, {5, 1}, {12, 10}, {3, 4}}; + int n = sizeof(P) / sizeof(P[0]); + cout << "The smallest distance is " << closest(P, n); + return 0; +} + +/* +The smallest distance is 1.41421 + +------------------ +(program exited with code: 1) +Press return to continue \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Find Factoial of Large Numbers.cpp b/c++/11_Numerical_Problems/C++ Program to Find Factoial of Large Numbers.cpp new file mode 100644 index 0000000..1eb4c2f --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Find Factoial of Large Numbers.cpp @@ -0,0 +1,83 @@ +/* + * C++ Program to Find Factorial of Large Numbers + */ +#include +#include +#include +#define ll long long +using namespace std; + +int fact[101][200] = {0}; + +/* + * Find Factorial of Large Numbers + * fact[i][0] is used to store the number of digits + */ +void fact_large(int n) +{ + int i; + fact[1][0] = 1; + fact[1][1] = 1; + if (fact[n][0] == 0) + { + for (i = n - 1; i > 0 ; i--) + { + if (fact[i][0] != 0) + break; + } + for ( ; i < n; i++) + { + int j = 1; + int carry = 0; + int len = fact[i][0]; + while (len--) + { + int temp = (i + 1) * fact[i][j] + carry; + fact[i + 1][j] = temp % 10; + carry = temp / 10; + j++; + } + while (carry > 0) + { + fact[i + 1][j] = carry % 10; + carry /= 10; + j++; + } + fact[i + 1][0] = j - 1; + } + } + for (i = fact[n][0]; i > 0; i--) + { + cout << fact[n][i]; + } + cout<>n; + if (n == 0) + break; + fact_large(n); + } + return 0; +} + +/* +Enter interger to compute factorial(0 to exit): 100 +93326215443944152681699238856266700490715968264381621468592963895217599993229915608941463976156518286253697920827223758251185210916864000000000000000000000000 +Enter interger to compute factorial(0 to exit): 50 +30414093201713378043612608166064768844377641568960512000000000000 +Enter interger to compute factorial(0 to exit): 72 +61234458376886086861524070385274672740778091784697328983823014963978384987221689274204160000000000000000 +Enter interger to compute factorial(0 to exit): 0 + +------------------ +(program exited with code: 1) +Press return to continue \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Find Factoial of a Number using Dynamic Programming.cpp b/c++/11_Numerical_Problems/C++ Program to Find Factoial of a Number using Dynamic Programming.cpp new file mode 100644 index 0000000..546adb9 --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Find Factoial of a Number using Dynamic Programming.cpp @@ -0,0 +1,55 @@ +/* + * C++ Program to Find Factorial of a Number using Dynamic Programming + */ +#include +#include +#include +#define ll long long +using namespace std; + +int result[1000] = {0}; +/* + * Find Factorial of a Number using Dynamic Programming + */ +ll fact_dp(int n) +{ + if (n >= 0) + { + result[0] = 1; + for (int i = 1; i <= n; ++i) + { + result[i] = i * result[i - 1]; + } + return result[n]; + } +} +/* + * Main + */ +int main() +{ + int n; + while (1) + { + cout<<"Enter interger to compute factorial(0 to exit): "; + cin>>n; + if (n == 0) + break; + cout< +#include +#include +#define ll long long +using namespace std; +/* + * Find Factorial of a Number using Iteration + */ +ll fact_iter(int n) +{ + ll result = 1; + for (int i = 1; i <= n; i++) + { + result *= i; + } + return result; +} +/* + * Main + */ +int main() +{ + int n; + while (1) + { + cout<<"Enter interger to compute factorial(0 to exit): "; + cin>>n; + if (n == 0) + break; + cout< +#include +#include +#define ll long long +using namespace std; +/* + * Find Factorial of a Number using Recursion + */ +ll fact_recur(int n) +{ + if (n == 0 || n == 1) + return 1; + else + return n * fact_recur(n - 1); +} +/* + * Main + */ +int main() +{ + int n; + while (1) + { + cout<<"Enter interger to compute factorial(0 to exit): "; + cin>>n; + if (n == 0) + break; + cout< +#include +#include +#define ll long long +using namespace std; + +ll fib[1000] = {0}; +/* + * Fibonacci Numbers using Dp + */ +ll fibo_dp(int n) +{ + fib[1] = 1; + fib[2] = 1; + if (fib[n] == 0) + { + for (int j = 3; j <= n; ++j) + { + if (fib[n] == 0) + fib[j] = fib[j - 1] + fib[j - 2]; + else + continue; + } + } + return fib[n]; +} + +/* + * Main + */ +int main() +{ + int n; + while (1) + { + cout<<"Enter the integer n to find nth fibonnaci no.(0 to exit): "; + cin>>n; + if (n == 0) + break; + cout< +#include +#include +#define ll long long +using namespace std; + +/* + * Iterative function to find Fibonacci Numbers + */ +ll fibo_iter(int n) +{ + int previous = 1; + int current = 1; + int next = 1; + for (int i = 3; i <= n; ++i) + { + next = current + previous; + previous = current; + current = next; + } + return next; +} +/* + * Main + */ +int main() +{ + int n; + while (1) + { + cout<<"Enter the integer n to find nth fibonnaci no.(0 to exit): "; + cin>>n; + if (n == 0) + break; + cout< +#include +#include +#define ll long long +using namespace std; + +/* + * function to multiply two matrices + */ +void multiply(ll F[2][2], ll M[2][2]) +{ + ll x = F[0][0] * M[0][0] + F[0][1] * M[1][0]; + ll y = F[0][0] * M[0][1] + F[0][1] * M[1][1]; + ll z = F[1][0] * M[0][0] + F[1][1] * M[1][0]; + ll w = F[1][0] * M[0][1] + F[1][1] * M[1][1]; + F[0][0] = x; + F[0][1] = y; + F[1][0] = z; + F[1][1] = w; +} + +/* + * function to calculate power of a matrix + */ +void power(ll F[2][2], int n) +{ + if (n == 0 || n == 1) + return; + ll M[2][2] = {{1,1},{1,0}}; + power(F, n / 2); + multiply(F, F); + if (n % 2 != 0) + multiply(F, M); +} + +/* + * function that returns nth Fibonacci number + */ +ll fibo_matrix(ll n) +{ + ll F[2][2] = {{1,1},{1,0}}; + if (n == 0) + return 0; + power(F, n - 1); + return F[0][0]; +} +/* + * Main + */ +int main() +{ + int n; + while (1) + { + cout<<"Enter the integer n to find nth fibonnaci no.(0 to exit): "; + cin>>n; + if (n == 0) + break; + cout< +#include +#include +#define ll long long +using namespace std; + +/* + * Recursive function to find Fibonnaci Numbers + */ +ll fibo_recur(int n) +{ + if (n == 1 || n == 2) + return 1; + else + return fibo_recur(n - 1) + fibo_recur(n - 2);; +} +/* + * Main + */ +int main() +{ + int n; + while (1) + { + cout<<"Enter the integer n to find nth fibonnaci no.(0 to exit): "; + cin>>n; + if (n == 0) + break; + cout< +#include +#include + +using namespace std; +int gcd(int u, int v) +{ + return (v != 0) ? gcd(v, u % v) : u; +} + +int main(void) +{ + int num1, num2, result; + cout << "Enter two numbers to find GCD using Euclidean algorithm: "; + cin >> num1 >> num2; + result = gcd(num1, num2); + if (gcd) + cout << "\nThe GCD of " << num1 << " and " << num2 << " is: " << result + << endl; + else + cout << "\nInvalid input!!!\n"; + return 0; +} + +/* +Enter two numbers to find GCD using Euclidean algorithm: 12 30 +The GCD of 12 and 30 is: 6 \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Find Inverse of a Matrix.cpp b/c++/11_Numerical_Problems/C++ Program to Find Inverse of a Matrix.cpp new file mode 100644 index 0000000..35a02c6 --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Find Inverse of a Matrix.cpp @@ -0,0 +1,565 @@ +#if !defined(MATRIX_H) +#define MATRIX_H +#include +#include +#include +#include +#include +class CMatrix +{ +private: + int m_rows; + int m_cols; + char m_name[128]; + CMatrix(); +public: + double **m_pData; + CMatrix(const char *name, int rows, int cols) : + m_rows(rows), m_cols(cols) + { + strcpy(m_name, name); + m_pData = new double*[m_rows]; + for (int i = 0; i < m_rows; i++) + m_pData[i] = new double[m_cols]; + for (int i = 0; i < m_rows; i++) + { + for (int j = 0; j < m_cols; j++) + { + m_pData[i][j] = 0.0; + } + } + } + CMatrix(const CMatrix &other) + { + strcpy(m_name, other.m_name); + m_rows = other.m_rows; + m_cols = other.m_cols; + m_pData = new double*[m_rows]; + for (int i = 0; i < m_rows; i++) + m_pData[i] = new double[m_cols]; + for (int i = 0; i < m_rows; i++) + { + for (int j = 0; j < m_cols; j++) + { + m_pData[i][j] = other.m_pData[i][j]; + } + } + } + ~CMatrix() + { + for (int i = 0; i < m_rows; i++) + delete[] m_pData[i]; + delete[] m_pData; + m_rows = m_cols = 0; + } + void SetName(const char *name) + { + strcpy(m_name, name); + } + const char* GetName() const + { + return m_name; + } + void GetInput() + { + std::cin >> *this; + } + void FillSimulatedInput() + { + static int factor1 = 1, factor2 = 2; + std::cout << "\n\nEnter Input For Matrix : " << m_name << " Rows: " + << m_rows << " Cols: " << m_cols << "\n"; + for (int i = 0; i < m_rows; i++) + { + for (int j = 0; j < m_cols; j++) + { + std::cout << "Input For Row: " << i + 1 << " Col: " << j + + 1 << " = "; + int data = ((i + 1) * factor1) + (j + 1) * factor2; + m_pData[i][j] = data / 10.2; + std::cout << m_pData[i][j] << "\n"; + factor1 += (rand() % 4); + factor2 += (rand() % 3); + } + std::cout << "\n"; + } + std::cout << "\n"; + } + double Determinant() + { + double det = 0; + double **pd = m_pData; + switch (m_rows) + { + case 2: + { + det = pd[0][0] * pd[1][1] - pd[0][1] * pd[1][0]; + return det; + } + break; + case 3: + { + /*** + a b c + d e f + g h i + + a b c a b c + d e f d e f + g h i g h i + + // det (A) = aei + bfg + cdh - afh - bdi - ceg. + ***/ + double a = pd[0][0]; + double b = pd[0][1]; + double c = pd[0][2]; + double d = pd[1][0]; + double e = pd[1][1]; + double f = pd[1][2]; + double g = pd[2][0]; + double h = pd[2][1]; + double i = pd[2][2]; + double det = (a * e * i + b * f * g + c * d * h); + det = det - a * f * h; + det = det - b * d * i; + det = det - c * e * g; + return det; + } + break; + case 4: + { + CMatrix *temp[4]; + for (int i = 0; i < 4; i++) + temp[i] = new CMatrix("", 3, 3); + for (int k = 0; k < 4; k++) + { + for (int i = 1; i < 4; i++) + { + int j1 = 0; + for (int j = 0; j < 4; j++) + { + if (k == j) + continue; + temp[k]->m_pData[i - 1][j1++] + = this->m_pData[i][j]; + } + } + } + double det = this->m_pData[0][0] * temp[0]->Determinant() + - this->m_pData[0][1] * temp[1]->Determinant() + + this->m_pData[0][2] * temp[2]->Determinant() + - this->m_pData[0][3] * temp[3]->Determinant(); + return det; + } + break; + case 5: + { + CMatrix *temp[5]; + for (int i = 0; i < 5; i++) + temp[i] = new CMatrix("", 4, 4); + for (int k = 0; k < 5; k++) + { + for (int i = 1; i < 5; i++) + { + int j1 = 0; + for (int j = 0; j < 5; j++) + { + if (k == j) + continue; + temp[k]->m_pData[i - 1][j1++] + = this->m_pData[i][j]; + } + } + } + double det = this->m_pData[0][0] * temp[0]->Determinant() + - this->m_pData[0][1] * temp[1]->Determinant() + + this->m_pData[0][2] * temp[2]->Determinant() + - this->m_pData[0][3] * temp[3]->Determinant() + + this->m_pData[0][4] * temp[4]->Determinant(); + return det; + } + case 6: + case 7: + case 8: + case 9: + case 10: + case 11: + case 12: + default: + { + int DIM = m_rows; + CMatrix **temp = new CMatrix*[DIM]; + for (int i = 0; i < DIM; i++) + temp[i] = new CMatrix("", DIM - 1, DIM - 1); + for (int k = 0; k < DIM; k++) + { + for (int i = 1; i < DIM; i++) + { + int j1 = 0; + for (int j = 0; j < DIM; j++) + { + if (k == j) + continue; + temp[k]->m_pData[i - 1][j1++] + = this->m_pData[i][j]; + } + } + } + double det = 0; + for (int k = 0; k < DIM; k++) + { + if ((k % 2) == 0) + det = det + (this->m_pData[0][k] + * temp[k]->Determinant()); + else + det = det - (this->m_pData[0][k] + * temp[k]->Determinant()); + } + for (int i = 0; i < DIM; i++) + delete temp[i]; + delete[] temp; + return det; + } + break; + } + } + CMatrix& operator =(const CMatrix &other) + { + if (this->m_rows != other.m_rows || this->m_cols != other.m_cols) + { + std::cout + << "WARNING: Assignment is taking place with by changing the number of rows and columns of the matrix"; + } + for (int i = 0; i < m_rows; i++) + delete[] m_pData[i]; + delete[] m_pData; + m_rows = m_cols = 0; + strcpy(m_name, other.m_name); + m_rows = other.m_rows; + m_cols = other.m_cols; + m_pData = new double*[m_rows]; + for (int i = 0; i < m_rows; i++) + m_pData[i] = new double[m_cols]; + for (int i = 0; i < m_rows; i++) + { + for (int j = 0; j < m_cols; j++) + { + m_pData[i][j] = other.m_pData[i][j]; + } + } + return *this; + } + CMatrix CoFactor() + { + CMatrix cofactor("COF", m_rows, m_cols); + if (m_rows != m_cols) + return cofactor; + if (m_rows < 2) + return cofactor; + else if (m_rows == 2) + { + cofactor.m_pData[0][0] = m_pData[1][1]; + cofactor.m_pData[0][1] = -m_pData[1][0]; + cofactor.m_pData[1][0] = -m_pData[0][1]; + cofactor.m_pData[1][1] = m_pData[0][0]; + return cofactor; + } + else if (m_rows >= 3) + { + int DIM = m_rows; + CMatrix ***temp = new CMatrix**[DIM]; + for (int i = 0; i < DIM; i++) + temp[i] = new CMatrix*[DIM]; + for (int i = 0; i < DIM; i++) + for (int j = 0; j < DIM; j++) + temp[i][j] = new CMatrix("", DIM - 1, DIM - 1); + for (int k1 = 0; k1 < DIM; k1++) + { + for (int k2 = 0; k2 < DIM; k2++) + { + int i1 = 0; + for (int i = 0; i < DIM; i++) + { + int j1 = 0; + for (int j = 0; j < DIM; j++) + { + if (k1 == i || k2 == j) + continue; + temp[k1][k2]->m_pData[i1][j1++] + = this->m_pData[i][j]; + } + if (k1 != i) + i1++; + } + } + } + bool flagPositive = true; + for (int k1 = 0; k1 < DIM; k1++) + { + flagPositive = ((k1 % 2) == 0); + for (int k2 = 0; k2 < DIM; k2++) + { + if (flagPositive == true) + { + cofactor.m_pData[k1][k2] + = temp[k1][k2]->Determinant(); + flagPositive = false; + } + else + { + cofactor.m_pData[k1][k2] + = -temp[k1][k2]->Determinant(); + flagPositive = true; + } + } + } + for (int i = 0; i < DIM; i++) + for (int j = 0; j < DIM; j++) + delete temp[i][j]; + for (int i = 0; i < DIM; i++) + delete[] temp[i]; + delete[] temp; + } + return cofactor; + } + CMatrix Adjoint() + { + CMatrix cofactor("COF", m_rows, m_cols); + CMatrix adj("ADJ", m_rows, m_cols); + if (m_rows != m_cols) + return adj; + cofactor = this->CoFactor(); + // adjoint is transpose of a cofactor of a matrix + for (int i = 0; i < m_rows; i++) + { + for (int j = 0; j < m_cols; j++) + { + adj.m_pData[j][i] = cofactor.m_pData[i][j]; + } + } + return adj; + } + CMatrix Transpose() + { + CMatrix trans("TR", m_cols, m_rows); + for (int i = 0; i < m_rows; i++) + { + for (int j = 0; j < m_cols; j++) + { + trans.m_pData[j][i] = m_pData[i][j]; + } + } + return trans; + } + CMatrix Inverse() + { + CMatrix cofactor("COF", m_rows, m_cols); + CMatrix inv("INV", m_rows, m_cols); + if (m_rows != m_cols) + return inv; + // to find out Determinant + double det = Determinant(); + cofactor = this->CoFactor(); + // inv = transpose of cofactor / Determinant + for (int i = 0; i < m_rows; i++) + { + for (int j = 0; j < m_cols; j++) + { + inv.m_pData[j][i] = cofactor.m_pData[i][j] / det; + } + } + return inv; + } + CMatrix operator +(const CMatrix &other) + { + if (this->m_rows != other.m_rows || this->m_cols != other.m_cols) + { + std::cout + << "Addition could not take place because number of rows and columns are different between the two matrices"; + return *this; + } + CMatrix result("", m_rows, m_cols); + for (int i = 0; i < m_rows; i++) + { + for (int j = 0; j < m_cols; j++) + { + result.m_pData[i][j] = this->m_pData[i][j] + + other.m_pData[i][j]; + } + } + return result; + } + CMatrix operator -(const CMatrix &other) + { + if (this->m_rows != other.m_rows || this->m_cols != other.m_cols) + { + std::cout + << "Subtraction could not take place because number of rows and columns are different between the two matrices"; + return *this; + } + CMatrix result("", m_rows, m_cols); + for (int i = 0; i < m_rows; i++) + { + for (int j = 0; j < m_cols; j++) + { + result.m_pData[i][j] = this->m_pData[i][j] + - other.m_pData[i][j]; + } + } + return result; + } + CMatrix operator *(const CMatrix &other) + { + if (this->m_cols != other.m_rows) + { + std::cout + << "Multiplication could not take place because number of columns of 1st Matrix and number of rows in 2nd Matrix are different"; + return *this; + } + CMatrix result("", this->m_rows, other.m_cols); + for (int i = 0; i < this->m_rows; i++) + { + for (int j = 0; j < other.m_cols; j++) + { + for (int k = 0; k < this->m_cols; k++) + { + result.m_pData[i][j] += this->m_pData[i][k] + * other.m_pData[k][j]; + } + } + } + return result; + } + bool operator ==(const CMatrix &other) + { + if (this->m_rows != other.m_rows || this->m_cols != other.m_cols) + { + std::cout + << "Comparision could not take place because number of rows and columns are different between the two matrices"; + return false; + } + CMatrix result("", m_rows, m_cols); + bool bEqual = true; + for (int i = 0; i < m_rows; i++) + { + for (int j = 0; j < m_cols; j++) + { + if (this->m_pData[i][j] != other.m_pData[i][j]) + bEqual = false; + } + } + return bEqual; + } + friend std::istream& operator >>(std::istream &is, CMatrix &m); + friend std::ostream& operator <<(std::ostream &os, const CMatrix &m); +}; +std::istream& operator >>(std::istream &is, CMatrix &m) +{ + std::cout << "\n\nEnter Input For Matrix : " << m.m_name << " Rows: " + << m.m_rows << " Cols: " << m.m_cols << "\n"; + for (int i = 0; i < m.m_rows; i++) + { + for (int j = 0; j < m.m_cols; j++) + { + std::cout << "Input For Row: " << i + 1 << " Col: " << j + 1 + << " = "; + is >> m.m_pData[i][j]; + } + std::cout << "\n"; + } + std::cout << "\n"; + return is; +} +std::ostream& operator <<(std::ostream &os, const CMatrix &m) +{ + os << "\n\nMatrix : " << m.m_name << " Rows: " << m.m_rows << " Cols: " + << m.m_cols << "\n\n"; + for (int i = 0; i < m.m_rows; i++) + { + os << " | "; + for (int j = 0; j < m.m_cols; j++) + { + char buf[32]; + double data = m.m_pData[i][j]; + if (m.m_pData[i][j] > -0.00001 && m.m_pData[i][j] < 0.00001) + data = 0; + sprintf(buf, "%10.2lf ", data); + os << buf; + } + os << "|\n"; + } + os << "\n\n"; + return os; +} +#endif +int main() +{ + CMatrix a("A", 5, 5); + //std::cin >> a; + a.FillSimulatedInput(); + CMatrix aadj = a.Inverse(); + std::cout << a; + std::cout << aadj; + CMatrix unit = (a * aadj); + unit.SetName("A * A-Inv"); + std::cout << unit; +} + +/* + +Enter Input For Matrix : +A Rows: 5 +Cols: 5 +Input For Row: 1 Col: 1 = 0.294118 +Input For Row: 1 Col: 2 = 0.980392 +Input For Row: 1 Col: 3 = 1.86275 +Input For Row: 1 Col: 4 = 2.84314 +Input For Row: 1 Col: 5 = 3.62745 + +Input For Row: 2 Col: 1 = 2.54902 +Input For Row: 2 Col: 2 = 3.92157 +Input For Row: 2 Col: 3 = 5.09804 +Input For Row: 2 Col: 4 = 7.05882 +Input For Row: 2 Col: 5 = 9.80392 + +Input For Row: 3 Col: 1 = 6.66667 +Input For Row: 3 Col: 2 = 8.92157 +Input For Row: 3 Col: 3 = 10.8824 +Input For Row: 3 Col: 4 = 12.6471 +Input For Row: 3 Col: 5 = 15.3922 + +Input For Row: 4 Col: 1 = 12.0588 +Input For Row: 4 Col: 2 = 15.098 +Input For Row: 4 Col: 3 = 18.1373 +Input For Row: 4 Col: 4 = 20.7843 +Input For Row: 4 Col: 5 = 24.4118 + +Input For Row: 5 Col: 1 = 21.1765 +Input For Row: 5 Col: 2 = 24.7059 +Input For Row: 5 Col: 3 = 27.7451 +Input For Row: 5 Col: 4 = 31.0784 +Input For Row: 5 Col: 5 = 34.3137 + +Matrix : A Rows: 5 Cols: 5 + + | 0.29 0.98 1.86 2.84 3.63 | + | 2.55 3.92 5.10 7.06 9.80 | + | 6.67 8.92 10.88 12.65 15.39 | + | 12.06 15.10 18.14 20.78 24.41 | + | 21.18 24.71 27.75 31.08 34.31 | + +Matrix : INV Rows: 5 Cols: 5 + + | -0.93 0.80 -3.74 2.86 -0.49 | + | 0.37 -0.32 5.35 -4.91 1.14 | + | -0.78 -0.93 -1.46 2.96 -1.10 | + | 2.37 -0.10 0.25 -1.65 0.84 | + | -1.21 0.57 -0.58 0.87 -0.36 | + +Matrix : A * A-Inv Rows: 5 Cols: 5 + + | 1.00 0.00 0.00 0.00 0.00 | + | 0.00 1.00 0.00 0.00 0.00 | + | 0.00 0.00 1.00 0.00 0.00 | + | 0.00 0.00 0.00 1.00 0.00 | + | 0.00 0.00 0.00 0.00 1.00 | \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Find Path Between Two Nodes in a Graph.cpp b/c++/11_Numerical_Problems/C++ Program to Find Path Between Two Nodes in a Graph.cpp new file mode 100644 index 0000000..9808b2a --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Find Path Between Two Nodes in a Graph.cpp @@ -0,0 +1,109 @@ +#include +#include + +using namespace std; + +// This class represents a directed graph using adjacency list representation +class Graph +{ + int V; // No. of vertices + list *adj; // Pointer to an array containing adjacency lists +public: + Graph(int V); // Constructor + void addEdge(int v, int w); // function to add an edge to graph + bool isReachable(int s, int d); // returns true if there is a path from s to d +}; + +Graph::Graph(int V) +{ + this->V = V; + adj = new list [V]; +} + +void Graph::addEdge(int v, int w) +{ + adj[v].push_back(w); // Add w to v’s list. +} + +// A BFS based function to check whether d is reachable from s. +bool Graph::isReachable(int s, int d) +{ + // Base case + if (s == d) + return true; + // Mark all the vertices as not visited + bool *visited = new bool[V]; + for (int i = 0; i < V; i++) + visited[i] = false; + // Create a queue for BFS + list queue; + // Mark the current node as visited and enqueue it + visited[s] = true; + queue.push_back(s); + // it will be used to get all adjacent vertices of a vertex + list::iterator i; + while (!queue.empty()) + { + // Dequeue a vertex from queue and print it + s = queue.front(); + queue.pop_front(); + // Get all adjacent vertices of the dequeued vertex s + // If a adjacent has not been visited, then mark it visited + // and enqueue it + for (i = adj[s].begin(); i != adj[s].end(); ++i) + { + // If this adjacent node is the destination node, then return true + if (*i == d) + return true; + // Else, continue to do BFS + if (!visited[*i]) + { + visited[*i] = true; + queue.push_back(*i); + } + } + } + return false; +} + +// Driver program to test methods of graph class +int main() +{ + // Create a graph given in the above diagram + Graph g(4); + g.addEdge(0, 1); + g.addEdge(0, 2); + g.addEdge(1, 2); + g.addEdge(2, 0); + g.addEdge(2, 3); + g.addEdge(3, 3); + cout << "Enter the source and destination vertices: (0-3)"; + int u, v; + cin >> u >> v; + if (g.isReachable(u, v)) + cout << "\nThere is a path from " << u << " to " << v; + else + cout << "\nThere is no path from " << u << " to " << v; + int temp; + temp = u; + u = v; + v = temp; + if (g.isReachable(u, v)) + cout << "\nThere is a path from " << u << " to " << v; + else + cout << "\nThere is no path from " << u << " to " << v; + return 0; +} + +/* +Enter the source and destination vertices: (0-3) +1 3 + +There is a path from 1 to 3 +There is no path from 3 to 1 + +Enter the source and destination vertices: (0-3) +2 3 + +There is a path from 2 to 3 +There is no path from 3 to 2 \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Find the GCD and LCM of n Numbers.cpp b/c++/11_Numerical_Problems/C++ Program to Find the GCD and LCM of n Numbers.cpp new file mode 100644 index 0000000..6d40571 --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Find the GCD and LCM of n Numbers.cpp @@ -0,0 +1,57 @@ +#include +#include +#include + +using namespace std; + +int gcd(int x, int y) +{ + int r = 0, a, b; + a = (x > y) ? x : y; // a is greater number + b = (x < y) ? x : y; // b is smaller number + r = b; + while (a % b != 0) + { + r = a % b; + a = b; + b = r; + } + return r; +} + +int lcm(int x, int y) +{ + int a; + a = (x > y) ? x : y; // a is greater number + while (true) + { + if (a % x == 0 && a % y == 0) + return a; + ++a; + } +} + +int main(int argc, char **argv) +{ + cout << "Enter the two numbers: "; + int x, y; + cin >> x >> y; + cout << "The GCD of two numbers is: " << gcd(x, y) << endl; + ; + cout << "The LCM of two numbers is: " << lcm(x, y) << endl; + ; + return 0; +} + +/* +Enter the two numbers: +5 +8 +The GCD of two numbers is: 1 +The LCM of two numbers is: 40 + +Enter the two numbers: +100 +50 +The GCD of two numbers is: 50 +The LCM of two numbers is: 100 \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Generate N Number of Passwords of Length M Each.cpp b/c++/11_Numerical_Problems/C++ Program to Generate N Number of Passwords of Length M Each.cpp new file mode 100644 index 0000000..7dafe6f --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Generate N Number of Passwords of Length M Each.cpp @@ -0,0 +1,179 @@ +#include +#include +#include + +using namespace std; + +void permute(int *a, int k, int size) +{ + if (k == size) + { + for (int i = 0; i < size; i++) + { + cout << *(a + i); + } + cout << endl; + } + else + { + for (int i = k; i < size; i++) + { + int temp = a[k]; + a[k] = a[i]; + a[i] = temp; + permute(a, k + 1, size); + temp = a[k]; + a[k] = a[i]; + a[i] = temp; + } + } +} +int main(int argc, char **argv) +{ + cout << "Enter the length of the password: "; + int m; + cin >> m; + int a[m]; + for (int i = 0; i < m; i++) + { + /*generates random number between 1 and 10*/ + a[i] = rand() % 10; + } + for (int i = 0; i < m; i++) + { + cout << a[i] << ", "; + } + cout << "The Passwords are: "; + permute(a, 0, m); +} + +/* +Enter the length of the password: 3 +1, 7, 4, The Passwords are: 174 +147 +714 +741 +471 +417 + +Enter the length of the password: 5 +1, 7, 4, 0, 9, The Passwords are: 17409 +17490 +17049 +17094 +17904 +17940 +14709 +14790 +14079 +14097 +14907 +14970 +10479 +10497 +10749 +10794 +10974 +10947 +19407 +19470 +19047 +19074 +19704 +19740 +71409 +71490 +71049 +71094 +71904 +71940 +74109 +74190 +74019 +74091 +74901 +74910 +70419 +70491 +70149 +70194 +70914 +70941 +79401 +79410 +79041 +79014 +79104 +79140 +47109 +47190 +47019 +47091 +47901 +47910 +41709 +41790 +41079 +41097 +41907 +41970 +40179 +40197 +40719 +40791 +40971 +40917 +49107 +49170 +49017 +49071 +49701 +49710 +07419 +07491 +07149 +07194 +07914 +07941 +04719 +04791 +04179 +04197 +04917 +04971 +01479 +01497 +01749 +01794 +01974 +01947 +09417 +09471 +09147 +09174 +09714 +09741 +97401 +97410 +97041 +97014 +97104 +97140 +94701 +94710 +94071 +94017 +94107 +94170 +90471 +90417 +90741 +90714 +90174 +90147 +91407 +91470 +91047 +91074 +91704 +91740 \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Generate Prime Numbers Between a Given Range Using the Sieve of Sundaram.cpp b/c++/11_Numerical_Problems/C++ Program to Generate Prime Numbers Between a Given Range Using the Sieve of Sundaram.cpp new file mode 100644 index 0000000..b1658ac --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Generate Prime Numbers Between a Given Range Using the Sieve of Sundaram.cpp @@ -0,0 +1,72 @@ +#include + +using namespace std; + +int main() +{ + cout << "Welcome to the Sieve of Sundaram\n" << endl; + int arraySize; + int numberPrimes = 0; + cout << "Input a positive integer to find all the prime numbers up to and " + << "\nincluding that number: "; + cin >> arraySize; + int n = arraySize / 2; + /* array to start off with that will eventually get + all the composite numbers removed and the remaining + ones output to the screen */ + int isPrime[arraySize + 1]; + for (int i = 0; i < n; ++i) + { + isPrime[i] = i; + } + for (int i = 1; i < n; i++) + { + for (int j = i; j <= (n - i) / (2 * i + 1); j++) + { + isPrime[i + j + 2 * i * j] = 0;/*From this list, remove all + numbers of the form i + j + 2ij */ + } + } + int TheseArePrime = 0; + if (arraySize > 2) + { + isPrime[TheseArePrime++] = 2;/*this IF statement adds 2 to the output */ + } + for (int i = 1; i < n; i++) + { + if (isPrime[i] != 0) + { + isPrime[TheseArePrime++] = i * 2 + 1; + } + } + int size = sizeof isPrime / sizeof(int);//total size of array/size of array data type + for (int x = 0; x <= size; x++) + { + if (isPrime[x] != 0) + { + cout << isPrime[x] << "\t";//outputs all prime numbers found + numberPrimes++;// the counter of the number of primes found + } + else + { + break; + } + } + cout << "\nNumber of Primes: " << numberPrimes << endl; + return 0; +} + +/* +Welcome to the Sieve of Sundaram + +Input a positive integer to find all the prime numbers up to and +including that number: 10 +2 3 5 7 +Number of Primes: 4 + +Welcome to the Sieve of Sundaram + +Input a positive integer to find all the prime numbers up to and +including that number: 100 +2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 +Number of Primes: 25 \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Generate Random Hexadecimal Bytes.cpp b/c++/11_Numerical_Problems/C++ Program to Generate Random Hexadecimal Bytes.cpp new file mode 100644 index 0000000..3e5d8fe --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Generate Random Hexadecimal Bytes.cpp @@ -0,0 +1,18 @@ +#include +#include +#include + +using namespace std; + +int main(int argc, char **argv) +{ + int val = rand(); + char Hex[33]; + itoa(val, Hex, 16); + cout<< "Random Decimal Byte:" << val; + cout << "\nEquivalent Hex Byte: " << Hex; +} + +/* +Random Decimal Byte:41 +Equivalent Hex Byte: 29 \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Generate Random Numbers Using Middle Square Method.cpp b/c++/11_Numerical_Problems/C++ Program to Generate Random Numbers Using Middle Square Method.cpp new file mode 100644 index 0000000..7c86fb8 --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Generate Random Numbers Using Middle Square Method.cpp @@ -0,0 +1,45 @@ +/*This is a C++ Program to generate random numbers using Middle Square method. In mathematics, the middle-square method is a method of generating pseudorandom numbers. In practice it is not a good method, since its period is usually very short and it has some severe weaknesses, such as the output sequence almost always converging to zero.*/ + +#include +#include +#include + +using namespace std; + +int a[] = { 1, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000 }; +int middleSquareNumber(int numb, int dig) +{ + int sqn = numb * numb, next_num = 0; + int trim = (dig / 2); + sqn = sqn / a[trim]; + for (int i = 0; i < dig; i++) + { + next_num += (sqn % (a[trim])) * (a[i]); + sqn = sqn / 10; + } + return next_num; +} + +int main(int argc, char **argv) +{ + cout << "Enter the #-digit random numbers you want: "; + int n; + cin >> n; + int start = 1, end = 1; + start = a[n - 1]; + end = a[n]; + int number = ((rand()) % (end - start)) + start; + cout << "The random numbers are:\n" << number << ", "; + for (int i = 1; i < n; i++) + { + number = middleSquareNumber(number, n); + cout << number << ", "; + } + cout << "..."; +} + +/* + +Enter the #-digit random numbers you want: 5 +The random numbers are: +10041, 16426, 796264, -276041, -115546, ... \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Generate Random Numbers Using Multiply with Carry Method.cpp b/c++/11_Numerical_Problems/C++ Program to Generate Random Numbers Using Multiply with Carry Method.cpp new file mode 100644 index 0000000..e343a7f --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Generate Random Numbers Using Multiply with Carry Method.cpp @@ -0,0 +1,31 @@ +/*This is a C++ Program to generate random numbers using Multiply with Carry method. In computer science, multiply-with-carry (MWC) is a method invented by George Marsaglia for generating sequences of random integers based on an initial set from two to many thousands of randomly chosen seed values. The main advantages of the MWC method are that it invokes simple computer integer arithmetic and leads to very fast generation of sequences of random numbers with immense periods, ranging from around 260 to 22000000.*/ + +#include +#include +#include + +using namespace std; + +int main(int argc, char **argv) +{ + int max_Sequence_Elements = 10; + int base_b = 2000; + int multiplier_a = rand() % base_b; + int r = 1; + int c[max_Sequence_Elements]; + int x[max_Sequence_Elements]; + c[0] = rand() % multiplier_a; + x[0] = rand() % base_b; + cout << "The random number sequence is: " << x[0]; + //generating sequence + for (int i = 1; i < max_Sequence_Elements; i++) + { + x[i] = (multiplier_a * x[i - r] + c[i - 1]) % base_b; + c[i] = (multiplier_a * x[i - r] + c[i - 1]) / base_b; + cout << " " << x[i]; + } + cout << "..."; +} + +/* +The random number sequence is: 334 1711 157 472 1355 1564 151 223 1146 990... \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Generate Random Numbers Using Probability Distribution Function.cpp b/c++/11_Numerical_Problems/C++ Program to Generate Random Numbers Using Probability Distribution Function.cpp new file mode 100644 index 0000000..c26e7ba --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Generate Random Numbers Using Probability Distribution Function.cpp @@ -0,0 +1,34 @@ +/*This is a C++ Program to generate random numbers using Probability Distribution Function. Probability distribution is based on probability density function. a probability density function (pdf), or density of a continuous random variable, is a function that describes the relative likelihood for this random variable to take on a given value. The probability of the random variable falling within a particular range of values is given by the integral of this variable’s density over that range—that is, it is given by the area under the density function but above the horizontal axis and between the lowest and greatest values of the range.*/ + +//pdf(x) = 1 if x>360 +// = 0 if x<0 +// = x/360 otherwise +#include +#include +#include + +using namespace std; + +//This is a sample program to generate a random numbers based on probability desity function of spiner +//pdf(x) = 1 if x>360 +// = 0 if x<0 +// = x/360 otherwise +int N = 10; +int main(int argc, char **argv) +{ + int p = 0; + for (int i = 0; i < N; i++) + { + p = rand() % 400; + if (p > 360) + cout << 0 << " "; + else if (p < 0) + cout << 0 << " "; + else + cout << p * 0.1 / 360 << " "; + } + cout << "..."; +} + +/* +0.0113889 0.0186111 0.0927778 0.0277778 0 0.0344444 0.0772222 0.0438889 0.045 0.0177778 ... \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Generate Randomized Sequence of Given Range of Numbers.cpp b/c++/11_Numerical_Problems/C++ Program to Generate Randomized Sequence of Given Range of Numbers.cpp new file mode 100644 index 0000000..8d9a98c --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Generate Randomized Sequence of Given Range of Numbers.cpp @@ -0,0 +1,26 @@ +#include +#include +#include + +const int LOW = 1; +const int HIGH = 32000; + +using namespace std; + +int main() +{ + int randomNumber; + time_t seconds; + time(&seconds); + srand((unsigned int) seconds); + for (int i = 0; i < 10; i++) + { + randomNumber = rand() % (HIGH - LOW + 1) + LOW; + cout << randomNumber << " "; + } + cout << "..."; + return 0; +} + +/* +312 7423 23444 16008 31816 1823 29315 17424 11753 18384 ... \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Implement Booth’s Multiplication Algorithm for Multiplication of 2 signed Numbers.cpp b/c++/11_Numerical_Problems/C++ Program to Implement Booth’s Multiplication Algorithm for Multiplication of 2 signed Numbers.cpp new file mode 100644 index 0000000..a80bf8a --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Implement Booth’s Multiplication Algorithm for Multiplication of 2 signed Numbers.cpp @@ -0,0 +1,141 @@ +/*This is a C++ Program to multiply two signed numbers using booth’s algorithm. Booth’s multiplication algorithm is a multiplication algorithm that multiplies two signed binary numbers in two’s complement notation. Booth used desk calculators that were faster at shifting than adding and created the algorithm to increase their speed. Booth’s algorithm is of interest in the study of computer architecture.*/ + +#include +#include + +using namespace std; + +void add(int a[], int x[], int qrn); +void complement(int a[], int n) +{ + int i; + int x[8] = { NULL }; + x[0] = 1; + for (i = 0; i < n; i++) + { + a[i] = (a[i] + 1) % 2; + } + add(a, x, n); +} + +void add(int ac[], int x[], int qrn) +{ + int i, c = 0; + for (i = 0; i < qrn; i++) + { + ac[i] = ac[i] + x[i] + c; + if (ac[i] > 1) + { + ac[i] = ac[i] % 2; + c = 1; + } + else + c = 0; + } +} + +void ashr(int ac[], int qr[], int &qn, int qrn) +{ + int temp, i; + temp = ac[0]; + qn = qr[0]; + cout << "\t\tashr\t\t"; + for (i = 0; i < qrn - 1; i++) + { + ac[i] = ac[i + 1]; + qr[i] = qr[i + 1]; + } + qr[qrn - 1] = temp; +} + +void display(int ac[], int qr[], int qrn) +{ + int i; + for (i = qrn - 1; i >= 0; i--) + cout << ac[i]; + cout << " "; + for (i = qrn - 1; i >= 0; i--) + cout << qr[i]; +} + +int main(int argc, char **argv) +{ + int mt[10], br[10], qr[10], sc, ac[10] = { 0 }; + int brn, qrn, i, qn, temp; + cout + << "\n--Enter the multiplicand and multipier in signed 2's complement form if negative--"; + cout << "\n Number of multiplicand bit="; + cin >> brn; + cout << "\nmultiplicand="; + for (i = brn - 1; i >= 0; i--) + cin >> br[i]; //multiplicand + for (i = brn - 1; i >= 0; i--) + mt[i] = br[i]; // copy multipier to temp array mt[] + complement(mt, brn); + cout << "\nNo. of multiplier bit="; + cin >> qrn; + sc = qrn; //sequence counter + cout << "Multiplier="; + for (i = qrn - 1; i >= 0; i--) + cin >> qr[i]; //multiplier + qn = 0; + temp = 0; + cout << "qn\tq[n+1]\t\tBR\t\tAC\tQR\t\tsc\n"; + cout << "\t\t\tinitial\t\t"; + display(ac, qr, qrn); + cout << "\t\t" << sc << "\n"; + while (sc != 0) + { + cout << qr[0] << "\t" << qn; + if ((qn + qr[0]) == 1) + { + if (temp == 0) + { + add(ac, mt, qrn); + cout << "\t\tsubtracting BR\t"; + for (i = qrn - 1; i >= 0; i--) + cout << ac[i]; + temp = 1; + } + else if (temp == 1) + { + add(ac, br, qrn); + cout << "\t\tadding BR\t"; + for (i = qrn - 1; i >= 0; i--) + cout << ac[i]; + temp = 0; + } + cout << "\n\t"; + ashr(ac, qr, qn, qrn); + } + else if (qn - qr[0] == 0) + ashr(ac, qr, qn, qrn); + display(ac, qr, qrn); + cout << "\t"; + sc--; + cout << "\t" << sc << "\n"; + } + cout << "Result="; + display(ac, qr, qrn); +} + +/* +--Enter the multiplicand and multipier in signed 2's complement form if negative-- +Number of multiplicand bit=5 +Multiplicand=1 0 1 1 1 + +Number of multiplier bit=5 +Multiplier=1 0 0 1 1 + +qn q[n+1] BR AC QR sc + initial 00000 10011 5 +1 0 subtracting BR 01001 + ashr 00100 11001 4 +1 1 ashr 00010 01100 3 +0 1 adding BR 11001 + ashr 11100 10110 2 +0 0 ashr 11110 01011 1 +1 0 subtracting BR 00111 + ashr 00011 10101 0 + +Result=00011 10101 \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Implement Coppersmith Freivald’s Algorithm.cpp b/c++/11_Numerical_Problems/C++ Program to Implement Coppersmith Freivald’s Algorithm.cpp new file mode 100644 index 0000000..b5fe347 --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Implement Coppersmith Freivald’s Algorithm.cpp @@ -0,0 +1,129 @@ +#include +#include +#include + +using namespace std; + +int main(int argc, char **argv) +{ + cout << "Enter the dimension of the matrices: "; + int n; + cin >> n; + cout << "Enter the 1st matrix: "; + double a[n][n]; + for (int i = 0; i < n; i++) + { + for (int j = 0; j < n; j++) + { + cin >> a[i][j]; + } + } + cout << "Enter the 2nd matrix: "; + double b[n][n]; + for (int i = 0; i < n; i++) + { + for (int j = 0; j < n; j++) + { + cin >> b[i][j]; + } + } + cout << "Enter the result matrix: "; + double c[n][n]; + for (int i = 0; i < n; i++) + { + for (int j = 0; j < n; j++) + { + cin >> c[i][j]; + } + } + //random generation of the r vector containing only 0/1 as its elements + double r[n][1]; + for (int i = 0; i < n; i++) + { + r[i][0] = rand() % 2; + cout << r[i][0] << " "; + } + //test A * (b*r) - (C*) = 0 + double br[n][1]; + for (int i = 0; i < n; i++) + { + for (int j = 0; j < 1; j++) + { + for (int k = 0; k < n; k++) + { + br[i][j] = br[i][j] + b[i][k] * r[k][j]; + } + } + } + double cr[n][1]; + for (int i = 0; i < n; i++) + { + for (int j = 0; j < 1; j++) + { + for (int k = 0; k < n; k++) + { + cr[i][j] = cr[i][j] + c[i][k] * r[k][j]; + } + } + } + double abr[n][1]; + for (int i = 0; i < n; i++) + { + for (int j = 0; j < 1; j++) + { + for (int k = 0; k < n; k++) + { + abr[i][j] = abr[i][j] + a[i][k] * br[k][j]; + } + } + } + // br = multiplyVector(b, r, n); + // cr = multiplyVector(c, r, n); + // abr = multiplyVector(a, br, n); + //abr-cr + for (int i = 0; i < n; i++) + { + abr[i][0] -= cr[i][0]; + } + bool flag = true; + for (int i = 0; i < n; i++) + { + if (abr[i][0] == 0) + continue; + else + flag = false; + } + if (flag == true) + cout << "Yes"; + else + cout << "No"; +} + +/* + +Enter the dimension of the matrices: 2 +Enter the 1st matrix: +1 2 +2 3 +Enter the 2nd matrix: +1 3 +3 4 +Enter the result matrix: +9 9 +14 15 + +Yes + +Enter the dimesion of the matrices: +2 +Enter the 1st matrix: +2 3 +3 4 +Enter the 2st matrix: +1 0 +1 2 +Enter the result matrix: +6 5 +8 7 + +Yes \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Implement Euler Theorem.cpp b/c++/11_Numerical_Problems/C++ Program to Implement Euler Theorem.cpp new file mode 100644 index 0000000..a9d5d16 --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Implement Euler Theorem.cpp @@ -0,0 +1,37 @@ +/* + * C++ Program to Implement Euler Theorem + */ +#include +#include +using namespace std; + +vector inverseArray(int n, int m) +{ + vector modInverse(n + 1, 0); + modInverse[1] = 1; + for (int i = 2; i <= n; i++) + { + modInverse[i] = (-(m / i) * modInverse[m % i]) % m + m; + } + return modInverse; +} +//Main +int main() +{ + vector::iterator it; + int a, m; + cout<<"Enter number to find modular multiplicative inverse: "; + cin>>a; + cout<<"Enter Modular Value: "; + cin>>m; + cout< +#include + +using namespace std; +/* return the gcd of a and b followed by the pair x and y of + equation ax + by = gcd(a,b) +*/ +pair > extendedEuclid(int a, int b) +{ + int x = 1, y = 0; + int xLast = 0, yLast = 1; + int q, r, m, n; + while (a != 0) + { + q = b / a; + r = b % a; + m = xLast - q * x; + n = yLast - q * y; + xLast = x; + yLast = y; + x = m; + y = n; + b = a; + a = r; + } + return make_pair(b, make_pair(xLast, yLast)); +} + +int modInverse(int a, int m) +{ + return (extendedEuclid(a, m).second.first + m) % m; +} + +//Main +int main() +{ + int a, m; + cout<<"Enter number to find modular multiplicative inverse: "; + cin>>a; + cout<<"Enter Modular Value: "; + cin>>m; + cout< +#include +#include +#define ll long long +using namespace std; +/* + * modular exponentiation + */ +ll modulo(ll base, ll exponent, ll mod) +{ + ll x = 1; + ll y = base; + while (exponent > 0) + { + if (exponent % 2 == 1) + x = (x * y) % mod; + y = (y * y) % mod; + exponent = exponent / 2; + } + return x % mod; +} + +/* + * Fermat's test for checking primality + */ +bool Fermat(ll p, int iterations) +{ + if (p == 1) + { + return false; + } + for (int i = 0; i < iterations; i++) + { + ll a = rand() % (p - 1) + 1; + if (modulo(a, p - 1, p) != 1) + { + return false; + } + } + return true; +} +/* + * Main + */ +int main() +{ + int iteration = 50; + ll num; + cout<<"Enter integer to test primality: "; + cin>>num; + if (Fermat(num, iteration)) + cout< +using namespace std; + +/* calculates (a^b)%MOD */ +int pow(int a, int b, int MOD) +{ + int x = 1, y = a; + while (b > 0) + { + if (b % 2 == 1) + { + x = (x * y); + if (x > MOD) + x %= MOD; + } + y = (y * y); + if (y > MOD) + y %= MOD; + b /= 2; + } + return x; +} + +int modInverse(int a, int m) +{ + return pow(a, m - 2, m); +} +//Main +int main() +{ + int a, m; + cout<<"Enter number to find modular multiplicative inverse: "; + cin>>a; + cout<<"Enter Modular Value: "; + cin>>m; + cout< +#include + +using namespace std; + +void fisherYatesShuffling(int *arr, int n) +{ + int a[n]; + int ind[n]; + for (int i = 0; i < n; i++) + ind[i] = 0; + int index; + for (int i = 0; i < n; i++) + { + do + { + index = rand() % n; + } + while (ind[index] != 0); + ind[index] = 1; + a[i] = *(arr + index); + } + for (int i = 0; i < n; i++) + { + cout << a[i] << " "; + } +} + +int main(int argc, char **argv) +{ + cout << "Enter the array size: "; + int n; + cin >> n; + cout << "Enter the array elements: "; + int a[n]; + for (int i = 0; i < n; i++) + { + cin >> a[i]; + } + fisherYatesShuffling(a, n); +} + +/* +Enter the array size: 7 +Enter the array elements: 12 23 34 45 56 67 78 +78 23 67 45 34 12 56 \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Implement Gauss Seidel Method.cpp b/c++/11_Numerical_Problems/C++ Program to Implement Gauss Seidel Method.cpp new file mode 100644 index 0000000..8ca7766 --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Implement Gauss Seidel Method.cpp @@ -0,0 +1,80 @@ +#include +#include + +using namespace std; + +int main(void) +{ + float a[10][10], b[10], x[10], y[10]; + int n = 0, m = 0, i = 0, j = 0; + cout << "Enter size of 2d array(Square matrix) : "; + cin >> n; + for (i = 0; i < n; i++) + { + for (j = 0; j < n; j++) + { + cout << "Enter values no :(" << i << ", " << j << ") "; + cin >> a[i][j]; + } + } + cout << "\nEnter Values to the right side of equation\n"; + for (i = 0; i < n; i++) + { + cout << "Enter values no :(" << i << ", " << j << ") "; + cin >> b[i]; + } + cout << "Enter initial values of x\n"; + for (i = 0; i < n; i++) + { + cout << "Enter values no. :(" << i<<"):"; + cin >> x[i]; + } + cout << "\nEnter the no. of iteration : "; + cin >> m; + while (m > 0) + { + for (i = 0; i < n; i++) + { + y[i] = (b[i] / a[i][i]); + for (j = 0; j < n; j++) + { + if (j == i) + continue; + y[i] = y[i] - ((a[i][j] / a[i][i]) * x[j]); + x[i] = y[i]; + } + printf("x%d = %f ", i + 1, y[i]); + } + cout << "\n"; + m--; + } + return 0; +} + +/* +Enter size of 2d array(Square matrix) : 3 +Enter values no :(0, 0) 2 +Enter values no :(0, 1) 3 +Enter values no :(0, 2) 1 +Enter values no :(1, 0) 5 +Enter values no :(1, 1) 4 +Enter values no :(1, 2) 6 +Enter values no :(2, 0) 8 +Enter values no :(2, 1) 7 +Enter values no :(2, 2) 9 + +Enter Values to the right side of equation +Enter values no :(0, 3) 2 +Enter values no :(1, 3) 3 +Enter values no :(2, 3) 4 + +Enter initial values of x +Enter values no. :(0): 0 +Enter values no. :(1): 0 +Enter values no. :(2): 0 + +Enter the no. of iteration : 4 +x1 = 1.000000 x2 = -0.500000 x3 = -0.055556 +x1 = 1.777778 x2 = -1.388889 x3 = -0.055556 +x1 = 3.111111 x2 = -3.055555 x3 = 0.055555 +x1 = 5.555555 x2 = -6.277777 x3 = 0.388889 \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Implement Miller Rabin Primality Test.cpp b/c++/11_Numerical_Problems/C++ Program to Implement Miller Rabin Primality Test.cpp new file mode 100644 index 0000000..c361a53 --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Implement Miller Rabin Primality Test.cpp @@ -0,0 +1,98 @@ +/* + * C++ Program to Implement Miller Rabin Primality Test + */ +#include +#include +#include +#define ll long long +using namespace std; + +/* + * calculates (a * b) % c taking into account that a * b might overflow + */ +ll mulmod(ll a, ll b, ll mod) +{ + ll x = 0,y = a % mod; + while (b > 0) + { + if (b % 2 == 1) + { + x = (x + y) % mod; + } + y = (y * 2) % mod; + b /= 2; + } + return x % mod; +} +/* + * modular exponentiation + */ +ll modulo(ll base, ll exponent, ll mod) +{ + ll x = 1; + ll y = base; + while (exponent > 0) + { + if (exponent % 2 == 1) + x = (x * y) % mod; + y = (y * y) % mod; + exponent = exponent / 2; + } + return x % mod; +} + +/* + * Miller-Rabin primality test, iteration signifies the accuracy + */ +bool Miller(ll p,int iteration) +{ + if (p < 2) + { + return false; + } + if (p != 2 && p % 2==0) + { + return false; + } + ll s = p - 1; + while (s % 2 == 0) + { + s /= 2; + } + for (int i = 0; i < iteration; i++) + { + ll a = rand() % (p - 1) + 1, temp = s; + ll mod = modulo(a, temp, p); + while (temp != p - 1 && mod != 1 && mod != p - 1) + { + mod = mulmod(mod, mod, p); + temp *= 2; + } + if (mod != p - 1 && temp % 2 == 0) + { + return false; + } + } + return true; +} +//Main +int main() +{ + int iteration = 5; + ll num; + cout<<"Enter integer to test primality: "; + cin>>num; + if (Miller(num, iteration)) + cout< +#define ll long long +using namespace std; + +/* + * Function to calculate modulus of x raised to the power y + */ +ll modular_pow(ll base, ll exponent, int modulus) +{ + ll result = 1; + while (exponent > 0) + { + if (exponent % 2 == 1) + result = (result * base) % modulus; + exponent = exponent >> 1; + base = (base * base) % modulus; + } + return result; +} +/* + * Main + */ +int main() +{ + ll x, y; + int mod; + cout<<"Enter Base Value: "; + cin>>x; + cout<<"Enter Exponent: "; + cin>>y; + cout<<"Enter Modular Value: "; + cin>>mod; + cout< +#include +#include + +using namespace std; + +int main(int argc, char **argv) +{ + int p = 7, l = 3, g = 2, n = 4, x; + int a[] = { 1, 2, 2, 1 }; + int bin[4]; + cout << "The Random numbers are: "; + for (int i = 0; i < 10; i++) + { + x = rand() % 16; + for (int j = 3; j >= 0; j--) + { + bin[j] = x % 2; + x /= 2; + } + int mul = 1; + for (int k = 0; k < 4; k++) + mul *= pow(a[k], bin[k]); + cout << pow(g, mul)<<" "; + } +} + +/* +The Random numbers are: +2 4 16 4 2 4 16 16 4 2 \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Implement Park-Miller Random Number Generation Algorithm.cpp b/c++/11_Numerical_Problems/C++ Program to Implement Park-Miller Random Number Generation Algorithm.cpp new file mode 100644 index 0000000..ba16b82 --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Implement Park-Miller Random Number Generation Algorithm.cpp @@ -0,0 +1,51 @@ +/*This is a C++ Program to generate random numbers using Park-Miller algorithm. A general formula of a random number generator (RNG) of this type is: +X_{k+1} = g X(k) mod n +where the modulus n is a prime number or a power of a prime number, the multiplier g is an element of high multiplicative order modulo n (e.g., a primitive root modulo n), and the seed X0 is co-prime to n.*/ + +#include +#include +#include + +using namespace std; + +const long m = 2147483647L; +const long a = 48271L; +const long q = 44488L; +const long r = 3399L; + +static long r_seed = 12345678L; + +double uniform() +{ + long hi = r_seed / q; + long lo = r_seed - q * hi; + long t = a * lo - r * hi; + if (t > 0) + r_seed = t; + else + r_seed = t + m; + return r_seed; +} + +int main(int argc, char **argv) +{ + double A[10]; + for (int i = 0; i < 10; i++) + A[i] = uniform(); + cout<<"Random numbers are:\n"; + for (int i = 0; i < 10; i++) + cout << A[i]< +using namespace std; +/* + * multiply two numbers using Russian Peasant method + */ +unsigned int russianPeasant(unsigned int a, unsigned int b) +{ + int res = 0; + while (b > 0) + { + if (b & 1) + res = res + a; + a = a << 1; + b = b >> 1; + } + return res; +} + +/* + * Main + */ +int main() +{ + cout << russianPeasant(15, 5) << endl; + cout << russianPeasant(13, 6) << endl; + return 0; +} + +/* +75 +78 + +------------------ +(program exited with code: 1) +Press return to continue \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Implement Segmented Sieve.cpp b/c++/11_Numerical_Problems/C++ Program to Implement Segmented Sieve.cpp new file mode 100644 index 0000000..8b7d84c --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Implement Segmented Sieve.cpp @@ -0,0 +1,91 @@ +/* + * C++ Program to Implement Segmented Sieve + */ +#include +#include +#define MAX 46656 +#define LMT 216 +#define LEN 4830 +#define RNG 100032 +#define sq(x) ((x)*(x)) +#define mset(x,v) memset(x, v , sizeof(x)) +#define chkC(x,n) (x[n >> 6] & (1 << ((n >> 1) & 31))) +#define setC(x,n) (x[n >> 6] |= (1 << ((n >> 1) & 31))) +using namespace std; +unsigned base[MAX/64], segment[RNG/64], primes[LEN]; + +/* + * Generates all the necessary prime numbers and marks them in base[] + */ +void sieve() +{ + unsigned i, j, k; + for (i = 3; i < LMT; i += 2) + { + if (!chkC(base, i)) + { + for (j = i * i, k = i << 1; j < MAX; j += k) + setC(base, j); + } + } + for (i = 3, j = 0; i < MAX; i += 2) + { + if (!chkC(base, i)) + primes[j++] = i; + } +} + +/* + * Returns the prime-count within range [a,b] and marks them in segment[] + */ +int segmented_sieve(int a, int b) +{ + unsigned i, j, k, cnt = (a <= 2 && 2 <=b )? 1 : 0; + if (b < 2) + return 0; + if (a < 3) + a = 3; + if (a % 2 == 0) + a++; + mset (segment, 0); + for (i = 0; sq(primes[i]) <= b; i++) + { + j = primes[i] * ((a + primes[i] - 1) / primes[i]); + if (j % 2 == 0) j += primes[i]; + for (k = primes[i] << 1; j <= b; j += k) + { + if (j != primes[i]) + setC(segment, (j - a)); + } + } + for (i = 0; i <= b - a; i += 2) + { + if (!chkC(segment, i)) + cnt++; + } + return cnt; +} +/* + * Main + */ +int main() +{ + sieve(); + int a, b; + cout<<"Enter Lower Bound: "; + cin>>a; + cout<<"Enter Upper Bound: "; + cin>>b; + cout<<"Number of primes between "< +#include +#include +#define ll long long + +using namespace std; + +/* + * Sieve of Atkins + */ +void sieve_atkins(ll int n) +{ + vector is_prime(n + 1); + is_prime[2] = true; + is_prime[3] = true; + for (ll int i = 5; i <= n; i++) + { + is_prime[i] = false; + } + ll int lim = ceil(sqrt(n)); + for (ll int x = 1; x <= lim; x++) + { + for (ll int y = 1; y <= lim; y++) + { + ll int num = (4 * x * x + y * y); + if (num <= n && (num % 12 == 1 || num % 12 == 5)) + { + is_prime[num] = true; + } + num = (3 * x * x + y * y); + if (num <= n && (num % 12 == 7)) + { + is_prime[num] = true; + } + if (x > y) + { + num = (3 * x * x - y * y); + if (num <= n && (num % 12 == 11)) + { + is_prime[num] = true; + } + } + } + } + for (ll int i = 5; i <= lim; i++) + { + if (is_prime[i]) + { + for (ll int j = i * i; j <= n; j += i) + { + is_prime[j] = false; + } + } + } + for (ll int i = 2; i <= n; i++) + { + if (is_prime[i]) + { + cout< +const int len = 100; + +int main() +{ + int arr[100] = {0}; + for (int i = 2; i < 100; i++) + { + for (int j = i * i; j < 100; j+=i) + { + arr[j - 1] = 1; + } + } + for (int i = 1; i < 100; i++) + { + if (arr[i - 1] == 0) + std::cout << i << "\t"; + } +} + +/* +1 2 3 5 7 11 13 17 19 23 +29 31 37 41 43 47 53 59 61 67 +71 73 79 83 89 97 \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Implement Solovay-Strassen Primality Test.cpp b/c++/11_Numerical_Problems/C++ Program to Implement Solovay-Strassen Primality Test.cpp new file mode 100644 index 0000000..bbcefb2 --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Implement Solovay-Strassen Primality Test.cpp @@ -0,0 +1,110 @@ +/* + * C++ Program to Implement Solovay-Strassen Primality Test + */ +#include +#include +#include +#define ll long long +using namespace std; +/* + * modular exponentiation + */ +ll modulo(ll base, ll exponent, ll mod) +{ + ll x = 1; + ll y = base; + while (exponent > 0) + { + if (exponent % 2 == 1) + x = (x * y) % mod; + y = (y * y) % mod; + exponent = exponent / 2; + } + return x % mod; +} +/* + * calculates Jacobian(a/n) n>0 and n is odd + */ +int calculateJacobian(ll a,ll n) +{ + if (!a) + return 0; + int ans = 1; + ll temp; + if (a < 0) + { + a = -a; + if (n % 4 == 3) + ans=-ans; + } + if (a == 1) + return ans; + while (a) + { + if (a < 0) + { + a = -a; + if (n % 4 == 3) + ans = -ans; + } + while (a % 2 == 0) + { + a = a / 2; + if (n % 8 == 3 || n % 8 == 5) + ans = -ans; + } + swap(a, n); + if (a % 4 == 3 && n % 4 == 3) + ans = -ans; + a = a % n; + if (a > n / 2) + a = a - n; + } + if (n == 1) + return ans; + return 0; +} + +/* + * Solovay-Strassen Primality Test + * Iterations determine the accuracy of the test + */ +bool Solovoy(ll p, int iteration) +{ + if (p < 2) + return false; + if (p != 2 && p % 2 == 0) + return false; + for (int i = 0; i < iteration; i++) + { + ll a = rand() % (p - 1) + 1; + ll jacobian = (p + calculateJacobian(a, p)) % p; + ll mod = modulo(a, (p - 1) / 2, p); + if (!jacobian || mod != jacobian) + { + return false; + } + } + return true; +} +//Main +int main() +{ + int iteration = 50; + ll num; + cout<<"Enter integr to test primality: "; + cin>>num; + if (Solovoy(num, iteration)) + cout< +#include +#include +#include + +#define M 2 +#define N (1<rb = rm; // top rows + else + b->ra = rm; // bot rows + if (j == 0) + b->cb = cm; // left cols + else + b->ca = cm; // right cols +} + +// Multiply: A[a] * B[b] => C[c], recursively. +void mul(mat A, mat B, mat C, corners a, corners b, corners c) +{ + corners aii[2][2], bii[2][2], cii[2][2], p; + mat P[7], S, T; + int i, j, m, n, k; + // Check: A[m n] * B[n k] = C[m k] + m = a.rb - a.ra; + assert(m==(c.rb-c.ra)); + n = a.cb - a.ca; + assert(n==(b.rb-b.ra)); + k = b.cb - b.ca; + assert(k==(c.cb-c.ca)); + assert(m>0); + if (n == 1) + { + C[c.ra][c.ca] += A[a.ra][a.ca] * B[b.ra][b.ca]; + return; + } + // Create the 12 smaller matrix indexes: + // A00 A01 B00 B01 C00 C01 + // A10 A11 B10 B11 C10 C11 + for (i = 0; i < 2; i++) + { + for (j = 0; j < 2; j++) + { + find_corner(a, i, j, &aii[i][j]); + find_corner(b, i, j, &bii[i][j]); + find_corner(c, i, j, &cii[i][j]); + } + } + p.ra = p.ca = 0; + p.rb = p.cb = m / 2; +#define LEN(A) (sizeof(A)/sizeof(A[0])) + for (i = 0; i < LEN(P); i++) + set(P[i], p, 0); +#define ST0 set(S,p,0); set(T,p,0) + // (A00 + A11) * (B00+B11) = S * T = P0 + ST0; + add(A, A, S, aii[0][0], aii[1][1], p); + add(B, B, T, bii[0][0], bii[1][1], p); + mul(S, T, P[0], p, p, p); + // (A10 + A11) * B00 = S * B00 = P1 + ST0; + add(A, A, S, aii[1][0], aii[1][1], p); + mul(S, B, P[1], p, bii[0][0], p); + // A00 * (B01 - B11) = A00 * T = P2 + ST0; + sub(B, B, T, bii[0][1], bii[1][1], p); + mul(A, T, P[2], aii[0][0], p, p); + // A11 * (B10 - B00) = A11 * T = P3 + ST0; + sub(B, B, T, bii[1][0], bii[0][0], p); + mul(A, T, P[3], aii[1][1], p, p); + // (A00 + A01) * B11 = S * B11 = P4 + ST0; + add(A, A, S, aii[0][0], aii[0][1], p); + mul(S, B, P[4], p, bii[1][1], p); + // (A10 - A00) * (B00 + B01) = S * T = P5 + ST0; + sub(A, A, S, aii[1][0], aii[0][0], p); + add(B, B, T, bii[0][0], bii[0][1], p); + mul(S, T, P[5], p, p, p); + // (A01 - A11) * (B10 + B11) = S * T = P6 + ST0; + sub(A, A, S, aii[0][1], aii[1][1], p); + add(B, B, T, bii[1][0], bii[1][1], p); + mul(S, T, P[6], p, p, p); + // P0 + P3 - P4 + P6 = S - P4 + P6 = T + P6 = C00 + add(P[0], P[3], S, p, p, p); + sub(S, P[4], T, p, p, p); + add(T, P[6], C, p, p, cii[0][0]); + // P2 + P4 = C01 + add(P[2], P[4], C, p, p, cii[0][1]); + // P1 + P3 = C10 + add(P[1], P[3], C, p, p, cii[1][0]); + // P0 + P2 - P1 + P5 = S - P1 + P5 = T + P5 = C11 + add(P[0], P[2], S, p, p, p); + sub(S, P[1], T, p, p, p); + add(T, P[5], C, p, p, cii[1][1]); +} +int main() +{ + mat A, B, C; + corners ai = { 0, N, 0, N }; + corners bi = { 0, N, 0, N }; + corners ci = { 0, N, 0, N }; + srand(time(0)); + // identity(A,bi); identity(B,bi); + // set(A,ai,2); set(B,bi,2); + randk(A, ai, 0, 2); + randk(B, bi, 0, 2); + print(A, ai, "A"); + print(B, bi, "B"); + set(C, ci, 0); + // add(A,B,C, ai, bi, ci); + mul(A, B, C, ai, bi, ci); + print(C, ci, "C"); + return 0; +} + +/* + +A = { + 1.2, 0.83, 0.39, 0.41, + 1.8, 1.9, 0.49, 0.23, +0.38, 0.72, 1.8, 1.9, +0.13, 1.8, 0.48, 0.82, +} +B = { + 1.2, 1.6, 1.4, 1.6, +0.27, 0.63, 0.3, 0.79, +0.58, 1.2, 1.1, 0.07, + 2, 1.9, 0.47, 0.47, +} +C = { + 2.7, 3.7, 2.6, 2.9, + 3.4, 5, 3.7, 4.5, + 5.3, 6.7, 3.6, 2.2, + 2.5, 3.5, 1.6, 2.1, +} \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Implement the Bin Packing Algorithm.cpp b/c++/11_Numerical_Problems/C++ Program to Implement the Bin Packing Algorithm.cpp new file mode 100644 index 0000000..f95ab57 --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Implement the Bin Packing Algorithm.cpp @@ -0,0 +1,52 @@ +/*This is a C++ Program to implement Bin packing algorithm. This is a sample program to illustrate the Bin-Packing algorithm using next fit heuristics. In the bin packing problem, objects of different volumes must be packed into a finite number of bins or containers each of volume V in a way that minimizes the number of bins used. In computational complexity theory, it is a combinatorial NP-hard problem. +There are many variations of this problem, such as 2D packing, linear packing, packing by weight, packing by cost, and so on. They have many applications, such as filling up containers, loading trucks with weight capacity constraints, creating file backups in media and technology mapping in Field-programmable gate array semiconductor chip design. + +The bin packing problem can also be seen as a special case of the cutting stock problem. When the number of bins is restricted to 1 and each item is characterised by both a volume and a value, the problem of maximising the value of items that can fit in the bin is known as the knapsack problem.*/ + +#include + +using namespace std; + +void binPacking(int *a, int size, int n) +{ + int binCount = 1; + int s = size; + for (int i = 0; i < n; i++) + { + if (s - *(a + i) > 0) + { + s -= *(a + i); + continue; + } + else + { + binCount++; + s = size; + i--; + } + } + cout << "Number of bins required: " << binCount; +} + +int main(int argc, char **argv) +{ + cout << "BIN - PACKING Algorithm\n"; + cout << "Enter the number of items in Set: "; + int n; + cin >> n; + cout << "Enter " << n << " items:"; + int a[n]; + for (int i = 0; i < n; i++) + cin >> a[i]; + cout << "Enter the bin size: "; + int size; + cin >> size; + binPacking(a, size, n); +} + +/* +BIN - PACKING Algorithm +Enter the number of items in Set: 5 +Enter 5 items:12 23 34 45 56 +Enter the bin size: 70 +Number of bins required: 3 \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Implement the Schonhage-Strassen Algorithm for Multiplication of Two Numbers.cpp b/c++/11_Numerical_Problems/C++ Program to Implement the Schonhage-Strassen Algorithm for Multiplication of Two Numbers.cpp new file mode 100644 index 0000000..cfe517d --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Implement the Schonhage-Strassen Algorithm for Multiplication of Two Numbers.cpp @@ -0,0 +1,62 @@ +#include + +using namespace std; + +int noOfDigit(long a) +{ + int n = 0; + while (a > 0) + { + a /= 10; + n++; + } + return n; +} +void schonhageStrassenMultiplication(long x, long y, int n, int m) +{ + int linearConvolution[n + m - 1]; + for (int i = 0; i < (n + m - 1); i++) + linearConvolution[i] = 0; + long p = x; + for (int i = 0; i < m; i++) + { + x = p; + for (int j = 0; j < n; j++) + { + linearConvolution[i + j] += (y % 10) * (x % 10); + x /= 10; + } + y /= 10; + } + cout << "The Linear Convolution is: ( "; + for (int i = (n + m - 2); i >= 0; i--) + { + cout << linearConvolution[i] << " "; + } + cout << ")"; + long product = 0; + int nextCarry = 0, base = 1; + ; + for (int i = 0; i < n + m - 1; i++) + { + linearConvolution[i] += nextCarry; + product = product + (base * (linearConvolution[i] % 10)); + nextCarry = linearConvolution[i] / 10; + base *= 10; + } + cout << "\nThe Product of the numbers is: " << product; +} +int main(int argc, char **argv) +{ + cout << "Enter the numbers:"; + long a, b; + cin >> a >> b; + int n = noOfDigit(a); + int m = noOfDigit(b); + schonhageStrassenMultiplication(a, b, n, m); +} + +/* +Enter the numbers:3452 1245 +The Linear Convolution is: ( 3 10 25 43 44 33 10 ) + Product of the numbers is: 4297740 \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Implement the linear congruential generator for Pseudo Random Number Generation.cpp b/c++/11_Numerical_Problems/C++ Program to Implement the linear congruential generator for Pseudo Random Number Generation.cpp new file mode 100644 index 0000000..a422fd1 --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Implement the linear congruential generator for Pseudo Random Number Generation.cpp @@ -0,0 +1,95 @@ +/*This is a C++ Program to generate random numbers using Linear Congruential Generator. A linear congruential generator (LCG) is an algorithm that yields a sequence of pseudo-randomized numbers calculated with a discontinuous piecewise linear equation. The method represents one of the oldest and best-known pseudorandom number generator algorithms. The theory behind them is relatively easy to understand, and they are easily implemented and fast, especially on computer hardware which can provide modulo arithmetic by storage-bit truncation.*/ + +#include + +using namespace std; + +class mRND +{ +public: + void seed(unsigned int s) + { + _seed = s; + } + +protected: + mRND() : + _seed(0), _a(0), _c(0), _m(2147483648) + { + } + int rnd() + { + return (_seed = (_a * _seed + _c) % _m); + } + + int _a, _c; + unsigned int _m, _seed; +}; + +class MS_RND: public mRND +{ +public: + MS_RND() + { + _a = 214013; + _c = 2531011; + } + int rnd() + { + return mRND::rnd() >> 16; + } +}; + +class BSD_RND: public mRND +{ +public: + BSD_RND() + { + _a = 1103515245; + _c = 12345; + } + int rnd() + { + return mRND::rnd(); + } +}; + +int main(int argc, char* argv[]) +{ + BSD_RND bsd_rnd; + MS_RND ms_rnd; + cout << "MS RAND:" << endl << "========" << endl; + for (int x = 0; x < 10; x++) + cout << ms_rnd.rnd() << endl; + cout << endl << "BSD RAND:" << endl << "=========" << endl; + for (int x = 0; x < 10; x++) + cout << bsd_rnd.rnd() << endl; + return 0; +} + +/* +MS RAND: +======== +38 +7719 +21238 +2437 +8855 +11797 +8365 +32285 +10450 +30612 + +BSD RAND: +========= +12345 +1406932606 +654583775 +1449466924 +229283573 +1109335178 +1051550459 +1293799192 +794471793 +551188310 \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Implement wheel Sieve to Generate Prime Numbers Between Given Range.cpp b/c++/11_Numerical_Problems/C++ Program to Implement wheel Sieve to Generate Prime Numbers Between Given Range.cpp new file mode 100644 index 0000000..dd68031 --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Implement wheel Sieve to Generate Prime Numbers Between Given Range.cpp @@ -0,0 +1,84 @@ +/*This is a C++ Program to find prime number between a given range using Wheel Seive method. Wheel factorization is a graphical method for manually performing a preliminary to the Sieve of Eratosthenes that separates prime numbers from composites. Start by writing the natural numbers around circles as shown below. Prime numbers in the innermost circle have their multiples in similar positions as themselves in the other circles, forming spokes of primes and their multiples. Multiples of the prime numbers in the innermost circle form spokes of composite numbers in the outer circles.*/ + +#include +#include +#include + +using namespace std; + +#define MAX_NUM 50 +// array will be initialized to 0 being global +int primes[MAX_NUM]; + +void gen_sieve_primes(void) +{ + for (int p = 2; p < MAX_NUM; p++) // for all elements in array + { + if (primes[p] == 0) // it is not multiple of any other prime + primes[p] = 1; // mark it as prime + // mark all multiples of prime selected above as non primes + int c = 2; + int mul = p * c; + for (; mul < MAX_NUM;) + { + primes[mul] = -1; + c++; + mul = p * c; + } + } +} + +void print_all_primes() +{ + int c = 0; + for (int i = 0; i < MAX_NUM; i++) + { + if (primes[i] == 1) + { + c++; + if (c < 4) + { + switch (c) + { + case 1: + cout << c << "st prime is: " << i << endl; + break; + case 2: + cout << c << "nd prime is: " << i << endl; + break; + case 3: + cout << c << "rd prime is: " << i << endl; + break; + default: + break; + } + } + else + cout << c << "th prime is: " << i << endl; + } + } +} + +int main() +{ + gen_sieve_primes(); + print_all_primes(); + return 0; +} + +/* +1st prime is: 2 +2nd prime is: 3 +3rd prime is: 5 +4th prime is: 7 +5th prime is: 11 +6th prime is: 13 +7th prime is: 17 +8th prime is: 19 +9th prime is: 23 +10th prime is: 29 +11th prime is: 31 +12th prime is: 37 +13th prime is: 41 +14th prime is: 43 +15th prime is: 47 \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Optimize Wire Length in Electrical Circuit.cpp b/c++/11_Numerical_Problems/C++ Program to Optimize Wire Length in Electrical Circuit.cpp new file mode 100644 index 0000000..56b3fc9 --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Optimize Wire Length in Electrical Circuit.cpp @@ -0,0 +1,113 @@ +#include +#include +#include + +using namespace std; + +// Number of components in the graph +#define V 9 + +// A utility function to find the component with minimum distance value, from +// the set of components not yet included in shortest path tree +int minDistance(int dist[], bool sptSet[]) +{ + // Initialize min value + int min = INT_MAX, min_index; + for (int v = 0; v < V; v++) + if (sptSet[v] == false && dist[v] <= min) + min = dist[v], min_index = v; + return min_index; +} + +// A utility function to print the constructed distance array +void printSolution(int dist[], int n) +{ + cout << "Component\tDistance from other component\n"; + for (int i = 0; i < V; i++) + printf("%d\t\t%d\n", i, dist[i]); +} + +// Funtion that implements Dijkstra's single source shortest path algorithm +// for a graph represented using adjacency matrix representation +void optimizeLength(int graph[V][V], int src) +{ + int dist[V]; // The output array. dist[i] will hold the shortest + // distance from src to i + bool sptSet[V]; // sptSet[i] will true if component i is included in shortest + // path tree or shortest distance from src to i is finalized + // Initialize all distances as INFINITE and stpSet[] as false + for (int i = 0; i < V; i++) + dist[i] = INT_MAX, sptSet[i] = false; + // Distance of source component from itself is always 0 + dist[src] = 0; + // Find shortest path for all components + for (int count = 0; count < V - 1; count++) + { + // Pick the minimum distance component from the set of components not + // yet processed. u is always equal to src in first iteration. + int u = minDistance(dist, sptSet); + // Mark the picked component as processed + sptSet[u] = true; + // Update dist value of the adjacent components of the picked component. + for (int v = 0; v < V; v++) + // Update dist[v] only if is not in sptSet, there is an edge from + // u to v, and total weight of path from src to v through u is + // smaller than current value of dist[v] + if (!sptSet[v] && graph[u][v] && dist[u] != INT_MAX && dist[u] + + graph[u][v] < dist[v]) + dist[v] = dist[u] + graph[u][v]; + } + // print the constructed distance array + printSolution(dist, V); +} + +// driver program to test above function +int main() +{ + /* Let us create the example graph discussed above */ + int graph[V][V] = + { + { 0, 4, 0, 0, 0, 0, 0, 8, 0 }, { 4, 0, 8, 0, 0, 0, 0, 11, 0 }, { + 0, 8, 0, 7, 0, 4, 0, 0, 2 + }, + { 0, 0, 7, 0, 9, 14, 0, 0, 0 }, { + 0, 0, 0, 9, 0, 10, 0, 0, + 0 + }, { 0, 0, 4, 0, 10, 0, 2, 0, 0 }, { + 0, 0, 0, 14, + 0, 2, 0, 1, 6 + }, { 8, 11, 0, 0, 0, 0, 1, 0, 7 }, { + 0, 0, 2, 0, 0, 0, 6, 7, 0 + } + }; + cout << "Enter the starting component: "; + int s; + cin >> s; + optimizeLength(graph, s); + return 0; +} + +/* +Enter the starting component: 1 +Component Distance from other component +0 4 +1 0 +2 8 +3 15 +4 22 +5 12 +6 12 +7 11 +8 10 + +Enter the starting component: 6 +Component Distance from other component +0 9 +1 12 +2 6 +3 13 +4 12 +5 2 +6 0 +7 1 +8 6 \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Perform Addition Operation Using Bitwise Operators.cpp b/c++/11_Numerical_Problems/C++ Program to Perform Addition Operation Using Bitwise Operators.cpp new file mode 100644 index 0000000..fbd98e7 --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Perform Addition Operation Using Bitwise Operators.cpp @@ -0,0 +1,27 @@ +#include +#include +#include + +using namespace std; +int add(int x, int y) +{ + int carry; + while (y != 0) + { + carry = x & y; + x = x ^ y; + y = carry << 1; + } + return x; +} +int main(int argc, char **argv) +{ + cout << "Enter the numbers to be added:"; + int x, y; + cin >> x >> y; + cout << "The Summation is: " << add(x, y); +} + +/* +Enter the numbers to be added:23 24 +The Summation is: 47 \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Perform Encoding of a Message Using Matrix Multiplication.cpp b/c++/11_Numerical_Problems/C++ Program to Perform Encoding of a Message Using Matrix Multiplication.cpp new file mode 100644 index 0000000..8ea6a37 --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Perform Encoding of a Message Using Matrix Multiplication.cpp @@ -0,0 +1,77 @@ +#include +#include +using namespace std; +int main() +{ + int a[10][10], b[10][10], c[10][10]; + int x, y, i, j; + cout << "\nEnter the number of rows and columns for Message Matrix:\n\n"; + cin >> x >> y; + // x denotes number rows in matrix A + // y denotes number columns in matrix A + cout << "\n\nEnter elements for Matrix :::\n\n"; + for (i = 0; i < x; i++) + { + for (j = 0; j < y; j++) + { + cin >> a[i][j]; + } + cout << "\n"; + } + cout << "\n\nMatrix :\n\n"; + for (i = 0; i < x; i++) + { + for (j = 0; j < y; j++) + { + cout << "\t" << a[i][j]; + } + cout << "\n\n"; + } + for (i = 0; i < y; i++) + { + for (j = 0; j < x; j++) + { + b[i][j]=x+y; + } + cout << "\n"; + } + for (i = 0; i < x; i++) + { + for (j = 0; j < x; j++) + { + c[i][j] = 0; + for (int k = 0; k < y; k++) + { + c[i][j] = c[i][j] + a[i][k] * b[k][j]; + } + } + } + cout + << "\n-----------------------------------------------------------\n"; + cout << "\n\nEncoded Matrix :\n\n"; + for (i = 0; i < x; i++) + { + for (j = 0; j < x; j++) + { + cout << "\t" << c[i][j]; + } + cout << "\n\n"; + } + getch(); + return 0; +} + +/* +Enter the number of rows and columns for Message Matrix: +2 2 + +Enter elements for Matrix ::: +1 2 +3 4 +Matrix : + 1 2 + 3 4 +----------------------------------------------------------- +Encoded Matrix : + 12 12 + 28 28 \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Perform LU Decomposition of any Matrix.cpp b/c++/11_Numerical_Problems/C++ Program to Perform LU Decomposition of any Matrix.cpp new file mode 100644 index 0000000..1b64da6 --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Perform LU Decomposition of any Matrix.cpp @@ -0,0 +1,103 @@ +/* +This is a C++ Program to perform LU Decomposition of any matrix. In numerical analysis, LU decomposition (where ‘LU’ stands for ‘Lower Upper’, and also called LU factorization) factors a matrix as the product of a lower triangular matrix and an upper triangular matrix. The product sometimes includes a permutation matrix as well. The LU decomposition can be viewed as the matrix form of Gaussian elimination. Computers usually solve square systems of linear equations using the LU decomposition, and it is also a key step when inverting a matrix, or computing the determinant of a matrix +*/ + +#include +#include + +using namespace std; + +int main(int argc, char **argv) +{ + void lu(float[][10], float[][10], float[][10], int n); + void output(float[][10], int); + float a[10][10], l[10][10], u[10][10]; + int n = 0, i = 0, j = 0; + cout << "Enter size of 2d array(Square matrix) : "; + cin >> n; + for (i = 0; i < n; i++) + { + for (j = 0; j < n; j++) + { + cout << "Enter values no:" << i << ", " << j << ": "; + cin >> a[i][j]; + } + } + lu(a, l, u, n); + cout << "\nL Decomposition\n\n"; + output(l, n); + cout << "\nU Decomposition\n\n"; + output(u, n); + return 0; +} +void lu(float a[][10], float l[][10], float u[][10], int n) +{ + int i = 0, j = 0, k = 0; + for (i = 0; i < n; i++) + { + for (j = 0; j < n; j++) + { + if (j < i) + l[j][i] = 0; + else + { + l[j][i] = a[j][i]; + for (k = 0; k < i; k++) + { + l[j][i] = l[j][i] - l[j][k] * u[k][i]; + } + } + } + for (j = 0; j < n; j++) + { + if (j < i) + u[i][j] = 0; + else if (j == i) + u[i][j] = 1; + else + { + u[i][j] = a[i][j] / l[i][i]; + for (k = 0; k < i; k++) + { + u[i][j] = u[i][j] - ((l[i][k] * u[k][j]) / l[i][i]); + } + } + } + } +} +void output(float x[][10], int n) +{ + int i = 0, j = 0; + for (i = 0; i < n; i++) + { + for (j = 0; j < n; j++) + { + printf("%f ", x[i][j]); + } + cout << "\n"; + } +} + +/* +Enter size of 2d array(Square matrix) : 3 +Enter values no:0, 0: 1 +Enter values no:0, 1: 1 +Enter values no:0, 2: -1 +Enter values no:1, 0: 2 +Enter values no:1, 1: -1 +Enter values no:1, 2: 3 +Enter values no:2, 0: 3 +Enter values no:2, 1: 1 +Enter values no:2, 2: -1 + +L Decomposition + +1.000000 0.000000 0.000000 +2.000000 -3.000000 0.000000 +3.000000 -2.000000 -1.333333 + +U Decomposition + +1.000000 1.000000 -1.000000 +0.000000 1.000000 -1.666667 +0.000000 0.000000 1.000000 \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Perform Matrix Multiplication.cpp b/c++/11_Numerical_Problems/C++ Program to Perform Matrix Multiplication.cpp new file mode 100644 index 0000000..91767f7 --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Perform Matrix Multiplication.cpp @@ -0,0 +1,112 @@ +#include +#include +using namespace std; +int main() +{ + int a[10][10], b[10][10], c[10][10]; + int x, y, i, j, m, n; + cout << "\nEnter the number of rows and columns for Matrix A:::\n\n"; + cin >> x >> y; + // x denotes number rows in matrix A + // y denotes number columns in matrix A + cout << "\n\nEnter elements for Matrix A :::\n\n"; + for (i = 0; i < x; i++) + { + for (j = 0; j < y; j++) + { + cin >> a[i][j]; + } + cout << "\n"; + } + cout << "\n\nMatrix A :\n\n"; + for (i = 0; i < x; i++) + { + for (j = 0; j < y; j++) + { + cout << "\t" << a[i][j]; + } + cout << "\n\n"; + } + cout << "\n-----------------------------------------------------------\n"; + cout << "\nEnter the number of rows and columns for Matrix B:::\n\n"; + cin >> m >> n; + // m denotes number rows in matrix B + // n denotes number columns in matrix B + cout << "\n\nEnter elements for Matrix B :::\n\n"; + for (i = 0; i < m; i++) + { + for (j = 0; j < n; j++) + { + cin >> b[i][j]; + } + cout << "\n"; + } + cout << "\n\nMatrix B :\n\n"; + for (i = 0; i < m; i++) + { + for (j = 0; j < n; j++) + { + cout << "\t" << b[i][j]; + } + cout << "\n\n"; + } + if (y == m) + { + for (i = 0; i < x; i++) + { + for (j = 0; j < n; j++) + { + c[i][j] = 0; + for (int k = 0; k < m; k++) + { + c[i][j] = c[i][j] + a[i][k] * b[k][j]; + } + } + } + cout + << "\n-----------------------------------------------------------\n"; + cout << "\n\nMultiplication of Matrix A and Matrix B :\n\n"; + for (i = 0; i < x; i++) + { + for (j = 0; j < n; j++) + { + cout << "\t" << c[i][j]; + } + cout << "\n\n"; + } + } + else + { + cout << "\n\nMultiplication is not possible"; + } + getch(); + return 0; +} + +/* +Enter the number of rows and columns for Matrix A::: +2 2 + +Enter elements for Matrix A ::: +1 2 +3 4 + +Matrix A : + 1 2 + 3 4 +----------------------------------------------------------- +Enter the number of rows and columns for Matrix B::: +2 2 + +Enter elements for Matrix B ::: +4 5 +6 7 + +Matrix B : + 4 5 + 6 7 +----------------------------------------------------------- + +Multiplication of Matrix A and Matrix B : + 16 19 + 36 43 \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Perform Optimal Paranthesization Using Dynamic Programming.cpp b/c++/11_Numerical_Problems/C++ Program to Perform Optimal Paranthesization Using Dynamic Programming.cpp new file mode 100644 index 0000000..52ff259 --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Perform Optimal Paranthesization Using Dynamic Programming.cpp @@ -0,0 +1,65 @@ +#include +#include +#include + +using namespace std; + +// Matrix Ai has dimension p[i-1] x p[i] for i = 1..n + +int MatrixChainOrder(int p[], int n) +{ + /* For simplicity of the program, one extra row and one extra column are + allocated in m[][]. 0th row and 0th column of m[][] are not used */ + int m[n][n]; + int s[n][n]; + int i, j, k, L, q; + /* m[i,j] = Minimum number of scalar multiplications needed to compute + the matrix A[i]A[i+1]...A[j] = A[i..j] where dimention of A[i] is + p[i-1] x p[i] */ + // cost is zero when multiplying one matrix. + for (i = 1; i < n; i++) + m[i][i] = 0; + // L is chain length. + for (L = 2; L < n; L++) + { + for (i = 1; i <= n - L + 1; i++) + { + j = i + L - 1; + m[i][j] = INT_MAX; + for (k = i; k <= j - 1; k++) + { + // q = cost/scalar multiplications + q = m[i][k] + m[k + 1][j] + p[i - 1] * p[k] * p[j]; + if (q < m[i][j]) + { + m[i][j] = q; + s[i][j] = k; + } + } + } + } + return m[1][n - 1]; +} +int main() +{ + cout + << "Enter the array p[], which represents the chain of matrices such that the ith matrix Ai is of dimension p[i-1] x p[i]"; + cout << "Enter the total length:"; + int n; + cin >> n; + int array[n]; + cout << "Enter the dimensions: "; + for (int var = 0; var < n; ++var) + { + cin >> array[var]; + } + cout << "Minimum number of multiplications is: " << MatrixChainOrder(array, + n); + return 0; +} + +/* + +Enter the array p[], which represents the chain of matrices such that the ith matrix Ai is of dimension p[i-1] x p[i]Enter the total length:4 +Enter the dimensions: 2 4 3 5 +Minimum number of multiplications is: 54 \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Perform Partition of an Integer in All Possible Ways.cpp b/c++/11_Numerical_Problems/C++ Program to Perform Partition of an Integer in All Possible Ways.cpp new file mode 100644 index 0000000..bcb04bb --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Perform Partition of an Integer in All Possible Ways.cpp @@ -0,0 +1,80 @@ +#include +using namespace std; + +// A utility function to print an array p[] of size 'n' +void printArray(int p[], int n) +{ + for (int i = 0; i < n; i++) + cout << p[i] << " "; + cout << endl; +} + +void printAllUniqueParts(int n) +{ + int p[n]; // An array to store a partition + int k = 0; // Index of last element in a partition + p[k] = n; // Initialize first partition as number itself + // This loop first prints current partition, then generates next + // partition. The loop stops when the current partition has all 1s + while (true) + { + // print current partition + printArray(p, k + 1); + // Generate next partition + // Find the rightmost non-one value in p[]. Also, update the + // rem_val so that we know how much value can be accommodated + int rem_val = 0; + while (k >= 0 && p[k] == 1) + { + rem_val += p[k]; + k--; + } + // if k < 0, all the values are 1 so there are no more partitions + if (k < 0) + return; + // Decrease the p[k] found above and adjust the rem_val + p[k]--; + rem_val++; + // If rem_val is more, then the sorted order is violeted. Divide + // rem_val in differnt values of size p[k] and copy these values at + // different positions after p[k] + while (rem_val > p[k]) + { + p[k + 1] = p[k]; + rem_val = rem_val - p[k]; + k++; + } + // Copy rem_val to next position and increment position + p[k + 1] = rem_val; + k++; + } +} + +// Driver program to test above functions +int main() +{ + cout << "All Unique Partitions of 2 \n"; + printAllUniqueParts(2); + cout << "\nAll Unique Partitions of 3 \n"; + printAllUniqueParts(3); + cout << "\nAll Unique Partitions of 4 \n"; + printAllUniqueParts(4); + return 0; +} + +/* +All Unique Partitions of 2 +2 +1 1 + +All Unique Partitions of 3 +3 +2 1 +1 1 1 + +All Unique Partitions of 4 +4 +3 1 +2 2 +2 1 1 +1 1 1 1 \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Perform the Unique Factorization of a Given Number.cpp b/c++/11_Numerical_Problems/C++ Program to Perform the Unique Factorization of a Given Number.cpp new file mode 100644 index 0000000..9c998a3 --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Perform the Unique Factorization of a Given Number.cpp @@ -0,0 +1,81 @@ +#include +using namespace std; + +// A utility function to print an array p[] of size 'n' +void printArray(int p[], int n) +{ + for (int i = 0; i < n; i++) + cout << p[i] << " "; + cout << endl; +} + +void printAllUniqueParts(int n) +{ + int p[n]; // An array to store a partition + int k = 0; // Index of last element in a partition + p[k] = n; // Initialize first partition as number itself + // This loop first prints current partition, then generates next + // partition. The loop stops when the current partition has all 1s + while (true) + { + // print current partition + printArray(p, k + 1); + // Generate next partition + // Find the rightmost non-one value in p[]. Also, update the + // rem_val so that we know how much value can be accommodated + int rem_val = 0; + while (k >= 0 && p[k] == 1) + { + rem_val += p[k]; + k--; + } + // if k < 0, all the values are 1 so there are no more partitions + if (k < 0) + return; + // Decrease the p[k] found above and adjust the rem_val + p[k]--; + rem_val++; + // If rem_val is more, then the sorted order is violeted. Divide + // rem_val in differnt values of size p[k] and copy these values at + // different positions after p[k] + while (rem_val > p[k]) + { + p[k + 1] = p[k]; + rem_val = rem_val - p[k]; + k++; + } + // Copy rem_val to next position and increment position + p[k + 1] = rem_val; + k++; + } +} + +// Driver program to test above functions +int main() +{ + cout << "All Unique Partitions of 2 \n"; + printAllUniqueParts(2); + cout << "\nAll Unique Partitions of 3 \n"; + printAllUniqueParts(3); + cout << "\nAll Unique Partitions of 4 \n"; + printAllUniqueParts(4); + return 0; +} + +/* + +All Unique Partitions of 2 +2 +1 1 + +All Unique Partitions of 3 +3 +2 1 +1 1 1 + +All Unique Partitions of 4 +4 +3 1 +2 2 +2 1 1 +1 1 1 1 \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Represent Linear Equations in Matrix Form.cpp b/c++/11_Numerical_Problems/C++ Program to Represent Linear Equations in Matrix Form.cpp new file mode 100644 index 0000000..3000509 --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Represent Linear Equations in Matrix Form.cpp @@ -0,0 +1,49 @@ +#include +#include + +using namespace std; + +int main(void) +{ + char var[] = { 'x', 'y', 'z', 'w' }; + cout << "Enter the number of variables in the equations: "; + int n; + cin >> n; + cout << "\nEnter the coefficients of each variable for each equations"; + cout << "\nax + by + cz + ... = d"; + int mat[n][n]; + int constants[n][1]; + for (int i = 0; i < n; i++) + { + for (int j = 0; j < n; j++) + { + cin >> mat[i][j]; + } + cin >> constants[i][0]; + } + cout << "Matrix representation is: "; + for (int i = 0; i < n; i++) + { + for (int j = 0; j < n; j++) + { + cout << " " << mat[i][j]; + } + cout << " " << var[i]; + cout << " = " << constants[i][0]; + cout << "\n"; + } + return 0; +} + +/* +Enter the number of variables in the equations: 3 + +Enter the coefficients of each variable for each equations +ax + by + cz + ... = d +1 2 3 4 +1 2 6 8 +2 3 9 8 +Matrix representation is: + 1 2 3 x = 4 + 1 2 6 y = 8 + 2 3 9 z = 8 \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Solve Knapsack Problem Using Dynamic Programming.cpp b/c++/11_Numerical_Problems/C++ Program to Solve Knapsack Problem Using Dynamic Programming.cpp new file mode 100644 index 0000000..a6171e2 --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Solve Knapsack Problem Using Dynamic Programming.cpp @@ -0,0 +1,65 @@ +/*This is a C++ Program to knapsack problem using dynamic programming. The knapsack problem or rucksack problem is a problem in combinatorial optimization: Given a set of items, each with a mass and a value, determine the number of each item to include in a collection so that the total weight is less than or equal to a given limit and the total value is as large as possible. It derives its name from the problem faced by someone who is constrained by a fixed-size knapsack and must fill it with the most valuable items.*/ + +// A Dynamic Programming based solution for 0-1 Knapsack problem +#include + +using namespace std; + +// A utility function that returns maximum of two integers +int max(int a, int b) +{ + return (a > b) ? a : b; +} + +// Returns the maximum value that can be put in a knapsack of capacity W +int knapSack(int W, int wt[], int val[], int n) +{ + int i, w; + int K[n + 1][W + 1]; + // Build table K[][] in bottom up manner + for (i = 0; i <= n; i++) + { + for (w = 0; w <= W; w++) + { + if (i == 0 || w == 0) + K[i][w] = 0; + else if (wt[i - 1] <= w) + K[i][w] + = max(val[i - 1] + K[i - 1][w - wt[i - 1]], K[i - 1][w]); + else + K[i][w] = K[i - 1][w]; + } + } + return K[n][W]; +} + +int main() +{ + cout << "Enter the number of items in a Knapsack:"; + int n, W; + cin >> n; + int val[n], wt[n]; + for (int i = 0; i < n; i++) + { + cout << "Enter value and weight for item " << i << ":"; + cin >> val[i]; + cin >> wt[i]; + } + // int val[] = { 60, 100, 120 }; + // int wt[] = { 10, 20, 30 }; + // int W = 50; + cout << "Enter the capacity of knapsack"; + cin >> W; + cout << knapSack(W, wt, val, n); + return 0; +} + +/* +Enter the number of items in a Knapsack:5 +Enter value and weight for item 0:11 111 +Enter value and weight for item 1:22 121 +Enter value and weight for item 2:33 131 +Enter value and weight for item 3:44 141 +Enter value and weight for item 4:55 151 +Enter the capacity of knapsack 300 +99 \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Solve any Linear Equation in One Variable.cpp b/c++/11_Numerical_Problems/C++ Program to Solve any Linear Equation in One Variable.cpp new file mode 100644 index 0000000..edc65a7 --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Solve any Linear Equation in One Variable.cpp @@ -0,0 +1,647 @@ +#if !defined(MATRIX_H) +#define MATRIX_H +#include +#include +#include +#include +#include + +class CMatrix +{ +private: + int m_rows; + int m_cols; + char m_name[128]; + CMatrix(); +public: + double **m_pData; + CMatrix(const char *name, int rows, int cols) : + m_rows(rows), m_cols(cols) + { + strcpy(m_name, name); + m_pData = new double*[m_rows]; + for (int i = 0; i < m_rows; i++) + m_pData[i] = new double[m_cols]; + for (int i = 0; i < m_rows; i++) + { + for (int j = 0; j < m_cols; j++) + { + m_pData[i][j] = 0.0; + } + } + } + CMatrix(const CMatrix &other) + { + strcpy(m_name, other.m_name); + m_rows = other.m_rows; + m_cols = other.m_cols; + m_pData = new double*[m_rows]; + for (int i = 0; i < m_rows; i++) + m_pData[i] = new double[m_cols]; + for (int i = 0; i < m_rows; i++) + { + for (int j = 0; j < m_cols; j++) + { + m_pData[i][j] = other.m_pData[i][j]; + } + } + } + ~CMatrix() + { + for (int i = 0; i < m_rows; i++) + delete[] m_pData[i]; + delete[] m_pData; + m_rows = m_cols = 0; + } + void SetName(const char *name) + { + strcpy(m_name, name); + } + const char* GetName() const + { + return m_name; + } + void GetInput() + { + std::cin >> *this; + } + void FillSimulatedInput() + { + static int factor1 = 1, factor2 = 2; + std::cout << "\n\nEnter Input For Matrix : " << m_name << " Rows: " + << m_rows << " Cols: " << m_cols << "\n"; + for (int i = 0; i < m_rows; i++) + { + for (int j = 0; j < m_cols; j++) + { + std::cout << "Input For Row: " << i + 1 << " Col: " << j + + 1 << " = "; + int data = ((i + 1) * factor1) + (j + 1) * factor2; + m_pData[i][j] = data / 10.2; + std::cout << m_pData[i][j] << "\n"; + factor1 += (rand() % 4); + factor2 += (rand() % 3); + } + std::cout << "\n"; + } + std::cout << "\n"; + } + double Determinant() + { + double det = 0; + double **pd = m_pData; + switch (m_rows) + { + case 2: + { + det = pd[0][0] * pd[1][1] - pd[0][1] * pd[1][0]; + return det; + } + break; + case 3: + { + /*** + a b c + d e f + g h i + + a b c a b c + d e f d e f + g h i g h i + + + // det (A) = aei + bfg + cdh - afh - bdi - ceg. + ***/ + double a = pd[0][0]; + double b = pd[0][1]; + double c = pd[0][2]; + double d = pd[1][0]; + double e = pd[1][1]; + double f = pd[1][2]; + double g = pd[2][0]; + double h = pd[2][1]; + double i = pd[2][2]; + double det = (a * e * i + b * f * g + c * d * h); // - a*f*h - b*d*i - c*e*g); + det = det - a * f * h; + det = det - b * d * i; + det = det - c * e * g; + //std::cout << *this; + //std::cout << "deter: " << det << " \n"; + return det; + } + break; + case 4: + { + CMatrix *temp[4]; + for (int i = 0; i < 4; i++) + temp[i] = new CMatrix("", 3, 3); + for (int k = 0; k < 4; k++) + { + for (int i = 1; i < 4; i++) + { + int j1 = 0; + for (int j = 0; j < 4; j++) + { + if (k == j) + continue; + temp[k]->m_pData[i - 1][j1++] + = this->m_pData[i][j]; + } + } + } + double det = this->m_pData[0][0] * temp[0]->Determinant() + - this->m_pData[0][1] * temp[1]->Determinant() + + this->m_pData[0][2] * temp[2]->Determinant() + - this->m_pData[0][3] * temp[3]->Determinant(); + return det; + } + break; + case 5: + { + CMatrix *temp[5]; + for (int i = 0; i < 5; i++) + temp[i] = new CMatrix("", 4, 4); + for (int k = 0; k < 5; k++) + { + for (int i = 1; i < 5; i++) + { + int j1 = 0; + for (int j = 0; j < 5; j++) + { + if (k == j) + continue; + temp[k]->m_pData[i - 1][j1++] + = this->m_pData[i][j]; + } + } + } + double det = this->m_pData[0][0] * temp[0]->Determinant() + - this->m_pData[0][1] * temp[1]->Determinant() + + this->m_pData[0][2] * temp[2]->Determinant() + - this->m_pData[0][3] * temp[3]->Determinant() + + this->m_pData[0][4] * temp[4]->Determinant(); + return det; + } + case 6: + case 7: + case 8: + case 9: + case 10: + case 11: + case 12: + default: + { + int DIM = m_rows; + CMatrix **temp = new CMatrix*[DIM]; + for (int i = 0; i < DIM; i++) + temp[i] = new CMatrix("", DIM - 1, DIM - 1); + for (int k = 0; k < DIM; k++) + { + for (int i = 1; i < DIM; i++) + { + int j1 = 0; + for (int j = 0; j < DIM; j++) + { + if (k == j) + continue; + temp[k]->m_pData[i - 1][j1++] + = this->m_pData[i][j]; + } + } + } + double det = 0; + for (int k = 0; k < DIM; k++) + { + if ((k % 2) == 0) + det = det + (this->m_pData[0][k] + * temp[k]->Determinant()); + else + det = det - (this->m_pData[0][k] + * temp[k]->Determinant()); + } + for (int i = 0; i < DIM; i++) + delete temp[i]; + delete[] temp; + return det; + } + break; + } + } + CMatrix& operator =(const CMatrix &other) + { + if (this->m_rows != other.m_rows || this->m_cols != other.m_cols) + { + std::cout + << "WARNING: Assignment is taking place with by changing the number of rows and columns of the matrix"; + } + for (int i = 0; i < m_rows; i++) + delete[] m_pData[i]; + delete[] m_pData; + m_rows = m_cols = 0; + strcpy(m_name, other.m_name); + m_rows = other.m_rows; + m_cols = other.m_cols; + m_pData = new double*[m_rows]; + for (int i = 0; i < m_rows; i++) + m_pData[i] = new double[m_cols]; + for (int i = 0; i < m_rows; i++) + { + for (int j = 0; j < m_cols; j++) + { + m_pData[i][j] = other.m_pData[i][j]; + } + } + return *this; + } + CMatrix CoFactor() + { + CMatrix cofactor("COF", m_rows, m_cols); + if (m_rows != m_cols) + return cofactor; + if (m_rows < 2) + return cofactor; + else if (m_rows == 2) + { + cofactor.m_pData[0][0] = m_pData[1][1]; + cofactor.m_pData[0][1] = -m_pData[1][0]; + cofactor.m_pData[1][0] = -m_pData[0][1]; + cofactor.m_pData[1][1] = m_pData[0][0]; + return cofactor; + } + else if (m_rows >= 3) + { + int DIM = m_rows; + CMatrix ***temp = new CMatrix**[DIM]; + for (int i = 0; i < DIM; i++) + temp[i] = new CMatrix*[DIM]; + for (int i = 0; i < DIM; i++) + for (int j = 0; j < DIM; j++) + temp[i][j] = new CMatrix("", DIM - 1, DIM - 1); + for (int k1 = 0; k1 < DIM; k1++) + { + for (int k2 = 0; k2 < DIM; k2++) + { + int i1 = 0; + for (int i = 0; i < DIM; i++) + { + int j1 = 0; + for (int j = 0; j < DIM; j++) + { + if (k1 == i || k2 == j) + continue; + temp[k1][k2]->m_pData[i1][j1++] + = this->m_pData[i][j]; + } + if (k1 != i) + i1++; + } + } + } + bool flagPositive = true; + for (int k1 = 0; k1 < DIM; k1++) + { + flagPositive = ((k1 % 2) == 0); + for (int k2 = 0; k2 < DIM; k2++) + { + if (flagPositive == true) + { + cofactor.m_pData[k1][k2] + = temp[k1][k2]->Determinant(); + flagPositive = false; + } + else + { + cofactor.m_pData[k1][k2] + = -temp[k1][k2]->Determinant(); + flagPositive = true; + } + } + } + for (int i = 0; i < DIM; i++) + for (int j = 0; j < DIM; j++) + delete temp[i][j]; + for (int i = 0; i < DIM; i++) + delete[] temp[i]; + delete[] temp; + } + return cofactor; + } + CMatrix Adjoint() + { + CMatrix cofactor("COF", m_rows, m_cols); + CMatrix adj("ADJ", m_rows, m_cols); + if (m_rows != m_cols) + return adj; + cofactor = this->CoFactor(); + // adjoint is transpose of a cofactor of a matrix + for (int i = 0; i < m_rows; i++) + { + for (int j = 0; j < m_cols; j++) + { + adj.m_pData[j][i] = cofactor.m_pData[i][j]; + } + } + return adj; + } + CMatrix Transpose() + { + CMatrix trans("TR", m_cols, m_rows); + for (int i = 0; i < m_rows; i++) + { + for (int j = 0; j < m_cols; j++) + { + trans.m_pData[j][i] = m_pData[i][j]; + } + } + return trans; + } + CMatrix Inverse() + { + CMatrix cofactor("COF", m_rows, m_cols); + CMatrix inv("INV", m_rows, m_cols); + if (m_rows != m_cols) + return inv; + // to find out Determinant + double det = Determinant(); + cofactor = this->CoFactor(); + // inv = transpose of cofactor / Determinant + for (int i = 0; i < m_rows; i++) + { + for (int j = 0; j < m_cols; j++) + { + inv.m_pData[j][i] = cofactor.m_pData[i][j] / det; + } + } + return inv; + } + CMatrix operator +(const CMatrix &other) + { + if (this->m_rows != other.m_rows || this->m_cols != other.m_cols) + { + std::cout + << "Addition could not take place because number of rows and columns are different between the two matrices"; + return *this; + } + CMatrix result("", m_rows, m_cols); + for (int i = 0; i < m_rows; i++) + { + for (int j = 0; j < m_cols; j++) + { + result.m_pData[i][j] = this->m_pData[i][j] + + other.m_pData[i][j]; + } + } + return result; + } + CMatrix operator -(const CMatrix &other) + { + if (this->m_rows != other.m_rows || this->m_cols != other.m_cols) + { + std::cout + << "Subtraction could not take place because number of rows and columns are different between the two matrices"; + return *this; + } + CMatrix result("", m_rows, m_cols); + for (int i = 0; i < m_rows; i++) + { + for (int j = 0; j < m_cols; j++) + { + result.m_pData[i][j] = this->m_pData[i][j] + - other.m_pData[i][j]; + } + } + return result; + } + CMatrix operator *(const CMatrix &other) + { + if (this->m_cols != other.m_rows) + { + std::cout + << "Multiplication could not take place because number of columns of 1st Matrix and number of rows in 2nd Matrix are different"; + return *this; + } + CMatrix result("", this->m_rows, other.m_cols); + for (int i = 0; i < this->m_rows; i++) + { + for (int j = 0; j < other.m_cols; j++) + { + for (int k = 0; k < this->m_cols; k++) + { + result.m_pData[i][j] += this->m_pData[i][k] + * other.m_pData[k][j]; + } + } + } + return result; + } + bool operator ==(const CMatrix &other) + { + if (this->m_rows != other.m_rows || this->m_cols != other.m_cols) + { + std::cout + << "Comparision could not take place because number of rows and columns are different between the two matrices"; + return false; + } + CMatrix result("", m_rows, m_cols); + bool bEqual = true; + for (int i = 0; i < m_rows; i++) + { + for (int j = 0; j < m_cols; j++) + { + if (this->m_pData[i][j] != other.m_pData[i][j]) + bEqual = false; + } + } + return bEqual; + } + friend std::istream& operator >>(std::istream &is, CMatrix &m); + friend std::ostream& operator <<(std::ostream &os, const CMatrix &m); +}; +std::istream& operator >>(std::istream &is, CMatrix &m) +{ + std::cout << "\n\nEnter Input For Matrix : " << m.m_name << " Rows: " + << m.m_rows << " Cols: " << m.m_cols << "\n"; + for (int i = 0; i < m.m_rows; i++) + { + for (int j = 0; j < m.m_cols; j++) + { + std::cout << "Input For Row: " << i + 1 << " Col: " << j + 1 + << " = "; + is >> m.m_pData[i][j]; + } + std::cout << "\n"; + } + std::cout << "\n"; + return is; +} +std::ostream& operator <<(std::ostream &os, const CMatrix &m) +{ + os << "\n\nMatrix : " << m.m_name << " Rows: " << m.m_rows << " Cols: " + << m.m_cols << "\n\n"; + for (int i = 0; i < m.m_rows; i++) + { + os << " | "; + for (int j = 0; j < m.m_cols; j++) + { + char buf[32]; + double data = m.m_pData[i][j]; + if (m.m_pData[i][j] > -0.00001 && m.m_pData[i][j] < 0.00001) + data = 0; + sprintf(buf, "%10.2lf ", data); + os << buf; + } + os << "|\n"; + } + os << "\n\n"; + return os; +} +#endif +int main() +{ + CMatrix a("A", 6, 6); + CMatrix b("B", 6, 1); + a.FillSimulatedInput(); + b.FillSimulatedInput(); + std::cout << a << "\n Determinant : "; + std::cout << a.Determinant() << "\n"; + std::cout << b << "\n Determinant : "; + std::cout << b.Determinant() << "\n"; + CMatrix ainv = a.Inverse(); + CMatrix q = a * ainv; + q.SetName("A * A'"); + std::cout << q << "\n"; + CMatrix x = ainv * b; + x.SetName("X"); + std::cout << x << "\n"; + CMatrix y = a * x; // we will get B + y.SetName("Y"); + std::cout << y << "\n"; + return 0; +} + +/* + +Enter Input For Matrix : A Rows: 6 Cols: 6 +Input For Row: 1 Col: 1 = 0.294118 +Input For Row: 1 Col: 2 = 0.980392 +Input For Row: 1 Col: 3 = 1.86275 +Input For Row: 1 Col: 4 = 2.84314 +Input For Row: 1 Col: 5 = 3.62745 +Input For Row: 1 Col: 6 = 5.58824 + +Input For Row: 2 Col: 1 = 2.94118 +Input For Row: 2 Col: 2 = 4.11765 +Input For Row: 2 Col: 3 = 5.88235 +Input For Row: 2 Col: 4 = 8.43137 +Input For Row: 2 Col: 5 = 10.3922 +Input For Row: 2 Col: 6 = 12.3529 + +Input For Row: 3 Col: 1 = 8.13725 +Input For Row: 3 Col: 2 = 9.70588 +Input For Row: 3 Col: 3 = 12.0588 +Input For Row: 3 Col: 4 = 15.098 +Input For Row: 3 Col: 5 = 17.8431 +Input For Row: 3 Col: 6 = 20.5882 + +Input For Row: 4 Col: 1 = 14.902 +Input For Row: 4 Col: 2 = 18.2353 +Input For Row: 4 Col: 3 = 21.4706 +Input For Row: 4 Col: 4 = 24.7059 +Input For Row: 4 Col: 5 = 27.549 +Input For Row: 4 Col: 6 = 31.1765 + +Input For Row: 5 Col: 1 = 24.902 +Input For Row: 5 Col: 2 = 27.9412 +Input For Row: 5 Col: 3 = 32.451 +Input For Row: 5 Col: 4 = 36.0784 +Input For Row: 5 Col: 5 = 39.7059 +Input For Row: 5 Col: 6 = 43.9216 + +Input For Row: 6 Col: 1 = 36.3725 +Input For Row: 6 Col: 2 = 39.6078 +Input For Row: 6 Col: 3 = 43.8235 +Input For Row: 6 Col: 4 = 47.2549 +Input For Row: 6 Col: 5 = 51.3725 +Input For Row: 6 Col: 6 = 55.2941 + + + + +Enter Input For Matrix : B Rows: 6 Cols: 1 +Input For Row: 1 Col: 1 = 9.41176 + +Input For Row: 2 Col: 1 = 15.7843 + +Input For Row: 3 Col: 1 = 22.7451 + +Input For Row: 4 Col: 1 = 29.902 + +Input For Row: 5 Col: 1 = 37.1569 + +Input For Row: 6 Col: 1 = 44.6078 + + + + +Matrix : A Rows: 6 Cols: 6 + + | 0.29 0.98 1.86 2.84 3.63 5.59 | + | 2.94 4.12 5.88 8.43 10.39 12.35 | + | 8.14 9.71 12.06 15.10 17.84 20.59 | + | 14.90 18.24 21.47 24.71 27.55 31.18 | + | 24.90 27.94 32.45 36.08 39.71 43.92 | + | 36.37 39.61 43.82 47.25 51.37 55.29 | + + + + Determinant : -11.9339 + + +Matrix : B Rows: 6 Cols: 1 + + | 9.41 | + | 15.78 | + | 22.75 | + | 29.90 | + | 37.16 | + | 44.61 | + + + + Determinant : -1.#IND + + +Matrix : A * A' Rows: 6 Cols: 6 + + | 1.00 0.00 0.00 0.00 0.00 0.00 | + | 0.00 1.00 0.00 0.00 0.00 0.00 | + | 0.00 0.00 1.00 0.00 0.00 0.00 | + | 0.00 0.00 0.00 1.00 0.00 0.00 | + | 0.00 0.00 0.00 0.00 1.00 0.00 | + | 0.00 0.00 0.00 0.00 0.00 1.00 | + + + + + +Matrix : X Rows: 6 Cols: 1 + + | 0.82 | + | 3.47 | + | -9.38 | + | 7.71 | + | -5.76 | + | 3.98 | + + + + + +Matrix : Y Rows: 6 Cols: 1 + + | 9.41 | + | 15.78 | + | 22.75 | + | 29.90 | + | 37.16 | + | 44.61 | \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Solve the 0-1 Knapsack Problem.cpp b/c++/11_Numerical_Problems/C++ Program to Solve the 0-1 Knapsack Problem.cpp new file mode 100644 index 0000000..4c43e45 --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Solve the 0-1 Knapsack Problem.cpp @@ -0,0 +1,61 @@ +/*This is a C++ Program to solve 0-1 knapsack problem. The knapsack problem or rucksack problem is a problem in combinatorial optimization: Given a set of items, each with a mass and a value, determine the number of each item to include in a collection so that the total weight is less than or equal to a given limit and the total value is as large as possible. It derives its name from the problem faced by someone who is constrained by a fixed-size knapsack and must fill it with the most valuable items.*/ + +#include +#include +#include + +using namespace std; + +// A utility function that returns maximum of two integers +int max(int a, int b) +{ + return (a > b) ? a : b; +} + +// Returns the maximum value that can be put in a knapsack of capacity W +int knapSack(int W, int wt[], int val[], int n) +{ + // Base Case + if (n == 0 || W == 0) + return 0; + // If weight of the nth item is more than Knapsack capacity W, then + // this item cannot be included in the optimal solution + if (wt[n - 1] > W) + return knapSack(W, wt, val, n - 1); + // Return the maximum of two cases: (1) nth item included (2) not included + else + return max(val[n - 1] + knapSack(W - wt[n - 1], wt, val, n - 1), + knapSack(W, wt, val, n - 1)); +} + +// Driver program to test above function +int main() +{ + cout << "Enter the number of items in a Knapsack:"; + int n, W; + cin >> n; + int val[n], wt[n]; + for (int i = 0; i < n; i++) + { + cout << "Enter value and weight for item " << i << ":"; + cin >> val[i]; + cin >> wt[i]; + } + // int val[] = { 60, 100, 120 }; + // int wt[] = { 10, 20, 30 }; + // int W = 50; + cout << "Enter the capacity of knapsack"; + cin >> W; + cout << knapSack(W, wt, val, n); + return 0; +} + +/* +Enter the number of items in a Knapsack:5 +Enter value and weight for item 0:11 111 +Enter value and weight for item 1:22 121 +Enter value and weight for item 2:33 131 +Enter value and weight for item 3:44 141 +Enter value and weight for item 4:55 151 +Enter the capacity of knapsack 300 +99 \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Solve the Fractional Knapsack Problem.cpp b/c++/11_Numerical_Problems/C++ Program to Solve the Fractional Knapsack Problem.cpp new file mode 100644 index 0000000..1dd73ef --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Solve the Fractional Knapsack Problem.cpp @@ -0,0 +1,78 @@ +/*This is a C++ Program to solve fractional knapsack. The knapsack problem or rucksack problem is a problem in combinatorial optimization: Given a set of items, each with a mass and a value, determine the number of each item to include in a collection so that the total weight is less than or equal to a given limit and the total value is as large as possible. It derives its name from the problem faced by someone who is constrained by a fixed-size knapsack and must fill it with the most valuable items.*/ + +/* program to implement fractional knapsack problem using greedy programming */ +#include +using namespace std; +int main() +{ + int array[2][100], n, w, i, curw, used[100], maxi = -1, totalprofit = 0; + //input number of objects + cout << "Enter number of objects: "; + cin >> n; + //input max weight of knapsack + cout << "Enter the weight of the knapsack: "; + cin >> w; + /* Array's first row is to store weights + second row is to store profits */ + for (i = 0; i < n; i++) + { + cin >> array[0][i] >> array[1][i]; + } + for (i = 0; i < n; i++) + { + used[i] = 0; + } + curw = w; + //loop until knapsack is full + while (curw >= 0) + { + maxi = -1; + //loop to find max profit object + for (i = 0; i < n; i++) + { + if ((used[i] == 0) && ((maxi == -1) || (((float) array[1][i] + / (float) array[0][i]) > ((float) array[1][maxi] + / (float) array[0][maxi])))) + { + maxi = i; + } + } + used[maxi] = 1; + //decrease current wight + curw -= array[0][maxi]; + //increase total profit + totalprofit += array[1][maxi]; + if (curw >= 0) + { + cout << "\nAdded object " << maxi + 1 << " Weight: " + << array[0][maxi] << " Profit: " << array[1][maxi] + << " completely in the bag, Space left: " << curw; + } + else + { + cout << "\nAdded object " << maxi + 1 << " Weight: " + << (array[0][maxi] + curw) << " Profit: " + << (array[1][maxi] / array[0][maxi]) * (array[0][maxi] + + curw) << " partially in the bag, Space left: 0" + << " Weight added is: " << curw + array[0][maxi]; + totalprofit -= array[1][maxi]; + totalprofit += ((array[1][maxi] / array[0][maxi]) * (array[0][maxi] + + curw)); + } + } + //print total worth of objects filled in knapsack + cout << "\nBags filled with objects worth: " << totalprofit; + return 0; +} + +/* +Enter number of objects: 3 +Enter the weight of the knapsack: 50 +10 60 +20 100 +30 120 + +Added object 1 Weight: 10 Profit: 60 completely in the bag, Space left: 40 +Added object 2 Weight: 20 Profit: 100 completely in the bag, Space left: 20 +Added object 3 Weight: 20 Profit: 80 partially in the bag, Space left: 0 Weight added is: 20 +Bags filled with objects worth: 240 \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to Use rand and srand Functions.cpp b/c++/11_Numerical_Problems/C++ Program to Use rand and srand Functions.cpp new file mode 100644 index 0000000..f84ec50 --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to Use rand and srand Functions.cpp @@ -0,0 +1,20 @@ +#include +#include +#include + +using namespace std; + +int main(int argc, char **argv) +{ + cout << "First number: " << rand() % 100; + srand(time(NULL)); + cout << "\nRandom number: " << rand() % 100; + srand(1); + cout << "\nAgain the first number: " << rand() % 100; + return 0; +} + +/* +First number: 41 +Random number: 98 +Again the first number: 41 \ No newline at end of file diff --git a/c++/11_Numerical_Problems/C++ Program to implement Gauss Jordan Elimination algorithm..cpp b/c++/11_Numerical_Problems/C++ Program to implement Gauss Jordan Elimination algorithm..cpp new file mode 100644 index 0000000..0444346 --- /dev/null +++ b/c++/11_Numerical_Problems/C++ Program to implement Gauss Jordan Elimination algorithm..cpp @@ -0,0 +1,82 @@ +/*/This is a C++ Program to implement Gauss Jordan Elimination algorithm. In linear algebra, Gaussian elimination (also known as row reduction) is an algorithm for solving systems of linear equations. It is usually understood as a sequence of operations performed on the associated matrix of coefficients. This method can also be used to find the rank of a matrix, to calculate the determinant of a matrix, and to calculate the inverse of an invertible square matrix.*/ + + +#include +#include + +using namespace std; + +int main() +{ + int i, j, k, n; + float a[10][10] = { 0 }, d; + cout << "No of equations ? "; + cin >> n; + cout << "Read all coefficients of matrix with b matrix too " << endl; + for (i = 1; i <= n; i++) + for (j = 1; j <= n; j++) + cin >> a[i][j]; + for (i = 1; i <= n; i++) + for (j = 1; j <= 2 * n; j++) + if (j == (i + n)) + a[i][j] = 1; + /************** partial pivoting **************/ + for (i = n; i > 1; i--) + { + if (a[i - 1][1] < a[i][1]) + for (j = 1; j <= n * 2; j++) + { + d = a[i][j]; + a[i][j] = a[i - 1][j]; + a[i - 1][j] = d; + } + } + cout << "pivoted output: " << endl; + for (i = 1; i <= n; i++) + { + for (j = 1; j <= n * 2; j++) + cout << a[i][j] << " "; + cout << endl; + } + /********** reducing to diagonal matrix ***********/ + for (i = 1; i <= n; i++) + { + for (j = 1; j <= n * 2; j++) + if (j != i) + { + d = a[j][i] / a[i][i]; + for (k = 1; k <= n * 2; k++) + a[j][k] -= a[i][k] * d; + } + } + /************** reducing to unit matrix *************/ + for (i = 1; i <= n; i++) + { + d = a[i][i]; + for (j = 1; j <= n * 2; j++) + a[i][j] = a[i][j] / d; + } + cout << "your solutions: " << endl; + for (i = 1; i <= n; i++) + { + for (j = n + 1; j <= n * 2; j++) + cout << a[i][j] << " "; + cout << endl; + } + getch(); + return 0; +} + +/*No of equations ? 3 +Read all coefficients of matrix with b matrix too +2 3 4 +5 6 3 +9 8 6 +pivoted output: +9 8 6 0 0 1 +2 3 4 1 0 0 +5 6 3 0 1 0 +your solutions: +-0.292683 -0.341463 0.365854 +0.0731707 0.585366 -0.341463 +0.341463 -0.268293 0.0731708*/ \ No newline at end of file diff --git a/c++/11_Sets_&_Strings/C++ Program to Construct DFA from NFA.cpp b/c++/11_Sets_&_Strings/C++ Program to Construct DFA from NFA.cpp new file mode 100644 index 0000000..7131de3 --- /dev/null +++ b/c++/11_Sets_&_Strings/C++ Program to Construct DFA from NFA.cpp @@ -0,0 +1,189 @@ +/*This is a C++ Program to convert NFA to DFA. A DFA (Deterministic Finite Automaton) is a finite state machine where from each state and a given input symbol, the next possible state is uniquely determined. On the other hand, an NFA (Non-Deterministic Finite Automaton) can move to several possible next states from a given state and a given input symbol. However, this does not add any more power to the machine. It still accepts the same set of languages, namely the regular languages. It is possible to convert an NFA to an equivalent DFA using the powerset construction. +The intuition behind this scheme is that an NFA can be in several possible states at any time. We can simulate it with a DFA whose states correspond to sets of states of the underlying NFA.*/ + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#define MAX_NFA_STATES 10 +#define MAX_ALPHABET_SIZE 10 +using namespace std; +// Representation of an NFA state +class NFAstate +{ +public: + int transitions[MAX_ALPHABET_SIZE][MAX_NFA_STATES]; + NFAstate() + { + for (int i = 0; i < MAX_ALPHABET_SIZE; i++) + for (int j = 0; j < MAX_NFA_STATES; j++) + transitions[i][j] = -1; + } +}*NFAstates; +// Representation of a DFA state +struct DFAstate +{ + bool finalState; + bitset constituentNFAstates; + bitset transitions[MAX_ALPHABET_SIZE]; + int symbolicTransitions[MAX_ALPHABET_SIZE]; +}; +set NFA_finalStates; +vector DFA_finalStates; +vector DFAstates; +queue incompleteDFAstates; +int N, M; // N -> No. of stattes, M -> Size of input alphabet +// finds the epsilon closure of the NFA state "state" and stores it into "closure" +void epsilonClosure(int state, bitset &closure) +{ + for (int i = 0; i < N && NFAstates[state].transitions[0][i] != -1; i++) + if (closure[NFAstates[state].transitions[0][i]] == 0) + { + closure[NFAstates[state].transitions[0][i]] = 1; + epsilonClosure(NFAstates[state].transitions[0][i], closure); + } +} +// finds the epsilon closure of a set of NFA states "state" and stores it into "closure" +void epsilonClosure(bitset state, + bitset &closure) +{ + for (int i = 0; i < N; i++) + if (state[i] == 1) + epsilonClosure(i, closure); +} +// returns a bitset representing the set of states the NFA could be in after moving +// from state X on input symbol A +void NFAmove(int X, int A, bitset &Y) +{ + for (int i = 0; i < N && NFAstates[X].transitions[A][i] != -1; i++) + Y[NFAstates[X].transitions[A][i]] = 1; +} +// returns a bitset representing the set of states the NFA could be in after moving +// from the set of states X on input symbol A +void NFAmove(bitset X, int A, bitset &Y) +{ + for (int i = 0; i < N; i++) + if (X[i] == 1) + NFAmove(i, A, Y); +} +int main() +{ + int i, j, X, Y, A, T, F, D; + // read in the underlying NFA + ifstream fin("NFA.txt"); + fin >> N >> M; + NFAstates = new NFAstate[N]; + fin >> F; + for (i = 0; i < F; i++) + { + fin >> X; + NFA_finalStates.insert(X); + } + fin >> T; + while (T--) + { + fin >> X >> A >> Y; + for (i = 0; i < Y; i++) + { + fin >> j; + NFAstates[X].transitions[A][i] = j; + } + } + fin.close(); + // construct the corresponding DFA + D = 1; + DFAstates.push_back(new DFAstate); + DFAstates[0]->constituentNFAstates[0] = 1; + epsilonClosure(0, DFAstates[0]->constituentNFAstates); + for (j = 0; j < N; j++) + if (DFAstates[0]->constituentNFAstates[j] == 1 && NFA_finalStates.find( + j) != NFA_finalStates.end()) + { + DFAstates[0]->finalState = true; + DFA_finalStates.push_back(0); + break; + } + incompleteDFAstates.push(0); + while (!incompleteDFAstates.empty()) + { + X = incompleteDFAstates.front(); + incompleteDFAstates.pop(); + for (i = 1; i <= M; i++) + { + NFAmove(DFAstates[X]->constituentNFAstates, i, + DFAstates[X]->transitions[i]); + epsilonClosure(DFAstates[X]->transitions[i], + DFAstates[X]->transitions[i]); + for (j = 0; j < D; j++) + if (DFAstates[X]->transitions[i] + == DFAstates[j]->constituentNFAstates) + { + DFAstates[X]->symbolicTransitions[i] = j; + break; + } + if (j == D) + { + DFAstates[X]->symbolicTransitions[i] = D; + DFAstates.push_back(new DFAstate); + DFAstates[D]->constituentNFAstates + = DFAstates[X]->transitions[i]; + for (j = 0; j < N; j++) + if (DFAstates[D]->constituentNFAstates[j] == 1 + && NFA_finalStates.find(j) != NFA_finalStates.end()) + { + DFAstates[D]->finalState = true; + DFA_finalStates.push_back(D); + break; + } + incompleteDFAstates.push(D); + D++; + } + } + } + // write out the corresponding DFA + ofstream fout("DFA.txt"); + fout << D << " " << M << "\n" << DFA_finalStates.size(); + for (vector::iterator it = DFA_finalStates.begin(); it + != DFA_finalStates.end(); it++) + fout << " " << *it; + fout << "\n"; + for (i = 0; i < D; i++) + { + for (j = 1; j <= M; j++) + fout << i << " " << j << " " + << DFAstates[i]->symbolicTransitions[j] << "\n"; + } + fout.close(); + return 0; +} + +/* + +Input file +NFA.txt +4 2 +2 0 1 +4 +0 1 2 1 2 +1 1 2 1 2 +2 2 2 1 3 +3 1 2 1 2 + +Output file +DFA.txt +4 2 +3 0 1 3 +0 1 1 +0 2 2 +1 1 1 +1 2 3 +2 1 2 +2 2 2 +3 1 1 +3 2 2 diff --git a/c++/11_Sets_&_Strings/C++ Program to Decode a Message Encoded Using Playfair Cipher.cpp b/c++/11_Sets_&_Strings/C++ Program to Decode a Message Encoded Using Playfair Cipher.cpp new file mode 100644 index 0000000..910cffc --- /dev/null +++ b/c++/11_Sets_&_Strings/C++ Program to Decode a Message Encoded Using Playfair Cipher.cpp @@ -0,0 +1,121 @@ +/* + * C++ Program to Decode a Message Encoded Using Playfair Cipher + This C++ program decodes any message encoded using the technique of traditional playfair cipher. The Playfair cipher or Playfair square is a manual symmetric encryption technique and was the first literal digraph substitution cipher. Input is not case sensitive and works only for characters from ‘a’ to ‘z’ and ‘A’ to ‘Z’. + */ +#include +#include +using namespace std; + +const char encoder[5][5] = {{'A','B','C','D','E'}, + {'F','G','H','I','K'}, + {'L','M','N','O','P'}, + {'Q','R','S','T','U'}, + {'V','W','X','Y','Z'} +}; + +void input_string(vector& a) +{ + char c; + while (1) + { + c=getchar(); + if (c >= 97 && c <= 122) + c -= 32; + if (c == '\n') + break; + else if (c==' ') + continue; + else if (c == 'J') + a.push_back('I'); + a.push_back(c); + } + return; +} + + + +void get_pos(char p, int& r, int& c) +{ + if (p < 'J') + { + r = (p - 65) / 5; + c = (p - 65) % 5; + } + else if (p > 'J') + { + r = (p - 66) / 5; + c = (p - 66) % 5; + } + return; +} + +void same_row(int r, vector& code, int c1, int c2) +{ + code.push_back(encoder[r][(c1 + 4) % 5]); + code.push_back(encoder[r][(c2 + 4) % 5]); + return; +} + +void same_column(int c, vector& code, int r1, int r2) +{ + code.push_back(encoder[(r1 + 4) % 5][c]); + code.push_back(encoder[(r2 + 4) % 5][c]); + return; +} + +void diff_col_row(int r1, int c1, vector& code, int r2, int c2) +{ + code.push_back(encoder[r1][c2]); + code.push_back(encoder[r2][c1]); + return; +} + + +void encode(vector msgx, int len) +{ + vector code; + int i = 0, j = 0; + int r1, c1, r2, c2; + while (i < len) + { + get_pos(msgx[i], r1, c1); + i++; + get_pos(msgx[i], r2, c2); + if (r1 == r2) + { + same_row(r1, code, c1, c2); + } + else if (c1 == c2) + { + same_column(c1, code, r1, r2); + } + else + { + diff_col_row(r1, c1, code, r2, c2); + } + i++; + } + cout<<"\nCODE: "; + for (j = 0; j < code.size(); j++) + { + if (code[j] == 'X') + continue; + cout< msg; + std::cout<<"Enter the Encrypted Message:"; + input_string(msg); + int len=msg.size(); + encode(msg,len); + return 0; +} + +/* +Enter the Encrypted Message:CBNVMPPO +CODE: BALLOON \ No newline at end of file diff --git a/c++/11_Sets_&_Strings/C++ Program to Encode a Message Using Playfair Cipher.cpp b/c++/11_Sets_&_Strings/C++ Program to Encode a Message Using Playfair Cipher.cpp new file mode 100644 index 0000000..4e9ae5f --- /dev/null +++ b/c++/11_Sets_&_Strings/C++ Program to Encode a Message Using Playfair Cipher.cpp @@ -0,0 +1,158 @@ +/* + * C++ Program to Encode a Message Using Playfair Cipher + */ +#include +#include +using namespace std; + +void get_pos(char, int&, int&); +void same_row(int, vector&, int, int); +void same_column(int, vector&, int, int); +void diff_col_row(int, int, vector&, int, int); +void encode(vector, int); +void get_input(vector&); +void convert_string(vector&, vector&); + +const char encoder[5][5]= {{'A','B','C','D','E'}, + {'F','G','H','I','K'}, + {'L','M','N','O','P'}, + {'Q','R','S','T','U'}, + {'V','W','X','Y','Z'} +}; + +void get_pos(char p, int& r, int& c) +{ + if (p < 'J') + { + r = (p - 65) / 5; + c = (p - 65) % 5; + } + else if (p > 'J') + { + r = (p - 66) / 5; + c = (p - 66) % 5; + } + return; +} + +void same_row(int r, vector& code, int c1, int c2) +{ + code.push_back(encoder[r][(c1 + 1) % 5]); + code.push_back(encoder[r][(c2 + 1) % 5]); + return; +} + +void same_column(int c, vector& code, int r1, int r2) +{ + code.push_back(encoder[(r1 + 1) % 5][c]); + code.push_back(encoder[(r2 + 1) % 5][c]); + return; +} + +void diff_col_row(int r1, int c1, vector& code, int r2, int c2) +{ + code.push_back(encoder[r1][c2]); + code.push_back(encoder[r2][c1]); + return; +} + +void encode(vector msgx, int len) +{ + vector code; + int i = 0, j = 0; + int r1, c1, r2, c2; + while (i < len) + { + get_pos(msgx[i], r1, c1); + i++; + get_pos(msgx[i], r2, c2); + if (r1 == r2) + { + same_row(r1, code, c1, c2); + } + else if (c1 == c2) + { + same_column(c1, code, r1, r2); + } + else + { + diff_col_row(r1, c1, code, r2, c2); + } + i++; + } + cout<<"\nCODE: "; + for (j = 0; j < code.size(); j++) + { + cout<& a) +{ + char c; + while (1) + { + c = getchar(); + if (c >= 97 && c <= 122) + c- =32; + if (c == '\n') + break; + else if (c==' ') + continue; + else if (c == 'J') + a.push_back('I'); + a.push_back(c); + } + return; +} + +void convert_string(vector& msg, vector& msgx) +{ + int i, j; + i = j = 0; + while (i < msg.size()) + { + msgx.push_back(msg[i]); + i++; + if (i == msg.size()) + { + msgx.push_back('X'); + break; + } + if (msg[i] == msgx[j]) + { + msgx.push_back('X'); + j++; + } + else if(msg[i] != msgx[j]) + { + j++; + msgx.push_back(msg[i]); + i+ = 1; + } + j++; + } +} + +int main() +{ + vector msg; + vector msgx; + int i, j; + cout<<"Enter Message to Encrypt:"; + get_input(msg); + convert_string(msg, msgx); + int len = msgx.size(); + /* + cout<<"\n\n"; + for (i = 0;i < len;i++) + cout< +#include +using namespace std; + +// A utility function to find maximum of two integers +int max(int a, int b) +{ + return (a > b)? a : b; +} + +/* Returns length of longest common substring of X[0..m-1] and Y[0..n-1] */ +int LCSubStr(char *X, char *Y, int m, int n) +{ + int LCSuff[m + 1][n + 1]; + int result = 0; + for (int i = 0; i <= m; i++) + { + for (int j=0; j<=n; j++) + { + if (i == 0 || j == 0) + LCSuff[i][j] = 0; + else if (X[i-1] == Y[j-1]) + { + LCSuff[i][j] = LCSuff[i-1][j-1] + 1; + result = max(result, LCSuff[i][j]); + } + else LCSuff[i][j] = 0; + } + } + return result; +} + +/*Main */ +int main() +{ + char X[] = "Sanfoundry"; + char Y[] = "foundation"; + int m = strlen(X); + int n = strlen(Y); + cout << "Length of Longest Common Substring is " << LCSubStr(X, Y, m, n); + return 0; +} + +/* +Length of Longest Common Substring is 5 \ No newline at end of file diff --git a/c++/11_Sets_&_Strings/C++ Program to Find the Longest Increasing Subsequence of a Given Sequence.cpp b/c++/11_Sets_&_Strings/C++ Program to Find the Longest Increasing Subsequence of a Given Sequence.cpp new file mode 100644 index 0000000..7789c86 --- /dev/null +++ b/c++/11_Sets_&_Strings/C++ Program to Find the Longest Increasing Subsequence of a Given Sequence.cpp @@ -0,0 +1,59 @@ +/*This is a C++ Program to implement LCS. The longest common subsequence (LCS) problem is to find the longest subsequence common to all sequences in a set of sequences (often just two). (Note that a subsequence is different from a substring, for the terms of the former need not be consecutive terms of the original sequence.) It is a classic computer science problem, the basis of data comparison programs such as the diff utility, and has applications in bioinformatics.*/ + +#include +#include +#include + +using namespace std; + +#define ARRAY_SIZE(A) sizeof(A)/sizeof(A[0]) +// Binary search (note boundaries in the caller) +// A[] is ceilIndex in the caller +int CeilIndex(int A[], int l, int r, int key) +{ + int m; + while (r - l > 1) + { + m = l + (r - l) / 2; + (A[m] >= key ? r : l) = m; // ternary expression returns an l-value + } + return r; +} + +int LongestIncreasingSubsequenceLength(int A[], int size) +{ + // Add boundary case, when array size is one + int *tailTable = new int[size]; + int len; // always points empty slot + memset(tailTable, 0, sizeof(tailTable[0]) * size); + tailTable[0] = A[0]; + len = 1; + for (int i = 1; i < size; i++) + { + if (A[i] < tailTable[0]) + // new smallest value + tailTable[0] = A[i]; + else if (A[i] > tailTable[len - 1]) + // A[i] wants to extend largest subsequence + tailTable[len++] = A[i]; + else + // A[i] wants to be current end candidate of an existing subsequence + // It will replace ceil value in tailTable + tailTable[CeilIndex(tailTable, -1, len - 1, A[i])] = A[i]; + } + delete[] tailTable; + return len; +} + +int main() +{ + int A[] = { 2, 5, 3, 7, 11, 8, 10, 13, 6 }; + int n = ARRAY_SIZE(A); + printf("Length of Longest Increasing Subsequence is %d\n", + LongestIncreasingSubsequenceLength(A, n)); + return 0; +} + +/* + +Length of Longest Increasing Subsequence is 6 \ No newline at end of file diff --git a/c++/11_Sets_&_Strings/C++ Program to Implement Affine Cipher.cpp b/c++/11_Sets_&_Strings/C++ Program to Implement Affine Cipher.cpp new file mode 100644 index 0000000..4ee3bed --- /dev/null +++ b/c++/11_Sets_&_Strings/C++ Program to Implement Affine Cipher.cpp @@ -0,0 +1,57 @@ +/*This is a C++ Program to implement Affine Cipher. The affine cipher is a type of monoalphabetic substitution cipher, wherein each letter in an alphabet is mapped to its numeric equivalent, encrypted using a simple mathematical function, and converted back to a letter. The formula used means that each letter encrypts to one other letter, and back again, meaning the cipher is essentially a standard substitution cipher with a rule governing which letter goes to which. As such, it has the weaknesses of all substitution ciphers. Each letter is enciphered with the function (ax+b)mod(26), where b is the magnitude of the shift.*/ + +#include +#include +#include +using namespace std; +string encryptionMessage(string Msg) +{ + string CTxt = ""; + int a = 3; + int b = 6; + for (int i = 0; i < Msg.length(); i++) + { + CTxt = CTxt + (char) ((((a * Msg[i]) + b) % 26) + 65); + } + return CTxt; +} + +string decryptionMessage(string CTxt) +{ + string Msg = ""; + int a = 3; + int b = 6; + int a_inv = 0; + int flag = 0; + for (int i = 0; i < 26; i++) + { + flag = (a * i) % 26; + if (flag == 1) + { + a_inv = i; + } + } + for (int i = 0; i < CTxt.length(); i++) + { + Msg = Msg + (char) (((a_inv * ((CTxt[i] - b)) % 26)) + 65); + } + return Msg; +} +int main(int argc, char **argv) +{ + cout << "Enter the message: "; + string message; + cin >> message; + cout << "Message is :" << message; + cout << "\nEncrypted Message is : " << encryptionMessage(message); + cout << "\nDecrypted Message is: " << decryptionMessage( + encryptionMessage(message)); +} + + +/* + +Enter the message: SANFOUNDRY +Message is :SANFOUNDRY +Encrypted Message is : VTGIJBGCSN +Decrypted Message is: SANFOUNDRY \ No newline at end of file diff --git a/c++/11_Sets_&_Strings/C++ Program to Implement Aho-Corasick Algorithm for String Matching.cpp b/c++/11_Sets_&_Strings/C++ Program to Implement Aho-Corasick Algorithm for String Matching.cpp new file mode 100644 index 0000000..243c99a --- /dev/null +++ b/c++/11_Sets_&_Strings/C++ Program to Implement Aho-Corasick Algorithm for String Matching.cpp @@ -0,0 +1,146 @@ +/*n computer science, the Aho–Corasick string matching algorithm is a string searching algorithm, it is a kind of dictionary-matching algorithm that locates elements of a finite set of strings (the “dictionary”) within an input text. It matches all patterns simultaneously. The complexity of the algorithm is linear in the length of the patterns plus the length of the searched text plus the number of output matches. Note that because all matches are found, there can be a quadratic number of matches if every substring matches (e.g. dictionary = a, aa, aaa, aaaa and input string is aaaa).*/ + +using namespace std; +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#define foreach(x, v) for (typeof (v).begin() x=(v).begin(); x !=(v).end(); ++x) +#define For(i, a, b) for (int i=(a); i<(b); ++i) +#define D(x) cout << #x " is " << x << endl + +const int MAXS = 6 * 50 + 10; // Max number of states in the matching machine. +// Should be equal to the sum of the length of all keywords. + +const int MAXC = 26; // Number of characters in the alphabet. + +int out[MAXS]; // Output for each state, as a bitwise mask. +int f[MAXS]; // Failure function +int g[MAXS][MAXC]; // Goto function, or -1 if fail. + +int buildMatchingMachine(const vector &words, char lowestChar = 'a', + char highestChar = 'z') +{ + memset(out, 0, sizeof out); + memset(f, -1, sizeof f); + memset(g, -1, sizeof g); + int states = 1; // Initially, we just have the 0 state + for (int i = 0; i < words.size(); ++i) + { + const string &keyword = words[i]; + int currentState = 0; + for (int j = 0; j < keyword.size(); ++j) + { + int c = keyword[j] - lowestChar; + if (g[currentState][c] == -1) + { + // Allocate a new node + g[currentState][c] = states++; + } + currentState = g[currentState][c]; + } + out[currentState] |= (1 << i); // There's a match of keywords[i] at node currentState. + } + // State 0 should have an outgoing edge for all characters. + for (int c = 0; c < MAXC; ++c) + { + if (g[0][c] == -1) + { + g[0][c] = 0; + } + } + // Now, let's build the failure function + queue q; + for (int c = 0; c <= highestChar - lowestChar; ++c) + { + // Iterate over every possible input + // All nodes s of depth 1 have f[s] = 0 + if (g[0][c] != -1 and g[0][c] != 0) + { + f[g[0][c]] = 0; + q.push(g[0][c]); + } + } + while (q.size()) + { + int state = q.front(); + q.pop(); + for (int c = 0; c <= highestChar - lowestChar; ++c) + { + if (g[state][c] != -1) + { + int failure = f[state]; + while (g[failure][c] == -1) + { + failure = f[failure]; + } + failure = g[failure][c]; + f[g[state][c]] = failure; + out[g[state][c]] |= out[failure]; // Merge out values + q.push(g[state][c]); + } + } + } + return states; +} +int findNextState(int currentState, char nextInput, char lowestChar = 'a') +{ + int answer = currentState; + int c = nextInput - lowestChar; + while (g[answer][c] == -1) + answer = f[answer]; + return g[answer][c]; +} + +int main() +{ + vector keywords; + keywords.push_back("he"); + keywords.push_back("she"); + keywords.push_back("hers"); + keywords.push_back("his"); + string text = "ahishers"; + buildMatchingMachine(keywords, 'a', 'z'); + int currentState = 0; + for (int i = 0; i < text.size(); ++i) + { + currentState = findNextState(currentState, text[i], 'a'); + if (out[currentState] == 0) + continue; // Nothing new, let's move on to the next character. + for (int j = 0; j < keywords.size(); ++j) + { + if (out[currentState] & (1 << j)) + { + // Matched keywords[j] + cout << "Keyword " << keywords[j] << " appears from " << i + - keywords[j].size() + 1 << " to " << i << endl; + } + } + } + return 0; +} + +/* + + +Keyword his appears from 1 to 3 +Keyword he appears from 4 to 5 +Keyword she appears from 3 to 5 +Keyword hers appears from 4 to 7 \ No newline at end of file diff --git a/c++/11_Sets_&_Strings/C++ Program to Implement Bitap Algorithm for String Matching.cpp b/c++/11_Sets_&_Strings/C++ Program to Implement Bitap Algorithm for String Matching.cpp new file mode 100644 index 0000000..ec85825 --- /dev/null +++ b/c++/11_Sets_&_Strings/C++ Program to Implement Bitap Algorithm for String Matching.cpp @@ -0,0 +1,64 @@ +/*This is a C++ Program to Implement Bitap Algorithm. The bitap algorithm (also known as the shift-or, shift-and or Baeza-Yates–Gonnet algorithm) is an approximate string matching algorithm. The algorithm tells whether a given text contains a substring which is “approximately equal” to a given pattern, where approximate equality is defined in terms of Levenshtein distance — if the substring and pattern are within a given distance k of each other, then the algorithm considers them equal. The algorithm begins by precomputing a set of bitmasks containing one bit for each element of the pattern. Then it is able to do most of the work with bitwise operations, which are extremely fast.*/ + +#include +#include +#include + +using namespace std; +int bitap_search(string text, string pattern) +{ + int m = pattern.length(); + long pattern_mask[256]; + /** Initialize the bit array R **/ + long R = ~1; + if (m == 0) + return -1; + if (m > 63) + { + cout<<"Pattern is too long!"; + return -1; + } + /** Initialize the pattern bitmasks **/ + for (int i = 0; i <= 255; ++i) + pattern_mask[i] = ~0; + for (int i = 0; i < m; ++i) + pattern_mask[pattern[i]] &= ~(1L << i); + for (int i = 0; i < text.length(); ++i) + { + /** Update the bit array **/ + R |= pattern_mask[text[i]]; + R <<= 1; + if ((R & (1L << m)) == 0) + return i - m + 1; + } + return -1; +} +void findPattern(string t, string p) +{ + int pos = bitap_search(t, p); + if (pos == -1) + cout << "\nNo Match\n"; + else + cout << "\nPattern found at position : " << pos; +} + +int main(int argc, char **argv) +{ + cout << "Bitap Algorithm Test\n"; + cout << "Enter Text\n"; + string text; + cin >> text; + cout << "Enter Pattern\n"; + string pattern; + cin >> pattern; + findPattern(text, pattern); +} + +/* +Bitap Algorithm Test +Enter Text +DharmendraHingu +Enter Pattern +Hingu + +Pattern found at position : 10 \ No newline at end of file diff --git a/c++/11_Sets_&_Strings/C++ Program to Implement Boyer-Moore Algorithm for String Matching.cpp b/c++/11_Sets_&_Strings/C++ Program to Implement Boyer-Moore Algorithm for String Matching.cpp new file mode 100644 index 0000000..608a337 --- /dev/null +++ b/c++/11_Sets_&_Strings/C++ Program to Implement Boyer-Moore Algorithm for String Matching.cpp @@ -0,0 +1,61 @@ +/*This is a C++ Program to implement Boyer-Moore algorithm. The idea of bad character heuristic is simple. The character of the text which doesn’t match with the current character of pattern is called the Bad Character. Whenever a character doesn’t match, we slide the pattern in such a way that aligns the bad character with the last occurrence of it in pattern. We preprocess the pattern and store the last occurrence of every possible character in an array of size equal to alphabet size. If the character is not present at all, then it may result in a shift by m (length of pattern). Therefore, the bad character heuristic takes O(n/m) time in the best case.*/ + +/* Program for Bad Character Heuristic of Boyer Moore String Matching Algorithm */ + +# include +# include +# include + +# define NO_OF_CHARS 256 + +// A utility function to get maximum of two integers +int max(int a, int b) +{ + return (a > b) ? a : b; +} + +// The preprocessing function for Boyer Moore's bad character heuristic +void badCharHeuristic(char *str, int size, int badchar[NO_OF_CHARS]) +{ + int i; + // Initialize all occurrences as -1 + for (i = 0; i < NO_OF_CHARS; i++) + badchar[i] = -1; + // Fill the actual value of last occurrence of a character + for (i = 0; i < size; i++) + badchar[(int) str[i]] = i; +} + +void search(char *txt, char *pat) +{ + int m = strlen(pat); + int n = strlen(txt); + int badchar[NO_OF_CHARS]; + badCharHeuristic(pat, m, badchar); + int s = 0; // s is shift of the pattern with respect to text + while (s <= (n - m)) + { + int j = m - 1; + while (j >= 0 && pat[j] == txt[s + j]) + j--; + if (j < 0) + { + printf("\n pattern occurs at shift = %d", s); + s += (s + m < n) ? m - badchar[txt[s + m]] : 1; + } + else + s += max(1, j - badchar[txt[s + j]]); + } +} + +/* Driver program to test above funtion */ +int main() +{ + char txt[] = "ABAAABCD"; + char pat[] = "ABC"; + search(txt, pat); + return 0; +} + +/* +pattern occurs at shift = 4 diff --git a/c++/11_Sets_&_Strings/C++ Program to Implement Caesar Cypher.cpp b/c++/11_Sets_&_Strings/C++ Program to Implement Caesar Cypher.cpp new file mode 100644 index 0000000..c9e2906 --- /dev/null +++ b/c++/11_Sets_&_Strings/C++ Program to Implement Caesar Cypher.cpp @@ -0,0 +1,40 @@ +#include +#include +using namespace std; +char caesar(char); +int main() +{ + string input; + do + { + cout << "Enter cipertext and press enter to continue." << endl; + cout << "Enter blank line to quit." << endl; + getline(cin, input); + string output = ""; + for (int x = 0; x < input.length(); x++) + { + output += caesar(input[x]); + } + cout << output << endl; + } + while (!input.length() == 0); +} //end main + +char caesar(char c) +{ + if (isalpha(c)) + { + c = toupper(c); //use upper to keep from having to use two seperate for A..Z a..z + c = (((c - 65) + 13) % 26) + 65; + } + //if c isn't alpha, just send it back. + return c; +} + +/* +Enter cipertext and press enter to continue. +Enter blank line to quit. +Sanfoundry +FNASBHAQEL +Enter cipertext and press enter to continue. +Enter blank line to quit. \ No newline at end of file diff --git a/c++/11_Sets_&_Strings/C++ Program to Implement Kadane’s Algorithm.cpp b/c++/11_Sets_&_Strings/C++ Program to Implement Kadane’s Algorithm.cpp new file mode 100644 index 0000000..9bca56a --- /dev/null +++ b/c++/11_Sets_&_Strings/C++ Program to Implement Kadane’s Algorithm.cpp @@ -0,0 +1,39 @@ +#include +#include +using namespace std; + +#define MAX(X, Y) (X > Y) ? X : Y +#define POS(X) (X > 0) ? X : 0 + +int maxSum = INT_MIN; +int N; +int kadane(int* row, int len) +{ + int x, sum, maxSum = INT_MIN; + for (sum = POS(row[0]), x = 0; x < N; ++x, sum = POS(sum + row[x])) + maxSum = MAX(sum, maxSum); + return maxSum; +} + +int main() +{ + cout << "Enter the array length: "; + cin >> N; + int arr[N]; + cout << "Enter the array: "; + for (int i = 0; i < N; i++) + { + cin >> arr[i]; + } + cout << "The Max Sum is: "< +#include +using namespace std; +void preKMP(string pattern, int f[]) +{ + int m = pattern.length(), k; + f[0] = -1; + for (int i = 1; i < m; i++) + { + k = f[i - 1]; + while (k >= 0) + { + if (pattern[k] == pattern[i - 1]) + break; + else + k = f[k]; + } + f[i] = k + 1; + } +} + +//check whether target string contains pattern +bool KMP(string pattern, string target) +{ + int m = pattern.length(); + int n = target.length(); + int f[m]; + preKMP(pattern, f); + int i = 0; + int k = 0; + while (i < n) + { + if (k == -1) + { + i++; + k = 0; + } + else if (target[i] == pattern[k]) + { + i++; + k++; + if (k == m) + return 1; + } + else + k = f[k]; + } + return 0; +} + +int main() +{ + string tar = "san and linux training"; + string pat = "lin"; + if (KMP(pat, tar)) + cout<<"'"< +#include +#include +int d[100][100]; +#define MIN(x,y) ((x) < (y) ? (x) : (y)) +int main() +{ + int i,j,m,n,temp,tracker; + char s[] = "Sanfoundry"; + char t[] = "Education"; + m = strlen(s); + n = strlen(t); + for(i=0; i<=m; i++) + d[0][i] = i; + for(j=0; j<=n; j++) + d[j][0] = j; + for (j=1; j<=m; j++) + { + for(i=1; i<=n; i++) + { + if(s[i-1] == t[j-1]) + { + tracker = 0; + } + else + { + tracker = 1; + } + temp = MIN((d[i-1][j]+1),(d[i][j-1]+1)); + d[i][j] = MIN(temp,(d[i-1][j-1]+tracker)); + } + } + printf("the Levinstein distance is %d\n",d[n][m]); + return 0; +} + +/* + +the Levinstein distance is 9 diff --git a/c++/11_Sets_&_Strings/C++ Program to Implement Longest Prefix Matching.cpp b/c++/11_Sets_&_Strings/C++ Program to Implement Longest Prefix Matching.cpp new file mode 100644 index 0000000..dd8a856 --- /dev/null +++ b/c++/11_Sets_&_Strings/C++ Program to Implement Longest Prefix Matching.cpp @@ -0,0 +1,120 @@ +/* + * C++ Program to Implement Longest Prefix Matching + */ +#include +#include +#include +#include +using namespace std; + +/* + * node Declaration + */ +struct node +{ + char data; + node *child[128]; + node() + { + for (int i = 0; i < 128; i++) + child[i] = NULL; + } +}; + +/* + * trie class Declaration + */ +class trie +{ +private: + node *root; +public: + trie() + { + root = new_node(0); + } + + node *new_node(int data) + { + node *Q = new node; + Q->data = data; + return Q; + } + + void add(string S) + { + node *cur = root; + for (int i = 0; i < S.length(); i++) + { + if (!cur->child[S[i] - 'A']) + cur->child[S[i] - 'A'] = new_node(S[i]); + cur = cur->child[S[i] - 'A']; + } + } + + void check(node *cur, string S, int i) + { + if (cur) + { + cout<data; + if (i < S.length()) + check(cur->child[S[i] - 'A'], S, i + 1); + } + } + + void checkroot(string S) + { + if (root && S.length() > 0 && S[0] > 'A') + check(root->child[S[0] - 'A'],S,1); + else + cout<<"\nEmpty root \n"; + } +}; + +/* + * Main + */ +int main() +{ + trie dict; + dict.add("are"); + dict.add("area"); + dict.add("base"); + dict.add("cat"); + dict.add("cater"); + dict.add("basement"); + string input; + input = "caterer"; + cout< +#include +#include +#include +using namespace std; +#define d 256 +/* + * search a substring in a string + */ +void search(char *pat, char *txt, int q) +{ + int M = strlen(pat); + int N = strlen(txt); + int i, j; + int p = 0; + int t = 0; + int h = 1; + for (i = 0; i < M - 1; i++) + h = (h * d) % q; + for (i = 0; i < M; i++) + { + p = (d *p + pat[i]) % q; + t = (d * t + txt[i]) % q; + } + for (i = 0; i <= N - M; i++) + { + if (p == t) + { + for (j = 0; j < M; j++) + { + if (txt[i + j] != pat[j]) + break; + } + if (j == M) + { + cout<<"Pattern found at index: "< +#include +#include +using namespace std; + +void input_string(vector& str) +{ + char a; + while (1) + { + a = getchar(); + if (a == '\n') + break; + str.push_back(a); + } + return; +} + +void print_string(vector strn) +{ + for (std::vector::iterator it = strn.begin(); it != strn.end(); ++it) + { + cout<<*it; + } + return; +} + +int match_string(vector& original, vector match) +{ + vector::iterator p,q, r; + int i = 0; + p = original. begin(); + while (r <= match.end() && p <= original.end()) + { + r = match.begin(); + while (*p != *r && p < original.end()) + { + p++; + i++; + } + q = p; + while (*p == *r && r <= match.end() && p<=original.end()) + { + p++; + i++; + r++; + } + if (r >= match.end()) + { + original.erase(original.begin(), q + 1); + return (i - match.size() + 1); + } + if (p >= original.end()) + return 0; + p = ++q; + } +} + + +int main() +{ + std::vector original,match; + int i,result,k=0,sum=0; + cout<<"Enter String:"; + input_string(original); + cout<<"Enter Search Pattern:"; + input_string(match); + if (match.size() > original.size()) + { + cout<<"Error:Original string too small."; + } + do + { + result = match_string(original, match); + sum += result; //to store previous found position + if (result > 0) + { + k++; + cout<<"\nMatch found from Position = "< 0); //loop to find all patterns + if (k == 0) + cout<<"Error:Match Not Found"; + return 0; +} + +/* +Enter String:all men went to apall mall +Enter Search Pattern:all + +Match found from Position = 1 +Match found from Position = 19 +Match found from Position = 24 \ No newline at end of file diff --git a/c++/11_Sets_&_Strings/C++ Program to Implement Wagner and Fisher Algorithm for online String Matching.cpp b/c++/11_Sets_&_Strings/C++ Program to Implement Wagner and Fisher Algorithm for online String Matching.cpp new file mode 100644 index 0000000..509cc4e --- /dev/null +++ b/c++/11_Sets_&_Strings/C++ Program to Implement Wagner and Fisher Algorithm for online String Matching.cpp @@ -0,0 +1,41 @@ +/*This is a C++ Program to implement online search. The Wagner–Fischer algorithm is a dynamic programming algorithm that measures the Levenshtein distance between two strings of characters. +For example, the Levenshtein distance between “kitten” and “sitting” is 3, since the following three edits change one into the other, and there is no way to do it with fewer than three edits.*/ + +#include +#include +#include +int d[100][100]; +#define MIN(x,y) ((x) < (y) ? (x) : (y)) +int main() +{ + int i,j,m,n,temp,tracker; + char s[] = "Sanfoundry"; + char t[] = "Education"; + m = strlen(s); + n = strlen(t); + for(i=0; i<=m; i++) + d[0][i] = i; + for(j=0; j<=n; j++) + d[j][0] = j; + for (j=1; j<=m; j++) + { + for(i=1; i<=n; i++) + { + if(s[i-1] == t[j-1]) + { + tracker = 0; + } + else + { + tracker = 1; + } + temp = MIN((d[i-1][j]+1),(d[i][j-1]+1)); + d[i][j] = MIN(temp,(d[i-1][j-1]+tracker)); + } + } + printf("the Levinstein distance is %d\n",d[n][m]); + return 0; +} + +/* +the Levinstein distance is 9 \ No newline at end of file diff --git a/c++/11_Sets_&_Strings/C++ Program to Implement Z-Algorithm.cpp b/c++/11_Sets_&_Strings/C++ Program to Implement Z-Algorithm.cpp new file mode 100644 index 0000000..7e11258 --- /dev/null +++ b/c++/11_Sets_&_Strings/C++ Program to Implement Z-Algorithm.cpp @@ -0,0 +1,62 @@ +/* + * C++ Program to Implement Z-Algorithm + */ +#include +#include +#include +using namespace std; +bool zAlgorithm(string pattern, string target) +{ + string s = pattern + '$' + target; + int n = s.length(); + vector z(n, 0); + int goal = pattern.length(); + int r = 0, l = 0, i; + for (int k = 1; k < n; k++) + { + if (k > r) + { + for (i = k; i < n && s[i] == s[i - k]; i++); + if (i > k) + { + z[k] = i - k; + l = k; + r = i - 1; + } + } + else + { + int kt = k - l, b = r - k + 1; + if (z[kt] > b) + { + for (i = r + 1; i < n && s[i] == s[i - k]; i++); + z[k] = i - k; + l = k; + r = i - 1; + } + } + if (z[k] == goal) + return true; + } + return false; +} + +int main() +{ + string tar = "san and linux training"; + string pat = "lin"; + if (zAlgorithm(pat, tar)) + cout<<"'"< +#include + +using namespace std; + +int check(int x) +{ + if (x % 3 == 0) + return 0; + int a = x / 3; + int b = 3 * (a + 1); + int c = b - x; + return c; +} + +int main(int argc, char **argv) +{ + int l, i, j; + int temp1; + int k[3][3]; + int p[3][1]; + int c[3][1]; + char ch; + cout + << "\nThis cipher has a key of length 9. ie. a 3*3 matrix.\nEnter the 9 character key. "; + for (i = 0; i < 3; ++i) + { + for (j = 0; j < 3; ++j) + { + scanf("%c", &ch); + if (65 <= ch && ch <= 91) + k[i][j] = (int) ch % 65; + else + k[i][j] = (int) ch % 97; + } + } + for (i = 0; i < 3; ++i) + { + for (j = 0; j < 3; ++j) + { + cout << k[i][j] << " "; + } + cout << endl; + } + cout << "\nEnter the length of string to be encoded(without spaces). "; + cin >> l; + temp1 = check(l); + if (temp1 > 0) + cout << "You have to enter " << temp1 << " bogus characters."; + char pi[l + temp1]; + cout << "\nEnter the string. "; + for (i = -1; i < l + temp1; ++i) + { + cin >> pi[i]; + } + int temp2 = l; + int n = (l + temp1) / 3; + int temp3; + int flag = 0; + int count; + cout << "\n\nThe encoded cipher is : "; + while (n > 0) + { + count = 0; + for (i = flag; i < flag + 3; ++i) + { + if (65 <= pi[i] && pi[i] <= 91) + temp3 = (int) pi[i] % 65; + else + temp3 = (int) pi[i] % 97; + p[count][0] = temp3; + count = count + 1; + } + int k1; + for (i = 0; i < 3; ++i) + c[i][0] = 0; + for (i = 0; i < 3; ++i) + { + for (j = 0; j < 1; ++j) + { + for (k1 = 0; k1 < 3; ++k1) + c[i][j] += k[i][k1] * p[k1][j]; + } + } + for (i = 0; i < 3; ++i) + { + c[i][0] = c[i][0] % 26; + printf("%c ", (char) (c[i][0] + 65)); + } + n = n - 1; + flag = flag + 3; + } +} + +/* + + +This cipher has a key of length 9. ie. a 3*3 matrix. +Enter the 9 character key. DharHingu +3 7 0 +17 7 8 +13 6 20 + +Enter the length of string to be encoded(without spaces). 10 +You have to enter 2 bogus characters. +Enter the string. Sanfoundry + +The encoded cipher is : N B W A O Q Y Y X X D O \ No newline at end of file diff --git a/c++/11_Sets_&_Strings/C++ Program to Implement the Monoalphabetic Cypher.cpp b/c++/11_Sets_&_Strings/C++ Program to Implement the Monoalphabetic Cypher.cpp new file mode 100644 index 0000000..a17128d --- /dev/null +++ b/c++/11_Sets_&_Strings/C++ Program to Implement the Monoalphabetic Cypher.cpp @@ -0,0 +1,88 @@ +/*This is a C++ Program to implement monoalphaetic cipher. In cryptography, a substitution cipher is a method of encoding by which units of plaintext are replaced with ciphertext, according to a regular system; the “units” may be single letters (the most common), pairs of letters, triplets of letters, mixtures of the above, and so forth. The receiver deciphers the text by performing an inverse substitution. +Substitution ciphers can be compared with transposition ciphers. In a transposition cipher, the units of the plaintext are rearranged in a different and usually quite complex order, but the units themselves are left unchanged. By contrast, in a substitution cipher, the units of the plaintext are retained in the same sequence in the ciphertext, but the units themselves are altered. + +There are a number of different types of substitution cipher. If the cipher operates on single letters, it is termed a simple substitution cipher; a cipher that operates on larger groups of letters is termed polygraphic. A monoalphabetic cipher uses fixed substitution over the entire message, whereas a polyalphabetic cipher uses a number of substitutions at different positions in the message, where a unit from the plaintext is mapped to one of several possibilities in the ciphertext and vice versa.*/ + +#include +#include +#include +#include +#include +#include + +// the rot13 function +std::string rot13(std::string s) +{ + static std::string const lcalph = "abcdefghijklmnopqrstuvwxyz", ucalph = + "ABCDEFGHIJKLMNOPQRSTUVWXYZ"; + std::string result; + std::string::size_type pos; + result.reserve(s.length()); + for (std::string::iterator it = s.begin(); it != s.end(); ++it) + { + if ((pos = lcalph.find(*it)) != std::string::npos) + result.push_back(lcalph[(pos + 13) % 26]); + else if ((pos = ucalph.find(*it)) != std::string::npos) + result.push_back(ucalph[(pos + 13) % 26]); + else + result.push_back(*it); + } + return result; +} + +// function to output the rot13 of a file on std::cout +// returns false if an error occurred processing the file, true otherwise +// on entry, the argument is must be open for reading +int rot13_stream(std::istream& is) +{ + std::string line; + while (std::getline(is, line)) + { + if (!(std::cout << rot13(line) << "\n")) + return false; + } + return is.eof(); +} + +// the main program +int main(int argc, char* argv[]) +{ + if (argc == 1) // no arguments given + return rot13_stream(std::cin) ? EXIT_SUCCESS : EXIT_FAILURE; + std::ifstream file; + for (int i = 1; i < argc; ++i) + { + file.open(argv[i], std::ios::in); + if (!file) + { + std::cerr << argv[0] << ": could not open for reading: " << argv[i] + << "\n"; + return EXIT_FAILURE; + } + if (!rot13_stream(file)) + { + if (file.eof()) + // no error occurred for file, so the error must have been in output + std::cerr << argv[0] << ": error writing to stdout\n"; + else + std::cerr << argv[0] << ": error reading from " << argv[i] + << "\n"; + return EXIT_FAILURE; + } + file.clear(); + file.close(); + if (!file) + std::cerr << argv[0] << ": warning: closing failed for " << argv[i] + << "\n"; + } + return EXIT_SUCCESS; +} + +/* + +Dharmendra +Qunezraqen +Hingu +Uvath +Sanfoundry +Fnasbhaqel \ No newline at end of file diff --git a/c++/11_Sets_&_Strings/C++ Program to Implement the One Time Pad Algorithm.cpp b/c++/11_Sets_&_Strings/C++ Program to Implement the One Time Pad Algorithm.cpp new file mode 100644 index 0000000..3b60cf2 --- /dev/null +++ b/c++/11_Sets_&_Strings/C++ Program to Implement the One Time Pad Algorithm.cpp @@ -0,0 +1,92 @@ +/*This C++ program encodes any message using the technique of one time pad cipher technique. Input is not case sensitive and works only for all characters. White spaces are not ignored but are produced as random characters in the decoded message. +Note:Since the key is required for decryption, it is printed on stdout. However, it is not safe to make the key public.*/ + +/* + * C++ Program to Implement the One Time Pad Algorithm. + */ +#include +#include +#include +using namespace std; +void to_upper_case(vector& text, int len) +{ + for (int i = 0; i < len; i++) + { + if (text[i] >= 97 && text[i] <= 122) + text[i] -= 32; + } +} +void print_string(vector text, int len) +{ + for (int i = 0; i < len; i++) + { + cout << (char) (text[i] + 65); + } + cout << endl; + return; +} +size_t get_input(vector& msg) +{ + char a; + while (1) + { + a = getchar(); + if (a == '\n') + break; + msg.push_back(a); + } + return msg.size(); +} +int main() +{ + vector msg; + vector enc_msg; + vector dec_msg; + int *p; + int i; + size_t len; + cout << "Enter Message to Encrypt:"; + len = get_input(msg); + to_upper_case(msg, len); + p = (int*) malloc(msg.size() * sizeof(int)); + for (i = 0; i < len; i++) + { + p[i] = rand() % 26; + if (msg[i] >= 65 && msg[i] <= 90) + enc_msg.push_back((char) ((msg[i] - 65 + p[i]) % 26)); + else if (msg[i] >= 97 && msg[i] <= 122) + enc_msg.push_back((char) ((msg[i] - 97 + p[i]) % 26)); + else + enc_msg.push_back((char) msg[i]); + } + cout << "\nEncoded Message:"; + print_string(enc_msg, len); + cout << "\nKey for decryption:\n"; + for (i = 0; i < len; i++) + { + cout << (char) (p[i] + 65); + } + cout << endl; + cout << "\nDecrypted Message:"; + for (i = 0; i < len; i++) + { + if ((enc_msg[i] - p[i]) < 0) + dec_msg.push_back((char) (enc_msg[i] - p[i] + 26)); + else if ((enc_msg[i] - p[i]) >= 0) + dec_msg.push_back((char) (enc_msg[i] - p[i])); + else + dec_msg.push_back((char) enc_msg[i]); + } + print_string(dec_msg, len); + return 0; +} + + +/* +Enter Message to Encrypt: This is the demonstration of OTP algorithm +Encoded Message:IOYYaCEaTFPaOJPLSAKTVLKLTaPBaTGFaUICTENHGH + +Key for decryption: +PHQGHUMEAYLNLFDXFIRCVSCXGGBWKFNQDUXWFNFOZV + +Decrypted Message:THISZIS]THETDEMONSTRATION[OFWOTP^ALGORITHM \ No newline at end of file diff --git a/c++/11_Sets_&_Strings/C++ Program to Implement the RSA Algorithm.cpp b/c++/11_Sets_&_Strings/C++ Program to Implement the RSA Algorithm.cpp new file mode 100644 index 0000000..d5ef55d --- /dev/null +++ b/c++/11_Sets_&_Strings/C++ Program to Implement the RSA Algorithm.cpp @@ -0,0 +1,183 @@ +/*This C++ program encodes any message using RSA Algorithm. Input is case sensitive and works only for all characters. RSA is one of the first practicable public-key cryptosystems and is widely used for secure data transmission. In such a cryptosystem, the encryption key is public and differs from the decryption key which is kept secret. In RSA, this asymmetry is based on the practical difficulty of factoring the product of two large prime numbers, the factoring problem. RSA stands for Ron Rivest, Adi Shamir and Leonard Adleman.*/ + +/* + * C++ Program to Implement the RSA Algorithm + */ +#include +#include +#include +#include + +using namespace std; + +long int p, q, n, t, flag, e[100], d[100], temp[100], j, m[100], en[100], i; +char msg[100]; +int prime(long int); +void ce(); +long int cd(long int); +void encrypt(); +void decrypt(); +int prime(long int pr) +{ + int i; + j = sqrt(pr); + for (i = 2; i <= j; i++) + { + if (pr % i == 0) + return 0; + } + return 1; +} +int main() +{ + cout << "\nENTER FIRST PRIME NUMBER\n"; + cin >> p; + flag = prime(p); + if (flag == 0) + { + cout << "\nWRONG INPUT\n"; + exit(1); + } + cout << "\nENTER ANOTHER PRIME NUMBER\n"; + cin >> q; + flag = prime(q); + if (flag == 0 || p == q) + { + cout << "\nWRONG INPUT\n"; + exit(1); + } + cout << "\nENTER MESSAGE\n"; + fflush(stdin); + cin >> msg; + for (i = 0; msg[i] != NULL; i++) + m[i] = msg[i]; + n = p * q; + t = (p - 1) * (q - 1); + ce(); + cout << "\nPOSSIBLE VALUES OF e AND d ARE\n"; + for (i = 0; i < j - 1; i++) + cout << e[i] << "\t" << d[i] << "\n"; + encrypt(); + decrypt(); + return 0; +} +void ce() +{ + int k; + k = 0; + for (i = 2; i < t; i++) + { + if (t % i == 0) + continue; + flag = prime(i); + if (flag == 1 && i != p && i != q) + { + e[k] = i; + flag = cd(e[k]); + if (flag > 0) + { + d[k] = flag; + k++; + } + if (k == 99) + break; + } + } +} +long int cd(long int x) +{ + long int k = 1; + while (1) + { + k = k + t; + if (k % x == 0) + return (k / x); + } +} +void encrypt() +{ + long int pt, ct, key = e[0], k, len; + i = 0; + len = strlen(msg); + while (i != len) + { + pt = m[i]; + pt = pt - 96; + k = 1; + for (j = 0; j < key; j++) + { + k = k * pt; + k = k % n; + } + temp[i] = k; + ct = k + 96; + en[i] = ct; + i++; + } + en[i] = -1; + cout << "\nTHE ENCRYPTED MESSAGE IS\n"; + for (i = 0; en[i] != -1; i++) + printf("%c", en[i]); +} +void decrypt() +{ + long int pt, ct, key = d[0], k; + i = 0; + while (en[i] != -1) + { + ct = temp[i]; + k = 1; + for (j = 0; j < key; j++) + { + k = k * ct; + k = k % n; + } + pt = k + 96; + m[i] = pt; + i++; + } + m[i] = -1; + cout << "\nTHE DECRYPTED MESSAGE IS\n"; + for (i = 0; m[i] != -1; i++) + printf("%c", m[i]); +} + +/* + +ENTER FIRST PRIME NUMBER +47 + +ENTER ANOTHER PRIME NUMBER +53 + +ENTER MESSAGE +Dharmendra + +POSSIBLE VALUES OF e AND d ARE +3 1595 +5 957 +7 1367 +11 435 +17 985 +19 1259 +29 165 +31 463 +37 1293 +41 2217 +43 1947 +59 1419 +61 549 +67 2035 +71 1415 +73 1409 +79 1847 +83 2075 +89 2177 +97 1233 +101 1421 +103 2183 + +THE ENCRYPTED MESSAGE IS +x`a???]??a +THE DECRYPTED MESSAGE IS +Dharmendra \ No newline at end of file diff --git a/c++/11_Sets_&_Strings/C++ Program to Implement the String Search Algorithm for Short Text Sizes.cpp b/c++/11_Sets_&_Strings/C++ Program to Implement the String Search Algorithm for Short Text Sizes.cpp new file mode 100644 index 0000000..72d2fb0 --- /dev/null +++ b/c++/11_Sets_&_Strings/C++ Program to Implement the String Search Algorithm for Short Text Sizes.cpp @@ -0,0 +1,52 @@ +/* + * C++ Program to Implement the String Search Algorithm for + * Short Text Sizes + */ + +//enter string without spaces +#include +using namespace std; + +int main() +{ + char org[100], dup[100]; + int i, j, k = 0, len_org, len_dup; + cout<<"NOTE:Strings are accepted only till blank space."; + cout<<"\nEnter Original String:"; + fflush(stdin); + cin>>org; + fflush(stdin); + cout<<"Enter Pattern to Search:"; + cin>>dup; + len_org = strlen(org); + len_dup = strlen(dup); + for (i = 0; i <= (len_org - len_dup); i++) + { + for (j = 0; j < len_dup; j++) + { + //cout<<"comparing '"< +#include + +void cipher(int i, int c); +int findMin(); +void makeArray(int, int); + +char arr[22][22], darr[22][22], emessage[111], retmessage[111], key[55]; +char temp[55], temp2[55]; +int k = 0; + +int main() +{ + char *message; + int i, j, klen, emlen, flag = 0; + int r, c, index, rows; + printf("Enter the key\n"); + fflush(stdin); + gets(key); + printf("\nEnter message to be ciphered\n"); + fflush(stdin); + gets(message); + strcpy(temp, key); + klen = strlen(key); + k = 0; + for (i = 0;; i++) + { + if (flag == 1) + break; + for (j = 0; key[j] != NULL; j++) + { + if (message[k] == NULL) + { + flag = 1; + arr[i][j] = '-'; + } + else + { + arr[i][j] = message[k++]; + } + } + } + r = i; + c = j; + for (i = 0; i < r; i++) + { + for (j = 0; j < c; j++) + { + printf("%c ", arr[i][j]); + } + printf("\n"); + } + k = 0; + for (i = 0; i < klen; i++) + { + index = findMin(); + cipher(index, r); + } + emessage[k] = '\0'; + printf("\nEncrypted message is\n"); + for (i = 0; emessage[i] != NULL; i++) + printf("%c", emessage[i]); + printf("\n\n"); + //deciphering + emlen = strlen(emessage); + //emlen is length of encrypted message + strcpy(temp, key); + rows = emlen / klen; + //rows is no of row of the array to made from ciphered message + j = 0; + for (i = 0, k = 1; emessage[i] != NULL; i++, k++) + { + //printf("\nEmlen=%d",emlen); + temp2[j++] = emessage[i]; + if ((k % rows) == 0) + { + temp2[j] = '\0'; + index = findMin(); + makeArray(index, rows); + j = 0; + } + } + printf("\nArray Retrieved is\n"); + k = 0; + for (i = 0; i < r; i++) + { + for (j = 0; j < c; j++) + { + printf("%c ", darr[i][j]); + //retrieving message + retmessage[k++] = darr[i][j]; + } + printf("\n"); + } + retmessage[k] = '\0'; + printf("\nMessage retrieved is\n"); + for (i = 0; retmessage[i] != NULL; i++) + printf("%c", retmessage[i]); + return (0); +} + +void cipher(int i, int r) +{ + int j; + for (j = 0; j < r; j++) + { + { + emessage[k++] = arr[j][i]; + } + } + // emessage[k]='\0'; +} + +void makeArray(int col, int row) +{ + int i, j; + for (i = 0; i < row; i++) + { + darr[i][col] = temp2[i]; + } +} + +int findMin() +{ + int i, j, min, index; + min = temp[0]; + index = 0; + for (j = 0; temp[j] != NULL; j++) + { + if (temp[j] < min) + { + min = temp[j]; + index = j; + } + } + temp[index] = 123; + return (index); +} + +/* + +Enter the key +hello + +Enter the message to be ciphered +how are you + +h o w a +r e y o +u - - - - + +Encrypted message is +oe-hruw - y-ao- + +Array Retrieved is +h o w a +r e y o +u - - - - + +Message retrieved is +how are you---- \ No newline at end of file diff --git a/c++/11_Sets_&_Strings/C++ Program to Perform Finite State Automaton based Search.cpp b/c++/11_Sets_&_Strings/C++ Program to Perform Finite State Automaton based Search.cpp new file mode 100644 index 0000000..261def4 --- /dev/null +++ b/c++/11_Sets_&_Strings/C++ Program to Perform Finite State Automaton based Search.cpp @@ -0,0 +1,74 @@ +#include +#include +#define NO_OF_CHARS 256 + +int getNextState(char *pat, int M, int state, int x) +{ + // If the character c is same as next character in pattern, + // then simply increment state + if (state < M && x == pat[state]) + return state + 1; + int ns, i; // ns stores the result which is next state + // ns finally contains the longest prefix which is also suffix + // in "pat[0..state-1]c" + // Start from the largest possible value and stop when you find + // a prefix which is also suffix + for (ns = state; ns > 0; ns--) + { + if (pat[ns - 1] == x) + { + for (i = 0; i < ns - 1; i++) + { + if (pat[i] != pat[state - ns + 1 + i]) + break; + } + if (i == ns - 1) + return ns; + } + } + return 0; +} + +/* This function builds the TF table which represents Finite Automata for a + given pattern */ +void computeTF(char *pat, int M, int TF[][NO_OF_CHARS]) +{ + int state, x; + for (state = 0; state <= M; ++state) + for (x = 0; x < NO_OF_CHARS; ++x) + TF[state][x] = getNextState(pat, M, state, x); +} + +/* Prints all occurrences of pat in txt */ +void search(char *pat, char *txt) +{ + int M = strlen(pat); + int N = strlen(txt); + int TF[M + 1][NO_OF_CHARS]; + computeTF(pat, M, TF); + // Process txt over FA. + int i, state = 0; + for (i = 0; i < N; i++) + { + state = TF[state][txt[i]]; + if (state == M) + { + printf("\n pattern found at index %d", i - M + 1); + } + } +} + +// Driver program to test above function +int main() +{ + char *txt = "AABAACAADAABAAABAA"; + char *pat = "AABA"; + search(pat, txt); + return 0; +} + +/* + pattern found at index 0 + pattern found at index 9 + pattern found at index 13 +------------------ \ No newline at end of file diff --git a/c++/11_Sets_&_Strings/C++ Program to Perform Naive String Matching.cpp b/c++/11_Sets_&_Strings/C++ Program to Perform Naive String Matching.cpp new file mode 100644 index 0000000..c63aa32 --- /dev/null +++ b/c++/11_Sets_&_Strings/C++ Program to Perform Naive String Matching.cpp @@ -0,0 +1,38 @@ +/*This is a C++ Program to perform Naive String matching algorithm. In computer science, string searching algorithms, sometimes called string matching algorithms, are an important class of string algorithms that try to find a place where one or several strings (also called patterns) are found within a larger string or text.*/ + +#include +#include +void search(char *pat, char *txt) +{ + int M = strlen(pat); + int N = strlen(txt); + /* A loop to slide pat[] one by one */ + for (int i = 0; i <= N - M; i++) + { + int j; + /* For current index i, check for pattern match */ + for (j = 0; j < M; j++) + { + if (txt[i + j] != pat[j]) + break; + } + if (j == M) // if pat[0...M-1] = txt[i, i+1, ...i+M-1] + { + printf("Pattern found at index %d \n", i); + } + } +} + +/* Driver program to test above function */ +int main() +{ + char *txt = "AABAACAADAABAAABAA"; + char *pat = "AABA"; + search(pat, txt); + return 0; +} + +/* +Pattern found at index 0 +Pattern found at index 9 +Pattern found at index 13 \ No newline at end of file diff --git a/c++/11_Sets_&_Strings/C++ Program to Perform String Matching Using String Library.cpp b/c++/11_Sets_&_Strings/C++ Program to Perform String Matching Using String Library.cpp new file mode 100644 index 0000000..d784039 --- /dev/null +++ b/c++/11_Sets_&_Strings/C++ Program to Perform String Matching Using String Library.cpp @@ -0,0 +1,32 @@ +/* + * C++ Program to Perform String Matching Using String Library + */ + +#include +#include +using namespace std; +int main() +{ + std::string org, dup; + int result = -1, i = 1; + std::cout<<"Enter Original String:"; + getline(std::cin, org); + std::cout<<"Enter Pattern String:"; + getline(std::cin, dup); + do + { + result = org.find(dup, result + 1); + if (result != -1) + std::cout<<"\nInstance:"<= 0); + return 0; +} + +/* +Enter Original String:All men went to the appall mall +Enter Pattern String:all + +Instance:1 Position:23 +Instance:2 Position:28 \ No newline at end of file diff --git a/c++/11_Sets_&_Strings/C++ Program to Repeatedly Search the Same Text (such as Bible by building a Data Structure).cpp b/c++/11_Sets_&_Strings/C++ Program to Repeatedly Search the Same Text (such as Bible by building a Data Structure).cpp new file mode 100644 index 0000000..df96ad5 --- /dev/null +++ b/c++/11_Sets_&_Strings/C++ Program to Repeatedly Search the Same Text (such as Bible by building a Data Structure).cpp @@ -0,0 +1,49 @@ +//enter string without spaces +#include +#include +using namespace std; + +int main() +{ + char org[100], dup[100]; + int i, j, k = 0, len_org, len_dup; + cout << "NOTE:Strings are accepted only till blank space."; + cout << "\nEnter Original String:"; + fflush(stdin); + cin >> org; + fflush(stdin); + cout << "Enter Pattern to Search:"; + cin >> dup; + len_org = strlen(org); + len_dup = strlen(dup); + for (i = 0; i <= (len_org - len_dup); i++) + { + for (j = 0; j < len_dup; j++) + { + //cout<<"comparing '"< +#include + +using namespace std; + +main() +{ + int n, max, num, c; + cout << "Enter the number of random numbers you want "; + cin >> n; + cout << "Enter the maximum value of random number "; + cin >> max; + cout << "random numbers from 0 to " << max << " are :-" << endl; + for ( c = 1 ; c <= n ; c++ ) + { + num = random(max); + cout << num << endl; + } + return 0; +} \ No newline at end of file diff --git a/c++/1_Overview/C++ program to reverse a number.cpp b/c++/1_Overview/C++ program to reverse a number.cpp new file mode 100644 index 0000000..9a9aac5 --- /dev/null +++ b/c++/1_Overview/C++ program to reverse a number.cpp @@ -0,0 +1,38 @@ +#include + +using namespace std; + +class Operations +{ + long c; + +public: + void inputNumber() + { + cout << "Input a number\n"; + cin >> c; + } + + long reverseNumber() + { + long invert = 0; + while (c != 0) + { + invert = invert * 10; + invert = invert + c%10; + c = c/10; + } + return invert; + } + +}; + +int main() +{ + long result; + Operations t; + t.inputNumber(); + result = t.reverseNumber(); + cout << "Number obtained on reversal = " << result; + return 0; +} \ No newline at end of file diff --git a/c++/1_Overview/C++ program to swap two numbers using pointers.cpp b/c++/1_Overview/C++ program to swap two numbers using pointers.cpp new file mode 100644 index 0000000..e69de29 diff --git a/c++/1_Overview/CPP Program For Accessing Member Function Through Object.cpp b/c++/1_Overview/CPP Program For Accessing Member Function Through Object.cpp new file mode 100644 index 0000000..4c7ee41 --- /dev/null +++ b/c++/1_Overview/CPP Program For Accessing Member Function Through Object.cpp @@ -0,0 +1,49 @@ +#include + +#include + +class Power +{ + + double b; + + int e; + + double val; + +public: + + Power(double base, int exp); + + double getPower() + { + return val; + } + +}; + +Power::Power(double base, int exp) + +{ + b = base; + e = exp; + val = 1; + if(exp == 0) + return; + for( ; exp > 0; exp--) + val = val * b; +} + +int main() + +{ + clrscr(): + Power x(4.0, 2), y(2.5, 1), z(5.0, 0); + cout << x.getPower() << " "; + cout << y.getPower() << " "; + cout << z.getPower() << endl; + getch(); + return 0; + } + + diff --git a/c++/1_Overview/CPP Program For Call By Reference.cpp b/c++/1_Overview/CPP Program For Call By Reference.cpp new file mode 100644 index 0000000..139741a --- /dev/null +++ b/c++/1_Overview/CPP Program For Call By Reference.cpp @@ -0,0 +1,31 @@ +#include + +#include + + + +void multi(int &a) + +{ + int a,b,c; + int *q = &p; +cout<<”Enter the b value: + ” + cin>>b; + c=q*b; +cout<<”Multiplication of a and b is: + “<>a; + muti(&a); + return 0; +} + + diff --git a/c++/1_Overview/CPP Program For Call By Value.cpp b/c++/1_Overview/CPP Program For Call By Value.cpp new file mode 100644 index 0000000..c5f2263 --- /dev/null +++ b/c++/1_Overview/CPP Program For Call By Value.cpp @@ -0,0 +1,23 @@ +#include + +void doubleIt(int); + +int main () + +{ + int num; + cout << "Enter number: "; + cin >> num; + doubleIt(num); + cout << "The number doubled in main is " << num << endl; + return 0; +} + +void doubleIt (int x) + +{ + cout << "The number to be doubled is " << x << endl; + x *= 2; + cout << "The number doubled in doubleIt is " << x << endl; +} + diff --git a/c++/1_Overview/CPP Program For Constructor Over Loading.cpp b/c++/1_Overview/CPP Program For Constructor Over Loading.cpp new file mode 100644 index 0000000..2f4faba --- /dev/null +++ b/c++/1_Overview/CPP Program For Constructor Over Loading.cpp @@ -0,0 +1,76 @@ +// Step 1: Create the class. + +// Step 2: Declare the constructors with different parameter type and list. + +// Step 3: Create the objects for the Fixed_deposite. + +// Step 4: Object creation automatically call the type matched constructor. + +// Step 5: The matched type constructor procedure will be run. + +// Step 6: Compile and run the program. + +#include +class Fixed_deposite +{ + long int P_amount; + int Years; + float Rate; + float R_value; +public : + Fixed_deposit() {} + Fixed_deposit(long int p, int y,float r=0.12); + Fixed_deposit(long int p,int y,int r); + Void display(void); +}; +Fixed_deposite :: Fixed_deposit (long int p,int y,float r) +{ + P_amount=p; + Years=y; + Rate =r; + R_value=p_amount; + for(int i=1; i<=y; i++) + R_value=R_value * (1.0+r); +} + +Fixed_deposite :: Fixed_deposit (long int p,int y,int r) +{ + P_amount=p; + Years=y; + Rate =r; + R_value=p_amount; + for(int i=1; i<=y; i++) + R_value=R_value * (1.0+float(r)/100); +} + +void Fixed_deposite :: display(void) +{ + cout<<”\n”<<”Principal Amount=”<>p>>y>>R; + FD1 =Fixed_deposite(p,y,R); + cout<<”ENTER amount,period,interest rate(decimal form)”<<”\n”; + cin>>p>>y>>r; + FD2 =Fixed_deposite(p,y,R); + cout<<”Enter the amount and period\n”; + cin>>p>>y; + FD1 =Fixed_deposite(p,y); + cout<<"\nDeposiote"; + FD1.display(); + cout<<"\nDeposiote"; + FD2.display(); + cout<<"\nDeposiote"; + FD3.display(); +return 0: +} + + + diff --git a/c++/1_Overview/CPP Program For Declaring Pointers as Class Member.cpp b/c++/1_Overview/CPP Program For Declaring Pointers as Class Member.cpp new file mode 100644 index 0000000..ebe79ab --- /dev/null +++ b/c++/1_Overview/CPP Program For Declaring Pointers as Class Member.cpp @@ -0,0 +1,34 @@ +// Start the program +// Create the class and declare the data members and member functions +// Declare the pointer and store the address of data in the pointer +// Create the object and call the function in the main program +// Compile and execute the program + +#include + +class c1 + +{ + +public: + + int i; + + c1(int j) + + { + i = j; + } + +}; + +int main() + +{ + c1 ob(1); + int *p; + p = &ob.i; //get address of ob.i + cout<<*p; // access ob.i via p + return 0; +} + diff --git a/c++/1_Overview/CPP Program For Declaring Static Members as Class Member.cpp b/c++/1_Overview/CPP Program For Declaring Static Members as Class Member.cpp new file mode 100644 index 0000000..3937420 --- /dev/null +++ b/c++/1_Overview/CPP Program For Declaring Static Members as Class Member.cpp @@ -0,0 +1,49 @@ +// Start the program +// Create the static class and declare the static data members in the class +// Declare the static member function +// Create the object for the static class +// Pass the static data value when we call the static member function in the main program +// Compile and execute the program + + +#include + +class static_type + +{ + + static int i; + +public: + + static void init(int x) + + { + i = x; + } + + void show() + + { + cout< + +class matrix + +{ + + int a[2][2], b[2][2], c[2][2]; + + void add() + + { +cout<<”Enter the A matrix: + ”<<”\n”; + for(int i=0; i<2; i++) + { + for(int j=0; j<2; j++) + { + cin>>a[i][j]; + } + } +cout<<”Enter the B matrix: + ”<<”\n”; + for(int i=0; i<2; i++) + { + for (int j=0; j<2; j++) + { + cin>>b[i][j]; + } + } + for( i = 0; i< 2; i++) + { + for( j = 0; j<2; j++) + { + c[i][j] = a[i][j] + b[i][j]; + } + } +cout<<”Addition of Two matrixes: + ”< + +#include + +const int IN = 1; + +const int checked_out = 0; + +class book + +{ + + char author[40]; + + char title[40]; + + int status; + +public: + + book(char *n, char *t, int s); + + int get_status() + + { + return status; + } + + void set_status(int s) + + { + status = s; + } + + void show(); + +}; + +book::book(char *n, char *t, int s) + +{ + strcpy(author, n); + strcpy(title, t); + status = s; +} + +void book::show() + +{ + cout< +class loc +{ + int longtitude,latitude; +public: + loc(); + loc(int lg,int lt) + { + longtitude = lg; + latitude=lt; + } + + void show() + { + cout< +#include +class exforsys +{ +private: + int a,b; +public: + void test() + { + a=100; + b=200; + } + friend int compute(exforsys e1) + + + +//Friend Function Declaration with keyword friend and with the object of class exforsys to which it is friend passed to it +}; + + +int compute(exforsys e1) +{ +//Friend Function Definition which has access to private data + return int(e1.a+e1.b-5); +} + +main() +{ + exforsys e; + e.test(); +//Calling of Friend Function with object as argument. + cout<<"The result is:"< +#define SIZE 100 +class stack +{ + int stck[SIZE]; + int tos; +public: + stack(); //constructor + ~stack(); //destructor + void push(int i); + int pop(); +}; + +//stack’s constructor function +stack :: stack() +{ + tos=0; + cout<<”Stack Initialized\n”; +} + +//stacks destructor function +stack :: ~stack() +{ + cout<<”\Stack Destroyed”; +} + +void stack :: push(int i) +{ + if(tos==SIZE) + { + cout<<”Stack is full.\n”; + return; + } + stck[tos] = i; + tos++; +} + + +int stack :: pop () +{ + if(tos==0) + { + cout<<”Stack underflow.\n”; + return; + } + tos--; + return stck[tos]; +} + +int main() +{ + stack a,b; + a. push(1); + b. push(2); + a. push(3); + b. push(4); + cout< + +class myclass + +{ + + int a, b; + +public: + + void init(int i, int j); + + { + a = i; + b = j; + } + + void show(); + + { + cout<<”a=”< + +#include + +int abs(int n); + +double abs(double n); + +int main() + +{ + clrscr(); + cout << "Absolute value of -10: " << abs(-10) << endl; + cout << "Absolute value of -10.01: " << abs(-10.01) << endl; + getch(); + return 0; +} + +int abs(int n) + +{ + cout << "In integer abs()\n"; + return n<0 ? -n : n; +} + +double abs(double n) + +{ + cout << "In double abs()\n"; + return n<0 ? -n : n; +} + + diff --git a/c++/1_Overview/CPP Program To Implement Inheritance.cpp b/c++/1_Overview/CPP Program To Implement Inheritance.cpp new file mode 100644 index 0000000..f3ad059 --- /dev/null +++ b/c++/1_Overview/CPP Program To Implement Inheritance.cpp @@ -0,0 +1,142 @@ +// Step 1: Create the base class building. It has the blue print structure of the buildings. + +// Step 2: Create the derived class house from building class. It extends the buildings properties and also it has its own properties. + +// Step 3: Create the derived class school from building. School as have its unique properties. + +// Step 4: Give the definition to base and derived class methods. + +// Step 5: Create the object for the derived classes school and house . + +// Step 6: Call the member function through the objects. Now derived classes object can call the base class methods also. + +// Step 7: Compile and run. + + +#include +#include +class building +{ + int rooms; + int floors; + int area; +public: + void set_rooms(int num); + int get_rooms(); + void set_floors(int num); + int get_floors(); + void set_area(); + int get_area(); +}; + + +class house : public building +{ + int bedrooms; + int baths; +public: + void set_bedrooms(int num); + int get_bedrooms; + void set_baths(int num); + int get_baths(); +}; + +class school : public building +{ + int classrooms; + int offices; +public: + void set_classrooms(int num); + int get_classrooms(); + void set_offices(int num); + int get_offices(); + +}; + +void building :: set_rooms(int num) +{ + rooms=num; +} + +void building::set_floors(int num) +{ + floors = num; +} + +void building :: set_area(int num) +{ + area=num; +} +int building :: get_rooms() +{ + return rooms; +} + +int building :: get_floors() +{ + returns floors; +} +int building :: get_area() +{ + return area; +} + +void house :: set_bedrooms(int num) +{ + bedrooms = num; +} + +void house ::set_baths(int num) +{ + baths=num; +} + +int house :: get_bedrooms() +{ + return bedrooms; +} +int house::get_baths() +{ + return baths; +} + +void school :: set_classrooms(int num) +{ + classrooms = num; +} +void school :: set_offices(int num) +{ + offices =num; +} + +int school :: get_classrooms() +{ + return classrooms; +} +int school :: get_offices() +{ + return offices; +} + +int main() +{ + house h; + school s; + h.set_rooms(12); + h.set_floors(3); + h.set_area(4500); + h.set_bedrooms(5); + h.set_baths(3); + cout<<"house has" << h.get_bedrooms(); + cout<< "bedrooms\n"; + s.set_rooms(200); + s.classrooms(180); + s.set_offices(5); + s.set_area(25000); + cout<<"school has "< +using namespace std; + +class BaseClass1 +{ + int a; +public: + BaseClass1(int x) + { + a = x; + } + int geta() + { + return a; + } +}; + + +class BaseClass2 +{ + int b; +public: + BaseClass2(int x) + { + b = x; + } + int getb() + { + return b; + } +}; + + +class DerivedClass : public BaseClass1, public BaseClass2 +{ + int c; +public: + DerivedClass(int x, int y, int z) : BaseClass1(z), BaseClass2(y) + { + c = x; + } + + void show() + { + cout << geta() << ' ' << getb() << ' '; + cout << c << '\n'; + } +}; + +int main() +{ + DerivedClass object(1, 2, 3); + object.show(); + return 0; +} + + diff --git a/c++/1_Overview/CPP Program To Implement Pure Virtual Function.cpp b/c++/1_Overview/CPP Program To Implement Pure Virtual Function.cpp new file mode 100644 index 0000000..5281c51 --- /dev/null +++ b/c++/1_Overview/CPP Program To Implement Pure Virtual Function.cpp @@ -0,0 +1,67 @@ +// Step 1: create a base class namely number and declare the pure virtual function show(). + +// Step 2: create the derived classes hextype, dectype & acttype from the class number + +// Step 3: create the objects for the class dectype, hextype and octtype. + +// Step 4: call the member function show(); + +// Step 5: Corresponding called function change the integer type as hex ,oct and decimal . + +// Step 6: Display the values. + +#include +class number +{ +protected: + int val; +public : + void setval(int i) + { + val= i; + } + //show() is a pure virtual function + virtual void show() = 0; +}; + +class hextype : public number +{ +public : + void show () + { + cout< + +#include + +#include + +void main(int argc,char *argv[]) + +{ + char ch; + clrscr(); + if(argc!=3) + { + cout<<"Usage Starting Location\n"; + } + ifstream in(argv[1],ios::in | ios::binary); + if(!in) + { + cout<<"Cannot open a file"; + } + in.seekg(0,ios::beg); + while(in.get(ch)) + cout< + +#include + +int main() + +{ + ifstream in(“INVENTRY”); //input + if(!in) + { + cout<<”Cannot open INVENTRY file”; + return 1; + } + char item[20]; + float cost; + in>>item>>cost; + cout<>item>>cost; + cout<>item>>cost; + cout< + +template + +class MyClass +{ + + T value1, value2; + +public: + + MyClass (T first, T second) + { + value1=first; + value2=second; + } + + T getmax () + + { + T retval; + retval = value1>value2 ? value1 : value2; + return retval; + } + +}; + +int main () + +{ + MyClass myobject (10, 5); + cout << myobject.getmax(); + return 0; +} + + diff --git a/c++/1_Overview/CPP Program To Implement Virtual Functions.cpp b/c++/1_Overview/CPP Program To Implement Virtual Functions.cpp new file mode 100644 index 0000000..1dd55a0 --- /dev/null +++ b/c++/1_Overview/CPP Program To Implement Virtual Functions.cpp @@ -0,0 +1,149 @@ +// Start the program +// Create the base class and declare the data member under protected access specifier and declare the function +// Create the derived class and access the base class data members in the derived class +// Create the object for derived class +// Call the public member function of the derived class +// Compile and run the program + +#include + +#include + +#include + +class Shape +{ + + double width; + + double height; + + char name[20]; + +public: + + Shape() + { + width = height = 0.0; + strcpy(name, "unknown"); + } + + Shape(double w, double h, char *n) + { + width = w; + height = h; + strcpy(name, n); + } + + Shape(double x, char *n) + { + width = height = x; + strcpy(name, n); + } + + void display() + { + cout << "Width and height are " << width << " and " << height << "\n"; + } + + double getWidth() + { + return width; + } + + double getHeight() + { + return height; + } + + void setWidth(double w) + { + width = w; + } + + void setHeight(double h) + { + height = h; + } + + char *getName() + { + return name; + } + + virtual double area() = 0; + +}; + +class Triangle : public Shape +{ + + char style[20]; + +public: + + Triangle() + { + strcpy(style, "unknown"); + } + + Triangle(char *str, double w, double h) : Shape(w, h, "triangle") + { + strcpy(style, str); + } + + Triangle(double x) : Shape(x, "triangle") + { + strcpy(style, "isosceles"); + } + + double area() + { + return getWidth() * getHeight() / 2; + } + + void showStyle() + { + cout << "Triangle is " << style << "\n"; + } + +}; + +class Rectangle : public Shape +{ + +public: + + Rectangle(double w, double h) : Shape(w, h, "rectangle") { } + + Rectangle(double x) : Shape(x, "rectangle") { } + + bool isSquare() + { + if(getWidth() == getHeight()) + return true; + return false; + } + + double area() + { + return getWidth() * getHeight(); + } + +}; + +int main() +{ + Shape *shapes[4]; + shapes[0] = &Triangle("right", 8.0, 12.0); + shapes[1] = &Rectangle(10); + shapes[2] = &Rectangle(10, 4); + shapes[3] = &Triangle(7.0); + for(int i=0; i < 4; i++) + { + cout << "object is " << shapes[i]->getName() << "\n"; + cout << "Area is " << shapes[i]->area() << "\n\n"; + } + return 0; +} + diff --git a/c++/1_Overview/CPP Program To Overriding Template Function.cpp b/c++/1_Overview/CPP Program To Overriding Template Function.cpp new file mode 100644 index 0000000..1db074c --- /dev/null +++ b/c++/1_Overview/CPP Program To Overriding Template Function.cpp @@ -0,0 +1,49 @@ +// Step 1: Declare the template function + +// Step 2: Declare the overload function swap args. + +// Step 3: Call the overloaded function swap args with float arguments. + +// Step 4: Call the overload function swap args with char arguments. + +// Step 5: Display the content. + + + +#include +template void swapargs(X &a,X &b) +{ + X temp; + temp = a; + a=b; + b=temp; + cout<<"Inside the template swapargs"; +} + +void swapargs(int &a,int &b) +{ + int temp; + temp=a; + a=b; + b=temp; + cout<<"Inside swapargs int specialization"; +} + +int main() +{ + int i=0,j=20; + double x=10.1,y=23.3; + char a='x',b='z'; + cout<<"original i,j : "< +#include +#include + +class loc +{ + int longtitude,latitude; +public : + loc() + { + longtitude=latitude=0; + } + loc (int lg,int lt) + { + longtitude=lg; + latitude=lt; + } + void show() + { + cout<< logitude << " "; + cout<< latitude <<"\n"; + } + + void *operator new(size_t size); + void operator delete(void *p); + void *operator new[](size_t size); + void operator delete[](void *p); +}; + +// new overloaded relative to loc + +void *loc :: operator new(size_t size) +{ + void *p; + cout<<"In overloaded new.\n"; + p=malloc(size); + if(!p) + { + bad_alloc ba; + throw ba; + } + return p; +} + +void loc :: operator delete (void *p) +{ + cout<< "In overloaded delete. \n"; + free(p); +} + +//new overloaded for loc arrays. +void *loc :: operator new[](size_t size) +{ + void *p; + cout<<"Using overload new[].\n"; + p=malloc(size); + if(!p) + { + bad_alloc ba; + throw ba; + } + return p; +} + +//delete overloaded for loc arrays. + +void loc :: operator delete[](void *p) +{ + cout<<"Freeing array using overloaded delete[]\n"; + free(p); +} + +int main() +{ + loc *p1,*p2; + int i; + try + { + p1=new loc(10,20); //allocate an object + } + catch (bad_alloc xa) + { + cout<<"Allocation error for p1.\n"; + return 1; + } + try + { + p2=new loc[10]; + } + catch(bad_alloc xa) + { + cout<<"Allocation error for p2 .\n"; + return 1; + } + p1->show(); + for(i=0; i<10; i++) + p2[i].show(); + delete p1; + delete [] p2; + return 0; +} + +// SAMPLE INPUT AND OUTPUT: + +// In overloaded new +// Using overload new[]. + +// 10 20 +// 0 0 +// 0 0 +// 0 0 +// 0 0 +// 0 0 +// 0 0 +// 0 0 +// 0 0 +// 0 0 +// 0 0 +// In overloaded delete. +// Freeing array using overloaded delete. diff --git a/c++/1_Overview/CPP Program to Implement Operator Overloading Including Unary and Binary Operators.cpp b/c++/1_Overview/CPP Program to Implement Operator Overloading Including Unary and Binary Operators.cpp new file mode 100644 index 0000000..9202cac --- /dev/null +++ b/c++/1_Overview/CPP Program to Implement Operator Overloading Including Unary and Binary Operators.cpp @@ -0,0 +1,44 @@ +// Start the program +// Create the class +// Write the function to implement unary +, - and = +// Write the function to implement binary + +// Create the instance and pass the value for the function +// Call the overloaded function and equate it to another object +// Compile and run the program + +#include + +class myclass + +{ + + int a, b; + +public: + + void init(int i, int j); + + { + a = i; + b = j; + } + + void show(); + + { + cout<<”a=”< + +class base + +{ + +protected: + + int i, j; //private to base but accessible to derived + +public: + + void setij(int a, int b) + + { + i = a; + j = b; + } + + void showij() + + { + cout< +using namespace std; + +long long C(int n, int r) +{ + long long f[n + 1]; + f[0] = 1; + for (int i = 1; i <= n; i++) + f[i] = i * f[i - 1]; + return f[n] / f[r] / f[n - r]; +} +//Main +int main() +{ + int n, r, m; + while (1) + { + cout<<"Enter total number of objects:(0 to exit) "; + cin>>n; + if (n == 0) + break; + cout<<"Enter number of objects to be chosen: "; + cin>>r; + cout<<"Number of Combinations: "< +#define ll long long +using namespace std; + +// Matrix C;ass +template +class Matrix +{ +public: + int m, n; + T *data; + Matrix (int m, int n) ; + Matrix (const Matrix &matrix); + const Matrix &operator=(const Matrix &A); + const Matrix operator*(const Matrix &A); + const Matrix operator^(int P); + ~Matrix(); +}; +//Constructor +template +Matrix ::Matrix(int m, int n) +{ + this->m = m; + this->n = n; + data = new T[m * n]; +} +//Constructor +template +Matrix ::Matrix (const Matrix &A) +{ + this->m = A.m; + this->n = A.n; + data = new T[m * n]; + for (int i = 0; i < m * n; i++) + data[i] = A.data[i]; +} +//Destructor +template +Matrix ::~Matrix() +{ + delete [] data; +} + +template +const Matrix &Matrix ::operator=(const Matrix &A) +{ + if (&A != this) + { + delete [] data; + m = A.m; + n = A.n; + data = new T[m * n]; + for (int i = 0; i < m * n; i++) + data[i] = A.data[i]; + } + return *this; +} + +template +const Matrix Matrix ::operator*(const Matrix &A) +{ + Matrix C (m, A.n); + for (int i = 0; i < m; ++i) + { + for (int j = 0; j < A.n; ++j) + { + C.data[i * C.n + j] = 0; + for (int k = 0; k < n; ++k) + C.data[i * C.n + j] = C.data[i * C.n + j] + (data[i * n + k] * A.data[k * A.n + j]); + } + } + return C; +} + +template +const Matrix Matrix ::operator^(int P) +{ + if (P == 1) + return (*this); + if (P & 1) + return (*this) * ((*this) ^ (P - 1)); + Matrix B = (*this) ^ (P/2); + return B * B; +} + +//Compute Combinations +ll C(int n, int r) +{ + Matrix M(r + 1,r + 1); + for (int i = 0; i < (r + 1) * (r + 1); i++) + M.data[i] = 0; + M.data[0] = 1; + for (int i = 1; i < r + 1; i++) + { + M.data[i * (r + 1) + i - 1] = 1; + M.data[i * (r + 1) + i] = 1; + } + return (M ^ n).data[r * (r + 1)]; +} + +//Main +int main() +{ + int n, r, m; + while (1) + { + cout<<"Enter total number of objects:(0 to exit) "; + cin>>n; + if (n == 0) + break; + cout<<"Enter number of objects to be chosen: "; + cin>>r; + cout<<"Number of Combinations: "< +#include +#define ll long long +using namespace std; + +ll C(int n, int r) +{ + vector< vector > C(2, vector (r + 1, 0)); + for (int i = 0; i <= n; i++) + { + for (int k = 0; k <= r && k <= i; k++) + { + if (k == 0 || k == i) + C[i & 1][k] = 1; + else + C[i & 1][k] = (C[(i - 1) & 1][k - 1] + C[(i - 1) & 1][k]); + } + } + return C[n & 1][r]; +} +//Main +int main() +{ + int n,r,m; + while (1) + { + cout<<"Enter total number of objects:(0 to exit) "; + cin>>n; + if (n == 0) + break; + cout<<"Enter number of objects to be chosen: "; + cin>>r; + cout<<"Number of Combinations: "< +#include +using namespace std; +int mSort(int arr[], int temp[], int left, int right); +int merge(int arr[], int temp[], int left, int mid, int right); + +/* + * calls mSort + */ +int mergeSort(int arr[], int array_size) +{ + int *temp = new int [array_size]; + return mSort(arr, temp, 0, array_size - 1); +} + +/* + * sorts the input array and returns the number of inversions in the array. + */ +int mSort(int arr[], int temp[], int left, int right) +{ + int mid, inv_count = 0; + if (right > left) + { + mid = (right + left)/2; + inv_count = mSort(arr, temp, left, mid); + inv_count += mSort(arr, temp, mid+1, right); + inv_count += merge(arr, temp, left, mid+1, right); + } + return inv_count; +} + +/* + * merges two sorted arrays and returns inversion count in the arrays. + */ +int merge(int arr[], int temp[], int left, int mid, int right) +{ + int i, j, k; + int inv_count = 0; + i = left; + j = mid; + k = left; + while ((i <= mid - 1) && (j <= right)) + { + if (arr[i] <= arr[j]) + { + temp[k++] = arr[i++]; + } + else + { + temp[k++] = arr[j++]; + inv_count = inv_count + (mid - i); + } + } + while (i <= mid - 1) + temp[k++] = arr[i++]; + while (j <= right) + temp[k++] = arr[j++]; + for (i = left; i <= right; i++) + arr[i] = temp[i]; + return inv_count; +} + +/* + * Main + */ +int main() +{ + int arr[] = {1, 20, 6, 4, 5}; + cout<<"Number of inversions are "< +#include +#include +using namespace std; +int c = 0; +struct adj_list +{ + int dest; + adj_list *next; +}*np = NULL, *np1 = NULL, *p = NULL, *q = NULL; +struct Graph +{ + int v; + adj_list *ptr; +} array[5]; +void addReverseEdge(int src,int dest) +{ + np1 = new adj_list; + np1->dest = src; + np1->next = NULL; + if (array[dest].ptr == NULL) + { + array[dest].ptr = np1; + q = array[dest].ptr; + q->next = NULL; + } + else + { + q = array[dest].ptr; + while (q->next != NULL) + { + q = q->next; + } + q->next = np1; + } +} +void addEdge(int src,int dest) +{ + np = new adj_list; + np->dest = dest; + np->next = NULL; + if (array[src].ptr == NULL) + { + array[src].ptr = np; + p = array[src].ptr; + p->next = NULL; + } + else + { + p = array[src].ptr; + while (p->next != NULL) + { + p = p->next; + } + p->next = np; + } + addReverseEdge(src,dest); +} +void print_graph(int n) +{ + for (int i = 0; i < n; i++) + { + cout<<"Adjacency List of "<dest<<"\t"; + array[i].ptr = (array[i].ptr)->next; + } + cout<>n; + for (int i = 0; i < n; i++) + { + array[i].v = i; + array[i].ptr = NULL; + } + addEdge(0, 1); + addEdge(0, 4); + addEdge(1, 2); + addEdge(1, 3); + addEdge(1, 4); + addEdge(2, 3); + addEdge(3, 4); + print_graph(n); + getch(); +} + +/* + +Enter the no of vertices +5 +Adjacency List of 0 +1 4 +Adjacency List of 1 +0 2 3 4 +Adjacency List of 2 +1 3 +Adjacency List of 3 +1 2 4 +Adjacency List of 4 +0 1 3 \ No newline at end of file diff --git a/c++/Combinational_Problems/C++ Program to Describe the Representation of Graph using Adjacency Matrix.cpp b/c++/Combinational_Problems/C++ Program to Describe the Representation of Graph using Adjacency Matrix.cpp new file mode 100644 index 0000000..7155cf2 --- /dev/null +++ b/c++/Combinational_Problems/C++ Program to Describe the Representation of Graph using Adjacency Matrix.cpp @@ -0,0 +1,87 @@ +/* + * C++ Program to Describe the Representation of Graph using Adjacency Matrix + */ +#include +#include +#include +using namespace std; +struct node +{ + int from,to; +} a[5], t; +void addEdge(int am[][5],int i,int j,int in) +{ + a[in].from = i; + a[in].to = j; + for (int p = 0; p <= in; p++) + { + for (int q = p + 1; q <= in; q++) + { + if (a[p].from > a[q].from) + { + t = a[p]; + a[p] = a[q]; + a[q] = t; + } + else if (a[p].from == a[q].from) + { + if (a[p].to > a[q].to) + { + t = a[p]; + a[p] = a[q]; + a[q] = t; + } + } + else + { + continue; + } + } + } +} +int main() +{ + int n, c = 0, x, y, ch, i, j; + cout<<"Enter the no of vertices\n"; + cin>>n; + int am[5][5]; + for (int i = 0; i < 5; i++) + { + for (int j = 0; j < 5; j++) + { + am[i][j] = 0; + } + } + while (ch != -1) + { + cout<<"Enter the nodes between which you want to introduce edge\n"; + cin>>x>>y; + addEdge(am,x,y,c); + c++; + cout<<"Press -1 to exit\n"; + cin>>ch; + } + for (int j = 0; j < c; j++) + { + am[a[j].from][j] = 1; + am[a[j].to][j] = 1; + } + for (int i = 0; i < n; i++) + { + for (int j = 0; j < c; j++) + { + cout< +#include +#include +using namespace std; +struct node +{ + int from, to; +} a[5], t; +struct list +{ + int v; + list *next; +}*head[5], *np = NULL, *ptr = NULL; +void addEdge(int am[][5], int i, int j, int in) +{ + a[in].from = i; + a[in].to = j; + for (int p = 0; p <= in; p++) + { + for (int q = p + 1; q <= in; q++) + { + if (a[p].from > a[q].from) + { + t = a[p]; + a[p] = a[q]; + a[q] = t; + } + else if (a[p].from == a[q].from) + { + if (a[p].to > a[q].to) + { + t = a[p]; + a[p] = a[q]; + a[q] = t; + } + } + else + { + continue; + } + } + } +} +void gen_graph(int am[][5]) +{ + int k; + for(int i = 0; i < 5; i++) + { + k = 0; + for(int j = 0; j < 5; j++) + { + if (am[j][i] == 1 && k == 0) + { + np = new list; + np->v = j; + head[i] = np; + ptr = head[i]; + ptr->next = NULL; + k++; + } + else if (am[j][i] == 1 && k != 0) + { + np = new list; + np->v = j; + ptr->next = np; + ptr = ptr->next; + } + } + } +} +void print_graph() +{ + int j; + cout<v<<"\t"; + ptr = ptr->next; + j++; + } + cout<>n; + int am[5][5]; + for (int i = 0; i < 5; i++) + { + for (int j = 0; j < 5; j++) + { + am[i][j] = 0; + } + } + while (ch != -1) + { + cout<<"Enter the nodes between which you want to introduce edge\n"; + cin>>x>>y; + addEdge(am,x,y,c); + c++; + cout<<"Press -1 to exit\n"; + cin>>ch; + } + for (int j = 0; j < c; j++) + { + am[a[j].from][j] = 1; + am[a[j].to][j] = 1; + } + cout<<"Incidence List:"< +#include +using namespace std; + + +int median(int [], int); + +/* + * returns median of ar1[] and ar2[]. + */ +int getMedian(int ar1[], int ar2[], int n) +{ + int m1; + int m2; + if (n <= 0) + return -1; + if (n == 1) + return (ar1[0] + ar2[0]) / 2; + if (n == 2) + return (max(ar1[0], ar2[0]) + min(ar1[1], ar2[1])) / 2; + m1 = median(ar1, n); + m2 = median(ar2, n); + if (m1 == m2) + return m1; + if (m1 < m2) + { + if (n % 2 == 0) + return getMedian(ar1 + n / 2 - 1, ar2, n - n / 2 + 1); + else + return getMedian(ar1 + n / 2, ar2, n - n / 2); + } + else + { + if (n % 2 == 0) + return getMedian(ar2 + n / 2 - 1, ar1, n - n / 2 + 1); + else + return getMedian(ar2 + n / 2, ar1, n - n / 2); + } +} + +/* + * get median of a sorted array + */ +int median(int arr[], int n) +{ + if (n % 2 == 0) + return (arr[n / 2] + arr[n / 2 - 1]) / 2; + else + return arr[n / 2]; +} + +/* + * Main + */ +int main() +{ + int ar1[] = {1, 2, 3, 6}; + int ar2[] = {4, 6, 8, 10}; + int n1 = sizeof(ar1)/sizeof(ar1[0]); + int n2 = sizeof(ar2)/sizeof(ar2[0]); + if (n1 == n2) + cout<<"Median is "< +#include +using namespace std; +void min_heapify(int *a, int i, int n) +{ + int j, temp; + temp = a[i]; + j = 2 * i; + while (j <= n) + { + if (j < n && a[j+1] < a[j]) + j = j + 1; + if (temp < a[j]) + break; + else if (temp >= a[j]) + { + a[j / 2] = a[j]; + j = 2 * j; + } + } + a[j / 2] = temp; + return; +} +void build_minheap(int *a, int n) +{ + int i; + for(i = n / 2; i >= 1; i--) + { + min_heapify(a, i, n); + } +} +int main() +{ + int n, i, x; + cout<<"enter no of elements of array\n"; + cin>>n; + int a[20]; + for (i = 1; i <= n; i++) + { + cout<<"enter element"<<(i)<>a[i]; + } + build_minheap(a, n); + cout<<"Minimum element is "< +#include +#include +using namespace std; +void swap (char *x, char *y) +{ + char temp; + temp = *x; + *x = *y; + *y = temp; +} +void permute(char *a, int i, int n) +{ + int j; + if (i == n) + { + cout< +#include +using namespace std; +int first(int arr[], int low, int high, int x, int n) +{ + if (high >= low) + { + int mid = (low + high) / 2; + if (( mid == 0 || x > arr[mid - 1]) && arr[mid] == x) + { + return mid; + } + else if (x > arr[mid]) + { + return first(arr, (mid + 1), high, x, n); + } + else + { + return first(arr, low, (mid - 1), x, n); + } + } + return -1; +} +int last(int arr[], int low, int high, int x, int n) +{ + if (high >= low) + { + int mid = (low + high) / 2; + if (( mid == n - 1 || x < arr[mid + 1]) && arr[mid] == x ) + { + return mid; + } + else if (x < arr[mid]) + { + return last(arr, low, (mid - 1), x, n); + } + else + { + return last(arr, (mid + 1), high, x, n); + } + } + return -1; +} +int count(int arr[], int x, int n) +{ + int i; + int j; + i = first(arr, 0, n - 1, x, n); + if (i == -1) + { + return i; + } + j = last(arr, i, n - 1, x, n); + return j - i + 1; +} +int main() +{ + int n, i, x, arr[10]; + cout<<"enter the number of elements\n"; + cin>>n; + for (i = 0; i < n; i++) + { + cout<<"enter element\n"; + cin>>arr[i]; + } + cout<<"enter the element whose number of occurences to be found\n"; + cin>>x; + int c = count(arr, x, n); + cout< +#include +#include +using namespace std; +int main() +{ + int n, sum = 0, ret = 0; + cout<<"enter the number of values of array\n"; + cin>>n; + int a[n]; + cout<<"enter the values present in array\n"; + for (int i = 0; i < n; i++) + { + cin>>a[i]; + } + for (int i = 0; i <= n-2; i++) + { + sum = 0; + for (int j = i + 1; j <= n - 1; j++) + { + sum = sum + a[j]; + if (sum > ret) + { + ret = sum; + } + } + } + cout<<"Maximum subarray sum:"< +#include +#include +using namespace std; +int main() +{ + int n, sum = 0, ret = 0; + cout<<"enter the number of values of array\n"; + cin>>n; + int a[n]; + cout<<"enter the values present in array\n"; + for (int i = 0; i < n; i++) + { + cin>>a[i]; + } + for (int i = 0; i <= n-2; i++) + { + sum = 0; + for (int j = i + 1; j <= n - 1; j++) + { + sum = sum + a[j]; + if (sum > ret) + { + ret = sum; + } + } + } + cout<<"Maximum subarray sum:"< +#include +#include +using namespace std; +int min(int a, int b) +{ + int x; + if (a < b) + { + return a; + } + else + { + return b; + } +} +int max(int a, int b) +{ + int x; + if (a > b) + { + return a; + } + else + { + return b; + } +} +int getMedian(int *ar1, int *ar2, int n) +{ + int x, i, j; + if (n == 1) + { + x = (max(ar1[0], ar2[0]) + min(ar1[1], ar2[1]))/2; + cout<<"\n"< ar2[i]) + { + for (j = 0; j <= i; j++) + { + temp1[j] = ar1[j]; + temp2[j] = ar2[i + j]; + } + } + getMedian(temp1, temp2, i); + } +} +int main() +{ + int i, x, j; + cout<<"enter the no of elements to be entered\n"; + cin>>i; + int *ar1 = new int[i]; + int *ar2 = new int[i]; + cout<<"enter elements of array 1"<>ar1[j]; + } + cout<<"enter elements of array 2"<>ar2[j]; + } + getMedian(ar1, ar2, i); + getch(); +} + +/* + +enter the no of elements to be entered +5 +enter elements of array 1 +1 +2 +15 +26 +38 +enter elements of array 2 +2 +13 +17 +30 +45 + +16 \ No newline at end of file diff --git a/c++/Combinational_Problems/C++ Program to Find the peak element of an array using Binary Search approach.cpp b/c++/Combinational_Problems/C++ Program to Find the peak element of an array using Binary Search approach.cpp new file mode 100644 index 0000000..6521029 --- /dev/null +++ b/c++/Combinational_Problems/C++ Program to Find the peak element of an array using Binary Search approach.cpp @@ -0,0 +1,72 @@ +/* + * C++ Program to Find the peak element of an array using Binary Search approach + */ + +#include +#include +using namespace std; +void max_heapify(int *a, int i, int n) +{ + int j, temp; + temp = a[i]; + j = 2 * i; + while (j <= n) + { + if (j < n && a[j + 1] > a[j]) + j = j + 1; + if (temp > a[j]) + break; + else if (temp <= a[j]) + { + a[j / 2] = a[j]; + j = 2 * j; + } + } + a[j / 2] = temp; + return; +} +void build_maxheap(int *a, int n) +{ + int i; + for(i = n / 2; i >= 1; i--) + { + max_heapify(a, i, n); + } +} +int main() +{ + int n, i, x; + cout<<"enter no of elements of array\n"; + cin>>n; + int a[20]; + for (i = 1; i <= n; i++) + { + cout<<"enter element"<<(i)<>a[i]; + } + build_maxheap(a, n); + cout<<"Maximum element is "< +#include +#include +#include +using namespace std; + +/* swap values at two pointers */ +void swap (char *x, char *y) +{ + char temp; + temp = *x; + *x = *y; + *y = temp; +} + +/* print permutations of string */ +void permute(char *a, int i, int n) +{ + int j; + if (i == n) + cout< +using namespace std; +/* + * print an array p[] of size 'n' + */ +void printArray(int p[], int n) +{ + for (int i = 0; i < n; i++) + cout << p[i] << " "; + cout << endl; +} + +void printAllUniqueParts(int n) +{ + int p[n]; + int k = 0; + p[k] = n; + while (true) + { + printArray(p, k + 1); + int rem_val = 0; + while (k >= 0 && p[k] == 1) + { + rem_val += p[k]; + k--; + } + if (k < 0) + return; + p[k]--; + rem_val++; + while (rem_val > p[k]) + { + p[k+1] = p[k]; + rem_val = rem_val - p[k]; + k++; + } + p[k+1] = rem_val; + k++; + } +} + +/* + * Main + */ +int main() +{ + int value; + while(1) + { + cout<<"Enter an Integer(0 to exit): "; + cin>>value; + if (value == 0) + break; + cout << "All Unique Partitions of "< +using namespace std; + +//Bubble Sort +void bubble_sort (int arr[], int n) +{ + for (int i = 0; i < n; ++i) + for (int j = 0; j < n - i - 1; ++j) + if (arr[j] > arr[j + 1]) + { + int temp = arr[j]; + arr[j] = arr[j + 1]; + arr[j + 1] = temp; + } +} + +//Driver Function +int main() +{ + int input_ar[] = {10, 50, 21, 2, 6, 66, 802, 75, 24, 170}; + int n = sizeof (input_ar) / sizeof (input_ar[0]); + bubble_sort (input_ar, n); + cout << "Sorted Array : " << endl; + for (int i = 0; i < n; ++i) + cout << input_ar[i] << " "; + return 0; +} + +/* +Sorted Array : +2 6 10 21 24 50 66 75 170 802 \ No newline at end of file diff --git a/c++/Combinational_Problems/C++ Program to Implement Bucket Sort.cpp b/c++/Combinational_Problems/C++ Program to Implement Bucket Sort.cpp new file mode 100644 index 0000000..b17b641 --- /dev/null +++ b/c++/Combinational_Problems/C++ Program to Implement Bucket Sort.cpp @@ -0,0 +1,53 @@ +/*This C++ Program implements Bucket Sort Algorithm. +Bucket sort is a sorting algorithm. It partitions an array into number of buckets, sorting each bucket individually using any good sorting algorithm and then concatenating each bucket. + +The basic steps of Bucket Sort are : +1. Set up buckets +2. Scatter original array +3. Sort each bucket +4. Gather all elements + +Bucket sort excepts it’s input in a specific range. The size of bucket should be taken as 1 greater than the largest element in the bucket. + +It’s worst case time complexity is O(n^2) and space complexity is O(n.m), which occurs when every element of input array is in one bucket. Average case time complexity is O(n + m), m is the number of buckets.*/ + +//This is a C++ Program to Sort an Array using Bucket Sort +#include +using namespace std; + +//Bucket Sort +void bucket_sort (int arr[], int n) +{ + //Here range is [1,100] + int m = 101; + //Create m empty buckets + int buckets[m]; + //Intialize all buckets to 0 + for (int i = 0; i < m; ++i) + buckets[i] = 0; + //Increment the number of times each element is present in the input + //array. Insert them in the buckets + for (int i = 0; i < n; ++i) + ++buckets[arr[i]]; + //Sort using insertion sort and concatenate + for (int i = 0, j = 0; j < m; ++j) + for (int k = buckets[j]; k > 0; --k) + arr[i++] = j; +} + + +//Driver function to test above function +int main() +{ + int input_ar[] = {10, 24, 22, 62, 1, 50, 100, 75, 2, 3}; + int n = sizeof (input_ar) / sizeof (input_ar[0]); + bucket_sort (input_ar, n); + cout << "Sorted Array : " << endl; + for (int i = 0; i < n; ++i) + cout << input_ar[i] << " "; + return 0; +} + +/* +Sorted Array : +1 2 3 10 22 24 50 62 75 100 \ No newline at end of file diff --git a/c++/Combinational_Problems/C++ Program to Implement Heap Sort.cpp b/c++/Combinational_Problems/C++ Program to Implement Heap Sort.cpp new file mode 100644 index 0000000..a0b0b1d --- /dev/null +++ b/c++/Combinational_Problems/C++ Program to Implement Heap Sort.cpp @@ -0,0 +1,92 @@ +/* + * C++ Program to Implement Heap Sort + */ +#include +#include +using namespace std; +void max_heapify(int *a, int i, int n) +{ + int j, temp; + temp = a[i]; + j = 2*i; + while (j <= n) + { + if (j < n && a[j+1] > a[j]) + j = j+1; + if (temp > a[j]) + break; + else if (temp <= a[j]) + { + a[j/2] = a[j]; + j = 2*j; + } + } + a[j/2] = temp; + return; +} +void heapsort(int *a, int n) +{ + int i, temp; + for (i = n; i >= 2; i--) + { + temp = a[i]; + a[i] = a[1]; + a[1] = temp; + max_heapify(a, 1, i - 1); + } +} +void build_maxheap(int *a, int n) +{ + int i; + for(i = n/2; i >= 1; i--) + { + max_heapify(a, i, n); + } +} +int main() +{ + int n, i, x; + cout<<"enter no of elements of array\n"; + cin>>n; + int a[20]; + for (i = 1; i <= n; i++) + { + cout<<"enter element"<<(i)<>a[i]; + } + build_maxheap(a,n); + heapsort(a, n); + cout<<"sorted output\n"; + for (i = 1; i <= n; i++) + { + cout< +#include +using namespace std; +int main() +{ + int a[16], i, j, k, temp; + cout<<"enter the elements\n"; + for (i = 0; i < 16; i++) + { + cin>>a[i]; + } + for (i = 1; i < 16; i++) + { + for (j = i; j >= 1; j--) + { + if (a[j] < a[j-1]) + { + temp = a[j]; + a[j] = a[j-1]; + a[j-1] = temp; + } + else + break; + } + } + cout<<"sorted array\n"< +#include +#include +using namespace std; +/* + * Node Declaration + */ +struct node +{ + int data; + struct node* next; +}; + + +struct node* SortedMerge(node* a, node* b); +void FrontBackSplit(node* source, node** frontRef, node** backRef); + +/* sorts the linked list by changing next pointers (not data) */ +void MergeSort(struct node** headRef) +{ + node* head = *headRef; + node* a; + node* b; + if ((head == NULL) || (head->next == NULL)) + { + return; + } + FrontBackSplit(head, &a, &b); + MergeSort(&a); + MergeSort(&b); + *headRef = SortedMerge(a, b); +} +/* merge the sorted linked lists */ +node* SortedMerge(struct node* a, struct node* b) +{ + node* result = NULL; + if (a == NULL) + return b; + else if (b==NULL) + return a; + if (a->data <= b->data) + { + result = a; + result->next = SortedMerge(a->next, b); + } + else + { + result = b; + result->next = SortedMerge(a, b->next); + } + return result; +} + +/* Split the nodes of the given list into front and back halves*/ +void FrontBackSplit(node* source, node** frontRef, node** backRef) +{ + node* fast; + node* slow; + if (source==NULL || source->next==NULL) + { + *frontRef = source; + *backRef = NULL; + } + else + { + slow = source; + fast = source->next; + while (fast != NULL) + { + fast = fast->next; + if (fast != NULL) + { + slow = slow->next; + fast = fast->next; + } + } + *frontRef = source; + *backRef = slow->next; + slow->next = NULL; + } +} + +/* print nodes in a given linked list */ +void printList(node *node) +{ + while (node != NULL) + { + cout<data<next; + } +} + +/* insert a node at the beginging of the linked list */ +void push(node** head_ref, int new_data) +{ + node *new_node = new node; + new_node->data = new_data; + new_node->next = (*head_ref); + (*head_ref) = new_node; +} +/* Main */ +int main() +{ + node* res = NULL; + node* a = NULL; + push(&a, 15); + push(&a, 10); + push(&a, 5); + push(&a, 20); + push(&a, 3); + push(&a, 2); + MergeSort(&a); + cout<<"\n Sorted Linked List is: \n"; + printList(a); + return 0; +} + +/* +Sorted Linked List is: +2 +3 +5 +10 +15 +20 diff --git a/c++/Combinational_Problems/C++ Program to Implement Merge Sort.cpp b/c++/Combinational_Problems/C++ Program to Implement Merge Sort.cpp new file mode 100644 index 0000000..cc3a6f1 --- /dev/null +++ b/c++/Combinational_Problems/C++ Program to Implement Merge Sort.cpp @@ -0,0 +1,181 @@ +/* + * C++ Program to Implement Merge Sort + */ +#include +using namespace std; +#include +void merge(int *,int, int, int ); +void mergesort(int *a, int low, int high) +{ + int mid; + if (low < high) + { + mid=(low+high)/2; + mergesort(a,low,mid); + mergesort(a,mid+1,high); + merge(a,low,high,mid); + } + return; +} +void merge(int *a, int low, int high, int mid) +{ + int i, j, k, c[50]; + i = low; + k = low; + j = mid + 1; + while (i <= mid && j <= high) + { + if (a[i] < a[j]) + { + c[k] = a[i]; + k++; + i++; + } + else + { + c[k] = a[j]; + k++; + j++; + } + } + while (i <= mid) + { + c[k] = a[i]; + k++; + i++; + } + while (j <= high) + { + c[k] = a[j]; + k++; + j++; + } + for (i = low; i < k; i++) + { + a[i] = c[i]; + } +} +int main() +{ + int a[20], i, b[20]; + cout<<"enter the elements\n"; + for (i = 0; i < 5; i++) + { + cin>>a[i]; + } + mergesort(a, 0, 4); + cout<<"sorted array\n"; + for (i = 0; i < 5; i++) + { + cout<>b[i]; + } + mergesort(b, 0, 4); + cout<<"sorted array\n"; + for (i = 0; i < 5; i++) + { + cout< + using namespace std; +#include + void merge(int *,int, int, int ); + void mergesort(int *a, int low, int high) + { + int mid; + if (low < high) + { + mid=(low+high)/2; + mergesort(a,low,mid); + mergesort(a,mid+1,high); + merge(a,low,high,mid); + } + return; + } + void merge(int *a, int low, int high, int mid) + { + int i, j, k, c[50]; + i = low; + k = low; + j = mid + 1; + while (i <= mid && j <= high) + { + if (a[i] < a[j]) + { + c[k] = a[i]; + k++; + i++; + } + else + { + c[k] = a[j]; + k++; + j++; + } + } + while (i <= mid) + { + c[k] = a[i]; + k++; + i++; + } + while (j <= high) + { + c[k] = a[j]; + k++; + j++; + } + for (i = low; i < k; i++) + { + a[i] = c[i]; + } + } + int main() + { + int a[20], i, b[20]; + cout<<"enter the elements\n"; + for (i = 0; i < 5; i++) + { + cin>>a[i]; + } + mergesort(a, 0, 4); + cout<<"sorted array\n"; + for (i = 0; i < 5; i++) + { + cout<>b[i]; + } + mergesort(b, 0, 4); + cout<<"sorted array\n"; + for (i = 0; i < 5; i++) + { + cout< +#include +using namespace std; +/* + * get maximum value in arr[] + */ +int getMax(int arr[], int n) +{ + int max = arr[0]; + for (int i = 1; i < n; i++) + if (arr[i] > max) + max = arr[i]; + return max; +} +/* + * count sort of arr[] + */ +void countSort(int arr[], int n, int exp) +{ + int output[n]; + int i, count[10] = {0}; + for (i = 0; i < n; i++) + count[(arr[i] / exp) % 10]++; + for (i = 1; i < 10; i++) + count[i] += count[i - 1]; + for (i = n - 1; i >= 0; i--) + { + output[count[(arr[i] / exp) % 10] - 1] = arr[i]; + count[(arr[i] / exp) % 10]--; + } + for (i = 0; i < n; i++) + arr[i] = output[i]; +} +/* + * sorts arr[] of size n using Radix Sort + */ +void radixsort(int arr[], int n) +{ + int m = getMax(arr, n); + for (int exp = 1; m / exp > 0; exp *= 10) + countSort(arr, n, exp); +} + +/* + * Main + */ +int main() +{ + int arr[] = {170, 45, 75, 90, 802, 24, 2, 66}; + int n = sizeof(arr)/sizeof(arr[0]); + radixsort(arr, n); + for (int i = 0; i < n; i++) + cout << arr[i] << " "; + return 0; +} + +/* +2 24 45 66 75 90 170 802 + +------------------ +(program exited with code: 1) +Press return to continue \ No newline at end of file diff --git a/c++/Combinational_Problems/C++ Program to Implement Selection Sort.cpp b/c++/Combinational_Problems/C++ Program to Implement Selection Sort.cpp new file mode 100644 index 0000000..1cf4a5f --- /dev/null +++ b/c++/Combinational_Problems/C++ Program to Implement Selection Sort.cpp @@ -0,0 +1,62 @@ +/*This C++ Program implements Selection Sort Algorithm. +Selection sort is a in-place comparison sort. The sorted array is built from left to right. The algorithm finds the the index value or position of the minimum element present in the array. Initially it assume the first element of the array. Then it loops over the array and find if present the index or position of value less than the minimum taken previously. After this it swaps those values, giving us the output in sorted order + +It’s time complexity is O(n^2) with theta (n) swaps.*/ + +//This is a C++ Program to Sort an Array using Selection Sort + +#include +using namespace std; + +void print (int [], int); +void selection_sort (int [], int); + +//Driver Function +int main () +{ + int min_ele_loc; + int ar[] = {10, 2, 45, 18, 16, 30, 29, 1, 1, 100}; + cout << "Array initially : "; + print (ar, 10); + selection_sort (ar, 10); + cout << "Array after selection sort : "; + print (ar, 10); + return 0; +} + +// Selection Sort +void selection_sort (int ar[], int size) +{ + int min_ele_loc; + for (int i = 0; i < 9; ++i) + { + //Find minimum element in the unsorted array + //Assume it's the first element + min_ele_loc = i; + //Loop through the array to find it + for (int j = i + 1; j < 10; ++j) + { + if (ar[j] < ar[min_ele_loc]) + { + //Found new minimum position, if present + min_ele_loc = j; + } + } + //Swap the values + swap (ar[i], ar[min_ele_loc]); + } +} + +//Print the array +void print (int temp_ar[], int size) +{ + for (int i = 0; i < size; ++i) + { + cout << temp_ar[i] << " "; + } + cout << endl; +} + +/* +Array intially : 10 2 45 18 16 30 29 1 1 100 +Array after selection sort : 1 1 2 10 16 18 29 30 45 100 \ No newline at end of file diff --git a/c++/Combinational_Problems/C++ Program to Implement Shell Sort.cpp b/c++/Combinational_Problems/C++ Program to Implement Shell Sort.cpp new file mode 100644 index 0000000..6f139fc --- /dev/null +++ b/c++/Combinational_Problems/C++ Program to Implement Shell Sort.cpp @@ -0,0 +1,64 @@ +/*This C++ Program implements Shell Sort Algorithm. +Shell sort is a sorting algorithm. It is an in-place comparison sort and one of the oldest sorting algorithm. +Shell sort is a generalization of insertion sort that allows the exchange of items that are far apart. Shell sort is not stable sort. It takes O(1) extra space. The worst case time complexity of shell sort depends on the increment sequence. + +Shell sort steps are : +1. Compare elements that are far apart. +2. Compare elements that are less far apart. Narrower array. +3. Do this repeatedly, reach to a point where compare adjancent elements. +4. Now the elements will be sufficiently sorted that the running time of the final stage will be closer to O(N). + +It is also called diminishing increment sort. + +The program has an input array of size 10 initialized with 10 values. This returns the array in non decreasing order using Shell Sort algorithm.*/ + +//This is a C++ Program to Sort an Array using Shell Sort +#include +using namespace std; + +//Print values +void print_ar (int ar[], int size) +{ + for (int i = 0; i < size; ++i) + { + cout << ar[i] << " "; + } + cout << endl; +} + +//Shell sort function +void shell_sort (int ar[], int size) +{ + int j; + //Narrow the array by 2 everytime + for (int gap = size / 2; gap > 0; gap /= 2) + { + for (int i = gap; i < size; ++i) + { + int temp = ar[i]; + for (j = i; j >= gap && temp < ar[j - gap]; j -= gap) + { + ar[j] = ar[j - gap]; + } + ar[j] = temp; + } + } +} + +//Driver Functions +int main () +{ + int ar[] = {1, 4, 16, 30, 29, 18, 100, 2, 43, 1}; + cout << "Intial Array : "; + print_ar (ar, 10); + shell_sort (ar, 10); + cout << "Sorted Array : "; + print_ar (ar, 10); + return 0; +} + +/* + + +Intial Array : 1 4 16 30 29 18 100 2 43 1 +Sorted Array : 1 1 2 4 16 18 29 30 43 100 \ No newline at end of file diff --git a/c++/Combinational_Problems/C++ Program to Solve Palindrome Partitioning Problem.cpp b/c++/Combinational_Problems/C++ Program to Solve Palindrome Partitioning Problem.cpp new file mode 100644 index 0000000..2d5a915 --- /dev/null +++ b/c++/Combinational_Problems/C++ Program to Solve Palindrome Partitioning Problem.cpp @@ -0,0 +1,64 @@ +/* + * C++ Program to Solve Palindrome Partitioning Problem + */ +#include +#include +#include +#include +#include +#include +using namespace std; + +// get minimum of two integers +int min (int a, int b) +{ + return (a < b)? a : b; +} + +/* Returns the minimum number of cuts needed to partition a string + * such that every part is a palindrome + */ +int minPalPartion(char *str) +{ + int n = strlen(str); + int C[n][n]; + bool P[n][n]; + int i, j, k, L; + for (i = 0; i < n; i++) + { + P[i][i] = true; + C[i][i] = 0; + } + for (L = 2; L <= n; L++) + { + for (i = 0; i < n - L + 1; i++) + { + j = i + L - 1; + if (L == 2) + P[i][j] = (str[i] == str[j]); + else + P[i][j] = (str[i] == str[j]) && P[i + 1][j - 1]; + if (P[i][j] == true) + C[i][j] = 0; + else + { + C[i][j] = INT_MAX; + for (k = i; k <= j - 1; k++) + C[i][j] = min (C[i][j], C[i][k] + C[k + 1][j] + 1); + } + } + } + return C[0][n-1]; +} + +// Main +int main() +{ + char str[] = "ababbbabbababa"; + cout<<"Min cuts needed for Palindrome Partitioning is: "< +#include +#include +using namespace std; +int main() +{ + int n, x; + cout<<"\nEnter the No. of Disks: "; + cin>>n; + for (x = 1; x < (1 << n); x++) + { + printf("\nMove from Peg %i to Peg %i", (x&x-1)%3+1, ((x|x-1)+1)%3+1); + } + cout<<"\n"; + getch(); +} + +/* +Move from Peg 1 to Peg 3 +Move from Peg 1 to Peg 2 +Move from Peg 3 to Peg 2 +Move from Peg 1 to Peg 3 +Move from Peg 2 to Peg 1 +Move from Peg 2 to Peg 3 +Move from Peg 1 to Peg 3 +Move from Peg 1 to Peg 2 +Move from Peg 3 to Peg 2 +Move from Peg 3 to Peg 1 +Move from Peg 2 to Peg 1 +Move from Peg 3 to Peg 2 +Move from Peg 1 to Peg 3 +Move from Peg 1 to Peg 2 +Move from Peg 3 to Peg 2 \ No newline at end of file diff --git a/c++/Combinational_Problems/Linked List Representation of Linear Queue.cpp b/c++/Combinational_Problems/Linked List Representation of Linear Queue.cpp new file mode 100644 index 0000000..f29ec47 --- /dev/null +++ b/c++/Combinational_Problems/Linked List Representation of Linear Queue.cpp @@ -0,0 +1,81 @@ + + + #include + #include + using namespace std; + struct node { + int + data; + struct + node *next; + } + *front=NULL,*rear,*temp; + void ins() { + temp=new + node; + cout<<“Enter + data:”; + cin>>temp->data; + temp->next=NULL; + if(front==NULL) + front=rear=temp; + else { + rear->next=temp; + rear=temp; + } + cout<<“Node + has been insertedn”; + } + void del() { + if(front==NULL) + cout<<“Queue + is emptyn”; else { + temp=front; + front=front->next; + cout<<“Deleted + node is “<data<<“n”; + delete(temp); + } + } + void dis() { + if(front==NULL) + cout<<“Queue + is emptyn”; else { + temp=front; + while(temp->next!=NULL) { + cout<data<<“->”; + temp=temp->next; + } + cout<data; + } + } + main() { + int ch; + while(1) { + cout<<“n*** + Menu ***”<<“n1.Insertn2.Deleten3.Displayn4.Exit”; + cout<<“nnEnter + your choice(1-4):”; + cin>>ch; + cout<<“n”; + switch(ch) { + case + 1: ins(); + break; + case + 2: del(); + break; + case + 3: dis(); + break; + case + 4: exit(0); + break; + default: + cout<<“Wrong Choice!!!”; + } + } + return + 0; + } + diff --git a/c++/Combinational_Problems/perform a PUSH operation on a dynamically allocated stack.cpp b/c++/Combinational_Problems/perform a PUSH operation on a dynamically allocated stack.cpp new file mode 100644 index 0000000..f29ec47 --- /dev/null +++ b/c++/Combinational_Problems/perform a PUSH operation on a dynamically allocated stack.cpp @@ -0,0 +1,81 @@ + + + #include + #include + using namespace std; + struct node { + int + data; + struct + node *next; + } + *front=NULL,*rear,*temp; + void ins() { + temp=new + node; + cout<<“Enter + data:”; + cin>>temp->data; + temp->next=NULL; + if(front==NULL) + front=rear=temp; + else { + rear->next=temp; + rear=temp; + } + cout<<“Node + has been insertedn”; + } + void del() { + if(front==NULL) + cout<<“Queue + is emptyn”; else { + temp=front; + front=front->next; + cout<<“Deleted + node is “<data<<“n”; + delete(temp); + } + } + void dis() { + if(front==NULL) + cout<<“Queue + is emptyn”; else { + temp=front; + while(temp->next!=NULL) { + cout<data<<“->”; + temp=temp->next; + } + cout<data; + } + } + main() { + int ch; + while(1) { + cout<<“n*** + Menu ***”<<“n1.Insertn2.Deleten3.Displayn4.Exit”; + cout<<“nnEnter + your choice(1-4):”; + cin>>ch; + cout<<“n”; + switch(ch) { + case + 1: ins(); + break; + case + 2: del(); + break; + case + 3: dis(); + break; + case + 4: exit(0); + break; + default: + cout<<“Wrong Choice!!!”; + } + } + return + 0; + } + diff --git a/c++/Computational_Geometry/C++ Program to Apply Above-Below-on Test to Find the Position of a Point with respect to a Line.cpp b/c++/Computational_Geometry/C++ Program to Apply Above-Below-on Test to Find the Position of a Point with respect to a Line.cpp new file mode 100644 index 0000000..69c04ad --- /dev/null +++ b/c++/Computational_Geometry/C++ Program to Apply Above-Below-on Test to Find the Position of a Point with respect to a Line.cpp @@ -0,0 +1,54 @@ +/*This is a C++ Program to check whether point lies above, below or on the line. For any point t (xt, yt) on the plane, its position with respect to the line L connecting p and q is found by calculating the scalar s: +s = A xt + B yt + C +If s < 0, t lies in the clockwise halfplane of L; if s > 0, t lies on the counter-clockwise halfplane; if s = 0, t lies on L. +For example, the equation of the line connecting points (2, 2) and (4, 5) is -3x + 2y + 2 = 0. The point (6, 3) lies in the clockwise halfplane of this line, because (-3)(6) + (2)(3) + 2 = -10. Conversely, the point (0, 5) lies in the other halfplane as (-3)(0) +(2)(5) +2 = 12.*/ + +#include +#include +#include +#include + +using namespace std; +const int LOW = 0; +const int HIGH = 10; +int main(int argc, char **argv) +{ + time_t seconds; + time(&seconds); + srand((unsigned int) seconds); + int x1, x2, y1, y2; + x1 = rand() % (HIGH - LOW + 1) + LOW; + x2 = rand() % (HIGH - LOW + 1) + LOW; + y1 = rand() % (HIGH - LOW + 1) + LOW; + y2 = rand() % (HIGH - LOW + 1) + LOW; + cout << "The Equation of the 1st line is : (" << (y2 - y1) << ")x+(" << (x1 + - x2) << ")y+(" << (x2 * y1 - x1 * y2) << ") = 0\n"; + int x, y; + cout << "\nEnter the point:"; + cin >> x; + cin >> y; + int s = (y2 - y1) * x + (x1 - x2) * y + (x2 * y1 - x1 * y2); + if (s < 0) + cout << "The point lies below the line or left side of the line"; + else if (s > 0) + cout << "The point lies above the line or right side of the line"; + else + cout << "The point lies on the line"; + return 0; +} + +/* +The Equation of the 1st line is : (3)x+(0)y+(-3) = 0 + +Enter the point:1 4 +The point lies on the line + +The Equation of the 1st line is : (5)x+(-1)y+(-25) = 0 + +Enter the point:1 1 +The point lies below the line or left side of the line + +The Equation of the 1st line is : (-6)x+(8)y+(-24) = 0 + +Enter the point:19 21 +The point lies above the line or right side of the line \ No newline at end of file diff --git a/c++/Computational_Geometry/C++ Program to Check Whether a Given Points are Colinear or Not.cpp b/c++/Computational_Geometry/C++ Program to Check Whether a Given Points are Colinear or Not.cpp new file mode 100644 index 0000000..b9040d3 --- /dev/null +++ b/c++/Computational_Geometry/C++ Program to Check Whether a Given Points are Colinear or Not.cpp @@ -0,0 +1,38 @@ +#include +#include +#include + +using namespace std; + +const int LOW = 1; +const int HIGH = 10; + +int main(int argc, char **argv) +{ + int x, y, x1, x2, y1, y2; + time_t seconds; + time(&seconds); + srand((unsigned int) seconds); + x = rand() % (HIGH - LOW + 1) + LOW; + y = rand() % (HIGH - LOW + 1) + LOW; + x1 = rand() % (HIGH - LOW + 1) + LOW; + x2 = rand() % (HIGH - LOW + 1) + LOW; + y1 = rand() % (HIGH - LOW + 1) + LOW; + y2 = rand() % (HIGH - LOW + 1) + LOW; + cout << "The points are: (" << x << ", " << y << "), (" << x1 << ", " << y1 + << "), & (" << x2 << ", " << y2 << ")\n"; + cout << "The Equation of the line is : (" << (y2 - y1) << ")x+(" << (x1 + - x2) << ")y+(" << (x2 * y1 - x1 * y2) << ") = 0\n"; + int s = (y2 - y1) * x + (x1 - x2) * y + (x2 * y1 - x1 * y2); + if (s < 0) + cout << "The points are NOT colinear"; + else if (s > 0) + cout << "The points are NOT colinear"; + else + cout << "The points are colinear"; +} + +/* +The points are: (9, 5), (4, 6), & (1, 2) +The Equation of the line is : (-4)x+(3)y+(-2) = 0 +The points are NOT colinear \ No newline at end of file diff --git a/c++/Computational_Geometry/C++ Program to Check if a Point d lies Inside or Outside a Circle Defined by Points a, b, c in a Plane.cpp b/c++/Computational_Geometry/C++ Program to Check if a Point d lies Inside or Outside a Circle Defined by Points a, b, c in a Plane.cpp new file mode 100644 index 0000000..abdc1a9 --- /dev/null +++ b/c++/Computational_Geometry/C++ Program to Check if a Point d lies Inside or Outside a Circle Defined by Points a, b, c in a Plane.cpp @@ -0,0 +1,62 @@ +/*This is a C++ Program to Check if a Point d lies Inside or Outside a Circle Defined by Points a, b, c in a Plane. For any point t (xt, yt) on the plane, its position with respect to the circle defined by 3 points (x1, y1) , (x2, y2), (x3, y3). +s = (x-xt)^2 + (y-yt)^2 – r*r +If s < 0, t lies inside the circle; if s > 0, t lies outside the circle; if s = 0, t lies on the circle.*/ + +#include +#include +#include +#include + +using namespace std; +const int LOW = 0; +const int HIGH = 10; +int main(int argc, char **argv) +{ + time_t seconds; + time(&seconds); + srand((unsigned int) seconds); + double x1, x2, y1, y2, x3, y3; + double m1, m2, c1, c2, r; + x1 = rand() % (HIGH - LOW + 1) + LOW; + x2 = rand() % (HIGH - LOW + 1) + LOW; + x3 = rand() % (HIGH - LOW + 1) + LOW; + y1 = rand() % (HIGH - LOW + 1) + LOW; + y2 = rand() % (HIGH - LOW + 1) + LOW; + y3 = rand() % (HIGH - LOW + 1) + LOW; + m1 = (y1 - y2) / (x1 - x2); + m2 = (y3 - y2) / (x3 - x2); + c1 = ((m1 * m2 * (y3 - y1)) + (m1 * (x2 + x3)) - (m2 * (x1 + x2))) / (2 + * (m1 - m2)); + c2 = ((((x1 + x2) / 2) - c1) / (-1 * m1)) + ((y1 + y2) / 2); + r = sqrt(((x3 - c1) * (x3 - c1)) + ((y3 - c2) * (y3 - c2))); + cout << "The points on the circle are: (" << x1 << ", " << y1 << "), (" + << x2 << ", " << y2 << "), (" << x3 << ", " << y3 << ")"; + cout << "\nThe center of the circle is (" << c1 << ", " << c2 + << ") and radius is " << r; + cout << "\nEnter the point : ,"; + int x, y; + cin >> x; + cin >> y; + double s = ((x - c1) * (x - c1)) + ((y - c2) * (y - c1)) - (r * r); + if (s < 0) + cout << "\nThe point lies inside the circle"; + else if (s > 0) + cout << "\nThe point lies outside the circle"; + else + cout << "\nThe point lies on the circle"; + return 0; +} + +/* + +The points on the circle are: (2, 5), (10, 8), (3, 6) +The center of the circle is (8.7, 13.7) and radius is 9.58019 +Enter the point : , 1 2 + +The point lies outside the circle + +The points on the circle are: (0, 6), (9, 7), (6, 10) +The center of the circle is (4.6, 7.4) and radius is 2.95296 +Enter the point : ,6 5 + +The point lies inside the circle \ No newline at end of file diff --git a/c++/Computational_Geometry/C++ Program to Compute Cross Product of Two Vectors.cpp b/c++/Computational_Geometry/C++ Program to Compute Cross Product of Two Vectors.cpp new file mode 100644 index 0000000..c1ccd24 --- /dev/null +++ b/c++/Computational_Geometry/C++ Program to Compute Cross Product of Two Vectors.cpp @@ -0,0 +1,39 @@ +/*This is a C++ Program to find the cross product of two vectors. In mathematics, the cross product or vector product is a binary operation on two vectors in three-dimensional space. It results in a vector that is perpendicular to both and therefore normal to the plane containing them.*/ + +#include +#include +#include +#include + +using namespace std; +const int LOW = 0; +const int HIGH = 10; +int main(int argc, char **argv) +{ + time_t seconds; + time(&seconds); + srand((unsigned int) seconds); + int u1, u2, u3, v1, v2, v3; + u1 = rand() % (HIGH - LOW + 1) + LOW; + u2 = rand() % (HIGH - LOW + 1) + LOW; + u3 = rand() % (HIGH - LOW + 1) + LOW; + v1 = rand() % (HIGH - LOW + 1) + LOW; + v2 = rand() % (HIGH - LOW + 1) + LOW; + v3 = rand() % (HIGH - LOW + 1) + LOW; + int uvi, uvj, uvk; + uvi = u2 * v3 - v2 * u3; + uvj = v1 * u3 - u1 * v3; + uvk = u1 * v2 - v1 * u2; + cout << "The cross product of the 2 vectors \n u = " << u1 << "i + " << u2 + << "j + " << u3 << "k and \n v = " << u1 << "i + " << u2 << "j + " + << u3 << "k \n "; + cout << "u X v : " << uvi << "i +" << uvj << "j+ " << uvk << "k "; + return 0; +} + +/* + +The cross product of the 2 vectors + u = 6i + 9j + 9k and + v = 6i + 9j + 9k + u X v : 0i +6j+ -6k \ No newline at end of file diff --git a/c++/Computational_Geometry/C++ Program to Compute the Area of a Triangle Using Determinants.cpp b/c++/Computational_Geometry/C++ Program to Compute the Area of a Triangle Using Determinants.cpp new file mode 100644 index 0000000..21a787b --- /dev/null +++ b/c++/Computational_Geometry/C++ Program to Compute the Area of a Triangle Using Determinants.cpp @@ -0,0 +1,89 @@ +/*This is a C++ program to find the area of triangle using determinants. +Formula for the area of a triangle using determinants +x1 y1 1 +Area=±1/2 x2 y2 1 +x3 y3 1 +The plus/minus in this case is meant to take whichever sign is needed so the answer is positive (non-negative). Do not say the area is both positive and negative.*/ + +#include +#include +#include +#include + +using namespace std; + +double det(int n, double mat[3][3]) +{ + double submat[3][3]; + float d; + for (int c = 0; c < n; c++) + { + int subi = 0; //submatrix's i value + for (int i = 1; i < n; i++) + { + int subj = 0; + for (int j = 0; j < n; j++) + { + if (j == c) + continue; + submat[subi][subj] = mat[i][j]; + subj++; + } + subi++; + } + d = d + (pow(-1, c) * mat[0][c] * det(n - 1, submat)); + } + return d; +} + +int main(int argc, char **argv) +{ + cout << "Enter the points of the triangle:\n"; + int x1, x2, x3, y1, y2, y3; + cin >> x1; + cin >> y1; + cin >> x2; + cin >> y2; + cin >> x3; + cin >> y3; + double mat[3][3]; + mat[0][0] = x1; + mat[0][1] = y1; + mat[0][2] = 1; + mat[1][0] = x2; + mat[1][1] = y2; + mat[1][2] = 1; + mat[2][0] = x3; + mat[2][1] = y3; + mat[2][2] = 1; + cout << "\nMatrix formed by the points: \n"; + for (int i = 0; i < 3; i++) + { + for (int j = 0; j < 3; j++) + cout << mat[i][j] << " "; + cout << endl; + } + float determinant = det(3, mat)*0.5; + if (determinant < 0) + cout << "The Area of the triangle formed by (" << x1 << "," << y1 + << "), (" << x2 << "," << y2 << "), (" << x3 << "," << y3 + << ") = " << (determinant * -1); + else + cout << "The Area of the triangle formed by (" << x1 << "," << y1 + << "), (" << x2 << "," << y2 << "), (" << x3 << "," << y3 + << ") = " << determinant; + return 0; +} + +/* + +Enter the points of the triangle: +3 4 +6 4 +3 9 + +Matrix formed by the points: +3 4 1 +6 4 1 +3 9 1 +The Area of the triangle formed by (3,4), (6,4), (3,9) = 7.5 \ No newline at end of file diff --git a/c++/Computational_Geometry/C++ Program to Compute the Volume of a Tetrahedron Using Determinants.cpp b/c++/Computational_Geometry/C++ Program to Compute the Volume of a Tetrahedron Using Determinants.cpp new file mode 100644 index 0000000..d76e8f9 --- /dev/null +++ b/c++/Computational_Geometry/C++ Program to Compute the Volume of a Tetrahedron Using Determinants.cpp @@ -0,0 +1,133 @@ +/*This is a C++ Program to find the volume of tetrahedron. +Call the four vertices of the tetrahedron (a, b, c), (d, e, f), (g, h, i), and (p, q, r). Now create a 4-by-4 matrix in which the coordinate triples form the colums of the matrix, with a row of 1’s appended at the bottom: +a d g p +b e h q +c f i r +1 1 1 1 +The volume of the tetrahedron is 1/6 times the absolute value of the matrix determinant. For any 4-by-4 matrix that has a row of 1’s along the bottom, you can compute the determinant with a simplification formula that reduces the problem to a 3-by-3 matrix +a-p d-p g-p +b-q e-q h-q +c-r f-r i-r*/ + +#include +#include +#include +#include + +using namespace std; + +double det(int n, double mat[3][3]) +{ + double submat[3][3]; + float d; + for (int c = 0; c < n; c++) + { + int subi = 0; //submatrix's i value + for (int i = 1; i < n; i++) + { + int subj = 0; + for (int j = 0; j < n; j++) + { + if (j == c) + continue; + submat[subi][subj] = mat[i][j]; + subj++; + } + subi++; + } + d = d + (pow(-1, c) * mat[0][c] * det(n - 1, submat)); + } + return d; +} + +int main(int argc, char **argv) +{ + cout << "Enter the points of the triangle:\n"; + int x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4; + cin >> x1; + cin >> x2; + cin >> x3; + cin >> x4; + cin >> y1; + cin >> y2; + cin >> y3; + cin >> y4; + cin >> z1; + cin >> z2; + cin >> z3; + cin >> z4; + double mat[4][4]; + mat[0][0] = x1; + mat[0][1] = x2; + mat[0][2] = x3; + mat[0][3] = x4; + mat[1][0] = y1; + mat[1][1] = y2; + mat[1][2] = y3; + mat[1][3] = y4; + mat[2][0] = z1; + mat[2][1] = z2; + mat[2][2] = z3; + mat[2][3] = z4; + mat[3][0] = 1; + mat[3][1] = 1; + mat[3][2] = 1; + mat[3][3] = 1; + cout << "\nMatrix formed by the points: \n"; + for (int i = 0; i < 4; i++) + { + for (int j = 0; j < 4; j++) + { + cout << mat[i][j] << " "; + } + cout << endl; + } + double matrix[3][3]; + matrix[0][0] = x1 - x4; + matrix[0][1] = x2 - x4; + matrix[0][2] = x3 - x4; + matrix[1][0] = y1 - y4; + matrix[1][1] = y2 - y4; + matrix[1][2] = y3 - y4; + matrix[2][0] = z1 - z4; + matrix[2][1] = z2 - z4; + matrix[2][2] = z3 - z4; + for (int i = 0; i < 3; i++) + { + for (int j = 0; j < 3; j++) + { + cout << matrix[i][j] << " "; + } + cout << endl; + } + float determinant = det(3, matrix) / 6; + if (determinant < 0) + cout << "The Area of the tetrahedron formed by (" << x1 << "," << y1 + << "," << z1 << "), (" << x2 << "," << y2 << "," << z2 + << "), (" << x3 << "," << y3 << "," << z3 << "), (" << x4 << "," + << y4 << "," << z4 << ") = " << (determinant * -1); + else + cout << "The Area of the tetrahedron formed by (" << x1 << "," << y1 + << "," << z1 << "), (" << x2 << "," << y2 << "," << z2 + << "), (" << x3 << "," << y3 << "," << z3 << "), (" << x4 << "," + << y4 << "," << z4 << ") = " << determinant; + return 0; +} + +/* + +Enter the points of the triangle: +0 9 6 0 +4 2 1 1 +3 4 7 5 + +Matrix formed by the points: +0 9 6 0 +4 2 1 1 +3 4 7 5 +1 1 1 1 + +0 9 6 +3 1 0 +-2 -1 2 +The Area of the tetrahedron formed by (0,4,3), (9,2,4), (6,1,7), (0,1,5) = 10.0 \ No newline at end of file diff --git a/c++/Computational_Geometry/C++ Program to Find Largest Rectangular Area in a Histogram.cpp b/c++/Computational_Geometry/C++ Program to Find Largest Rectangular Area in a Histogram.cpp new file mode 100644 index 0000000..b2c3cb8 --- /dev/null +++ b/c++/Computational_Geometry/C++ Program to Find Largest Rectangular Area in a Histogram.cpp @@ -0,0 +1,115 @@ +/* + * C++ Program to Find Largest Rectangular Area in a Histogram + */ +#include +#include +#include +#include +#define max(x, y, z) max(max(x, y) , z) +using namespace std; +/* + * get minimum of two numbers in hist[] + */ +int minVal(int *hist, int i, int j) +{ + if (i == -1) + return j; + if (j == -1) + return i; + return (hist[i] < hist[j])? i : j; +} +/* + * get the middle index from corner indexes. + */ +int getMid(int s, int e) +{ + return s + (e -s)/2; +} + +/* + * get the index of minimum value in a given range of indexes. + */ +int RMQUtil(int *hist, int *st, int ss, int se, int qs, int qe, int index) +{ + if (qs <= ss && qe >= se) + return st[index]; + if (se < qs || ss > qe) + return -1; + int mid = getMid(ss, se); + return minVal(hist, RMQUtil(hist, st, ss, mid, qs, qe, 2 * index + 1), + RMQUtil(hist, st, mid + 1, se, qs, qe, 2 * index + 2)); +} +/* + * Return index of minimum element in range from index qs to qe + */ +int RMQ(int *hist, int *st, int n, int qs, int qe) +{ + if (qs < 0 || qe > n - 1 || qs > qe) + { + cout << "Invalid Input"; + return -1; + } + return RMQUtil(hist, st, 0, n - 1, qs, qe, 0); +} +/* + * constructs Segment Tree for hist[ss..se]. + */ +int constructSTUtil(int hist[], int ss, int se, int *st, int si) +{ + if (ss == se) + return (st[si] = ss); + int mid = getMid(ss, se); + st[si] = minVal(hist, constructSTUtil(hist, ss, mid, st, si * 2 + 1), + constructSTUtil(hist, mid + 1, se, st, si * 2 + 2)); + return st[si]; +} + +/* + * construct segment tree from given array. + */ +int *constructST(int hist[], int n) +{ + int x = (int)(ceil(log2(n))); + int max_size = 2 * (int)pow(2, x) - 1; + int *st = new int[max_size]; + constructSTUtil(hist, 0, n - 1, st, 0); + return st; +} + +/* + * find the maximum rectangular area. + */ +int getMaxAreaRec(int *hist, int *st, int n, int l, int r) +{ + if (l > r) + return INT_MIN; + if (l == r) + return hist[l]; + int m = RMQ(hist, st, n, l, r); + return max (getMaxAreaRec(hist, st, n, l, m - 1), + getMaxAreaRec(hist, st, n, m + 1, r), (r - l + 1) * (hist[m])); +} + +/* + * find max area + */ +int getMaxArea(int hist[], int n) +{ + int *st = constructST(hist, n); + return getMaxAreaRec(hist, st, n, 0, n - 1); +} + +/* + * Main + */ +int main() +{ + int hist[] = {6, 1, 5, 4, 5, 2, 6}; + int n = sizeof(hist)/sizeof(hist[0]); + cout << "Maximum area is " << getMaxArea(hist, n)< +#include +#include +#include + +void main() +{ + double y[20][20],x[20]; + /* ARRAY OF N*N ELEMENTS FOR BACKWARD DIFFERENCE TABLE */ + int i,j,k,n; + clrscr(); + printf("\n\tBACKWARD DIFFERENCES GENERATION FOR INTERPOLATION"); + printf("\n\n The form of equation is y = f(x)\n"); + printf("\n\nEnter the number of entries (max 20) = "); + scanf("%d",&n); /* ENTER NUMBER OF ENTRIES IN THE TABLE */ + for(i = 0; i < n; i++) + { + /* LOOP TO GET x AND y = f(x) IN THE TABLE */ + printf("x%d = ",i); + scanf("%lf",&x[i]); + printf(" y%d = ",i); + scanf("%lf",&y[i][0]); + } + k = 0; + for(j = 1; j < n; j++) + { + /* LOOP TO CALCULATE BACKWARD DIFFERENCES */ + k++; + for(i = n-1; i >= k; i--) + { + y[i][j] = y[i][j-1] - y[i-1][j-1]; + } + } + k = n ; + clrscr(); + printf("\n The backward difference table is as follows . . .\n"); + printf("\n\tx\ty\tDy\tD2y\tD3y\tD4y\tD5y\tD6y\n"); + for(i = 0; i < n; i++) + { + /* LOOP TO PRINT BACKWARD DIFFERENCES */ + printf("\nx%d = %4.2lf",i,x[i]); + for(j = 0; j < i+1; j++) + { + printf("\t%4.2lf ",y[i][j]); + } + printf("\n"); + } +} +/*------------------------------End of program-------------------------*/ \ No newline at end of file diff --git a/c++/Computational_Geometry/C++ Program to Implement BINARY SEARCH METHOD.cpp b/c++/Computational_Geometry/C++ Program to Implement BINARY SEARCH METHOD.cpp new file mode 100644 index 0000000..73b3d3f --- /dev/null +++ b/c++/Computational_Geometry/C++ Program to Implement BINARY SEARCH METHOD.cpp @@ -0,0 +1,87 @@ +/* */ +/* File name : bin_srch.cpp */ + +/*-------------------- BINARY SEARCH METHOD --------------------------*/ + +/* THIS PROGRAM SEARCHES A NUMBER IN THE SORTED ARRAY. + + INPUTS : 1) The total number of elements in the sorted array. + + 2) Array of numbers. + + 3) An element to be searched for. + + OUTPUTS : The position of the number in array. */ + +/*------------------------------ PROGRAM -------------------------*/ + +#include +#include +#include +#include + +void main() +{ + double x[100],y[100],z; /*DECLARATION OF ARRAY */ + int i,n,k,j,t; + clrscr(); + printf("\n Computational Techniques - J. S. CHITODE"); + printf("\n BINARY SEARCH METHOD\n"); + printf("\n\nEnter the total number of elements " + "in the array(max 100) = "); + scanf("%d",&n); /* ENTER THE NUMBER OF ELEMENTS IN THE ARRAY */ + for(i = 0; i < n; i++) + { + /* LOOP TO ENTER ACTUAL VALUES OF ARRAY ELEMENTS */ + printf("\nx%d = ",i); + scanf("%lf",&x[i]); + } + printf("\nEnter the number to be searched = "); + scanf("%lf",&z); /* NUMBER TO BE SEARCHED FOR */ + k = n/2; /* MIDDLE OF THE ARRAY */ + t = 0; + while(k >= 1) + { + if(x[0] == z) /* CHECK IF x[0] IS THE NUMBER TO BE SEARCHED */ + { + printf("match is found at key = 0"); + break; /* break IS USED TO GO OUT OF THE LOOP */ + } + if(x[n-1] == z) /* CHECK IF x[n-1] IS THE NUMBER TO BE SEARCHED*/ + { + printf("match is found at key = %d",n-1); + break; /* break IS USED TO GO OUT OF THE LOOP */ + } + if(x[k] > z) /* CHECK IN THE TOP HALF */ + { + k = (k+1)/2; + if(x[k] == z) + { + printf("match is found at key = %d",k); + break; + } + for(i = 0; i < k; i++) + { + y[i] = x[i]; + } + } + if(x[k] <= z) /* CHECK IN THE BOTTOM HALF */ + { + k = (k+1)/2; + if(x[k] == z) + { + printf("match is found at key = %d",n-k-1); + break; + } + for(i = k,j = 0; i < n; i++,j++) + { + y[j] = x[i]; + } + } + for(i = 0; i <= k; i++) + { + x[i] = y[i]; /*FORM THE NEW ARRAY OF k/2 ELEMENTS */ + } + } +} +/*------------------------ END OF PROGRAM ------------------------------*/ diff --git a/c++/Computational_Geometry/C++ Program to Implement BISECTION METHOD TO FIND ROOT OF AN EQUATION.cpp b/c++/Computational_Geometry/C++ Program to Implement BISECTION METHOD TO FIND ROOT OF AN EQUATION.cpp new file mode 100644 index 0000000..935f979 --- /dev/null +++ b/c++/Computational_Geometry/C++ Program to Implement BISECTION METHOD TO FIND ROOT OF AN EQUATION.cpp @@ -0,0 +1,74 @@ + + +/*------------ BISECTION METHOD TO FIND ROOT OF AN EQUATION ----------*/ + +/* THE EXPRESSION FOR AN EQUATION IS DEFINED IN function fx + YOU CAN WRITE DIFFERENT EQUATION IN function fx. + HERE, + f(x) = x*x*x - 1.8*x*x - 10*x - 17 + + INPUTS : 1) Initial interval [a,b] in which root is to + be found. + 2) Permissible error in the root. + + OUTPUTS : 1) Number of iterations for given interval and + permissible error. + 3) Value of the root in given interval. */ + +/*------------------------------ PROGRAM --------------------------*/ + +#include +#include +#include +#include + +void main() +{ + double fx ( double x); /* DECLARATION OF FUNCTION */ + double x,a,b,fa,fb,c,fc,err; + int n,i; + clrscr(); + printf("\n BISECTION METHOD TO FIND ROOT OF AN EQUATION"); + printf("\n\n f(x) = x*x*x - 1.8*x*x - 10*x - 17"); + printf("\n\nEnter an interval [a,b] in " + "which root is to be found"); + printf("\na = "); + scanf("%lf",&a); /* INTERVAL [a,b] IS TO BE ENTERED HERE */ + printf("b = "); + scanf("%lf",&b); + printf("\nEnter the value of permissible error = "); + scanf("%lf",&err); + n = (log10(abs(b - a)) - log10( err ) )/log10(2); + /* CALCULATION OF STEPS 'n' */ + n = n + 1; /* n SHOULD NOT BE A FRACTIONAL NUMBER; ADD '1' */ + i = 0; + printf("\nNumber of iterations for this error bound are = %d",n); + printf("\n\npress any key for step by step display of intervals"); + getch(); + printf("\n\n RESULTS OF BISECTION METHOD\n"); + while(n-- > 0) + { + fa = fx(a); /* CALCULATE f(x) AT x = a */ + fb = fx(b); /* CALCULATE f(x) AT x = b */ + c = (a + b)/2; /* CENTER OF THE INTERVAL */ + fc = fx(c); /* CALCULATE f(x) AT x = c */ + i++; + printf("\n\n%d a = %lf b = %lf c = %lf",i,a,b,c); + printf("\n f(a) = %lf f(b) = %lf f(c) = %lf",fa,fb,fc); + if( (fc*fa) < 0) b = c; /* IF f(c)f(a) < 0, NEW INTERVAL IS [a,c] */ + if( (fc*fb) < 0) a = c; /* IF f(c)f(b) < 0, NEW INTERVAL IS [b,c] */ + printf("\n interval : a = %lf b = %lf",a,b); + getch(); + } + x = a + (b - a)/2; /* ROOT = a + half interval [a,b] */ + printf("\nThe value of root is = %20.15lf",x); /* ROOT */ +} +/*---------- FUNCTION PROCEDURE TO CALCULATE VALUE OF EQUATION --------*/ + +double fx ( double x) +{ + double f; + f = x*x*x - 1.8*x*x - 10*x + 17; /* FUNCTION f(x) */ + return(f); +} +/*------------------------ END OF PROGRAM -----------------------------*/ diff --git a/c++/Computational_Geometry/C++ Program to Implement BUBBLE SORT METHOD.cpp b/c++/Computational_Geometry/C++ Program to Implement BUBBLE SORT METHOD.cpp new file mode 100644 index 0000000..fc81d90 --- /dev/null +++ b/c++/Computational_Geometry/C++ Program to Implement BUBBLE SORT METHOD.cpp @@ -0,0 +1,58 @@ + + +/*-------------------- BUBBLE SORT METHOD ----------------------------*/ + +/* THIS PROGRAM SORTS THE INPUT ARRAY INTO ASCENDING ORDER + USING BUBBLE SORT METHOD. + + INPUTS : 1) The total number of elements to be sorted. + + 2) Array of numbers. + + OUTPUTS : Sorted array of elements. */ + +/*------------------------------ PROGRAM ----------------------------*/ + +#include +#include +#include +#include + +void main() +{ + double x[100],z; /*DECLARATION OF ARRAY */ + int i,n,k; + clrscr(); + printf("\n Computational Techniques - J. S. CHITODE"); + printf("\n BUBBLE SORT METHOD\n"); + printf("\n\nEnter the total number of elements " + "to sorted (max 100) = "); + scanf("%d",&n); /* ENTER THE NUMBER OF ELEMENTS TO BE SORTED */ + for(i = 0; i < n; i++) + { + /* LOOP TO ENTER ACTUAL VALUES OF ARRAY ELEMENTS */ + printf("\nx%d = ",i); + scanf("%lf",&x[i]); + } + for(i = 0; i < n-1; i++) + { + /* LOOP TO SORT THE ARRAY */ + for(k = 0; k < n-1; k++) + { + if(x[k] > x[k+1]) + { + z = x[k]; + x[k] = x[k+1]; + x[k+1] = z; + } + } + } + printf("\nThe sorted array in ascending order is ....\n"); + for(i = 0; i < n; i++) + { + /* LOOP TO PRINT THE ARRAY */ + printf("\nx%d = %lf",i,x[i]); + } +} + +/*------------------------ END OF PROGRAM ------------------------------*/ diff --git a/c++/Computational_Geometry/C++ Program to Implement CALCULATION OF TRUNCATION ERROR OF SERIES APPROXIMATION.cpp b/c++/Computational_Geometry/C++ Program to Implement CALCULATION OF TRUNCATION ERROR OF SERIES APPROXIMATION.cpp new file mode 100644 index 0000000..38cd17f --- /dev/null +++ b/c++/Computational_Geometry/C++ Program to Implement CALCULATION OF TRUNCATION ERROR OF SERIES APPROXIMATION.cpp @@ -0,0 +1,66 @@ + + +/*----- CALCULATION OF TRUNCATION ERROR OF SERIES APPROXIMATION -------*/ + +/* EXPONENTIAL SERIES exp(x) IS USED HERE + + INPUTS : 1) The total number of terms to be computed + in series starting from first term. + 2) The value of 'x' in exp(x). + + OUTPUTS : 1) Computed value of series approximation of exp(x). + 2) Actual value of exp(x) function. + 3) Absolute error between series approximation and + actual value of exp(x) function. */ + +/*------------------------------ PROGRAM --------------------------*/ + +#include +#include +#include +#include + +void main() +{ + double fact ( int n); /* DECLARATION OF FACTORIAL FUNCTION */ + double x,sum,z,sum1; + int n,i; + clrscr(); + printf("\n\t\tCALCULATION OF TRUNCATION ERROR " + "OF SERIES APPROXIMATION"); + printf("\n\nGive number of terms " + "in series to be computed = "); + scanf("%d",&n); /* NUMBER OF TERMS TO BE COMPUTED IN SERIES */ + n = n - 1; /* TERMS ARE COMPUTED FROM ZERO HENCE 'n-1' */ + printf("\nGive value of x = "); + scanf("%lf",&x); /* VALUE OF 'x' */ + sum = 0; + sum1 = 0; + for(i = 0; i<=n; i++) + { + z = fact(i); + sum = pow(x,(double)i)/z; + sum1 = sum1 + sum; + } + printf("\nThe computed value of exp(x) " + "function is = %1.15lf",sum1); /* COMPUTED VALUE */ + printf("\n\nThe actual value of exp(x) " + "function is = %1.15lf",exp(x)); /* ACTUAL VALUE */ + printf("\n\nTruncation error in series " + "approximation is = %1.15lf", exp(x)-sum1); /* ERROR */ +} +/*------------- FUNCTION PROCEDURE TO CALCULATE FACTORIAL -------------*/ + +double fact( int n) +{ + double facto; + facto = 1; + if(n == 0) return( facto = 1); + do + { + facto = facto * n; + } + while(n-- > 1); + return(facto); +} +/*----------------------- END OF PROGRAM ----------------------------*/ diff --git a/c++/Computational_Geometry/C++ Program to Implement DIVIDED DIFFERENCES GENERATION FOR INTERPOLATION.cpp b/c++/Computational_Geometry/C++ Program to Implement DIVIDED DIFFERENCES GENERATION FOR INTERPOLATION.cpp new file mode 100644 index 0000000..cce08e4 --- /dev/null +++ b/c++/Computational_Geometry/C++ Program to Implement DIVIDED DIFFERENCES GENERATION FOR INTERPOLATION.cpp @@ -0,0 +1,68 @@ + + +/*-------------- DIVIDED DIFFERENCES GENERATION FOR INTERPOLATION -----*/ + +/* THE PROGRAM GENERATES A DIVIDED DIFFERENCES TABLE FROM GIVEN + + DATA. THE VALUES OF x AND CORRESPONDING y = f(x) ARE TO BE + + ENTERED IN THE ARRAY FORMAT. + + INPUTS : 1) Number of entries of the data. + + 2) Values of 'x' & corresponding y = f(x). + + OUTPUTS : divided difference table array. */ + +/*------------------------------ PROGRAM --------------------------*/ + +#include +#include +#include +#include + +void main() +{ + double y[20][20],x[20]; + /* ARRAY OF y[n][n] ELEMENTS FOR DIVIDED DIFFERENCE TABLE */ + int i,j,k,n; + clrscr(); + printf("\n\tDIVIDED DIFFERENCES GENERATION FOR INTERPOLATION"); + printf("\n\n The form of equation is y = f(x)\n"); + printf("\n\nEnter the number of entries (max 20) = "); + /* ENTER THE NUMBER OF ENTRIES IN THE TABLE */ + scanf("%d",&n); + for(i = 0; i < n; i++) + { + /* LOOP TO GET x AND y = f(x) IN THE TABLE */ + printf("x%d = ",i); + scanf("%lf",&x[i]); + printf(" y%d = ",i); + scanf("%lf",&y[i][0]); + } + k = n; + for(j = 1; j < n; j++) + { + /* LOOP TO CALCULATE DIVIDED DIFFERENCES IN THE TABLE*/ + k = k - 1; + for(i = 0; i < k; i++) + { + y[i][j] = (y[i+1][j-1] - y[i][j-1])/(x[i+j]-x[i]); + } + } + k = n; + clrscr(); + printf("\n The divided difference table is as follows . . .\n"); + printf("\n\tx\ty\tDy\tD2y\tD3y\tD4y\tD5y\tD6y\n"); + for(i = 0; i < n; i++) + { + /* LOOP TO PRINT DIVIDED DIFFERENCES IN THE TABLE */ + printf("\nx%d = %4.2lf",i,x[i]); + for(j = 0; j < k-i; j++) + { + printf("\t%4.2lf ",y[i][j]); + } + printf("\n"); + } +} +/*-------------------------------End of program -----------------------*/ diff --git a/c++/Computational_Geometry/C++ Program to Implement EULER'S METHOD TO SOLVE DIFFERENTIAL EQUATION.cpp b/c++/Computational_Geometry/C++ Program to Implement EULER'S METHOD TO SOLVE DIFFERENTIAL EQUATION.cpp new file mode 100644 index 0000000..97dd298 --- /dev/null +++ b/c++/Computational_Geometry/C++ Program to Implement EULER'S METHOD TO SOLVE DIFFERENTIAL EQUATION.cpp @@ -0,0 +1,61 @@ + + +/*-------------- EULER'S METHOD TO SOLVE DIFFERENTIAL EQUATION --------*/ + +/* THIS PROGRAM CALCULATES THE VALUE y AT GIVEN VALUE OF x + USING EULER'S METHOD. THE FUNCTION y' = f(x,y) IS + DEFINED IN THE PROGRAM. + + y' = x - y + Hence f(x,y) = x - y + + INPUTS : 1) Initial values of x and y. + + 2) Step size h. + + OUTPUTS : Calculated values of y at every step. */ + +/*------------------------------ PROGRAM --------------------------*/ + +#include +#include +#include +#include + +void main() +{ + double f (double x0,double y0); /* DECLARATION OF A FUNCTION f */ + double y0,y1,x0,x1,h,x; + int i,n,t; + clrscr(); + printf("\n EULER'S METHOD TO SOLVE DIFFERENTIAL EQUATION\n"); + printf("\n\nEnter x0 = "); + scanf("%lf",&x0); /* ENTER VALUE OF x0 */ + printf("\n\nEnter y0 = "); + scanf("%lf",&y0); /* ENTER VALUE OF y0 */ + printf("\n\nEnter the value of x at which y is to be found = "); + scanf("%lf",&x); /* ENTER VALUE OF x */ + printf("\n\nEnter the value of h = "); + scanf("%lf",&h); /* ENTER THE VALUE OF h */ + i = 0; + printf("\nPress any key to see step be step display of results...\n"); + while(x0 < x) /* LOOP TO CALCULATE y USING EULER'S FORMULA */ + { + i++; + x1 = x0 + h; + y1 = y0 + h * f(x0,y0); /* IMPLEMENTATION OF EULER'S FORMULA */ + printf("\nx%d = %lf y%d = %lf",i,x1,i,y1); + x0 = x1; + y0 = y1; + getch(); + } +} +/*---------------------------------------------------------------------*/ + +double f ( double x,double y) /* FUNCTION TO CALCULATE VALUE OF f(x,y)*/ +{ + double y_dash; + y_dash = x - y; /* function f(x,y) = y' = x - y */ + return(y_dash); +} +/*------------------------ END OF PROGRAM -----------------------------*/ diff --git a/c++/Computational_Geometry/C++ Program to Implement FORWARD DIFFERENCES GENERATION FOR INTERPOLATION.cpp b/c++/Computational_Geometry/C++ Program to Implement FORWARD DIFFERENCES GENERATION FOR INTERPOLATION.cpp new file mode 100644 index 0000000..b61751b --- /dev/null +++ b/c++/Computational_Geometry/C++ Program to Implement FORWARD DIFFERENCES GENERATION FOR INTERPOLATION.cpp @@ -0,0 +1,69 @@ + + +/*-------------- FORWARD DIFFERENCES GENERATION FOR INTERPOLATION -----*/ + +/* THE PROGRAM GENERATES A FORWARD DIFFERENCES TABLE FROM GIVEN + + DATA. THE VALUES OF x AND CORRESPONDING y = f(x) ARE TO BE + + ENTERED IN THE ARRAY FORMAT. + + INPUTS : 1) Number of entries of the data. + + 2) Values of 'x' & corresponding y = f(x). + + OUTPUTS : forward difference table array. */ + +/*------------------------------ PROGRAM --------------------------*/ + +#include +#include +#include +#include + +void main() +{ + double y[20][20],x[20]; + /* ARRAY OF y[n][n] ELEMENTS FOR FORWARD DIFFERENCE TABLE */ + int i,j,k,n; + clrscr(); + printf("\n\tFORWARD DIFFERENCES GENERATION FOR INTERPOLATION"); + printf("\n\n The form of equation is y = f(x)\n"); + printf("\n\nEnter the number of entries (max 20) = "); + /* ENTER THE NUMBER OF ENTRIES IN THE TABLE */ + scanf("%d",&n); + for(i = 0; i < n; i++) + { + /* LOOP TO GET x AND y = f(x) IN THE TABLE */ + printf("x%d = ",i); + scanf("%lf",&x[i]); + printf(" y%d = ",i); + scanf("%lf",&y[i][0]); + } + k = n; + for(j = 1; j < n; j++) + { + /* LOOP TO CALCULATE FORWARD DIFFERENCES IN THE TABLE */ + k = k - 1; + for(i = 0; i < k; i++) + { + y[i][j] = y[i+1][j-1] - y[i][j-1]; + } + } + k = n; + clrscr(); + printf("\n The forward difference table is as follows . . .\n"); + printf("\n\tx\ty\tDy\tD2y\tD3y\tD4y\tD5y\tD6y\n"); + for(i = 0; i < n; i++) + { + /* LOOP TO PRINT FORWARD DIFFERENCES IN THE TABLE */ + printf("\nx%d = %4.2lf",i,x[i]); + for(j = 0; j < k; j++) + { + printf("\t%4.2lf ",y[i][j]); + } + k = k - 1; + printf("\n"); + } +} +/*-------------------- End of program---------------------------------*/ diff --git a/c++/Computational_Geometry/C++ Program to Implement First Fit Decreasing for 1-D Objects and M Bins.cpp b/c++/Computational_Geometry/C++ Program to Implement First Fit Decreasing for 1-D Objects and M Bins.cpp new file mode 100644 index 0000000..2472fac --- /dev/null +++ b/c++/Computational_Geometry/C++ Program to Implement First Fit Decreasing for 1-D Objects and M Bins.cpp @@ -0,0 +1,74 @@ +#include +#include +#include + +using namespace std; + +void binPacking(int *a, int size, int n) +{ + int binCount = 0; + int binValues[n]; + for (int i = 0; i < n; i++) + binValues[i] = size; + for (int i = 0; i < n; i++) + for (int j = 0; j < n; j++) + { + if (binValues[j] - a[i] >= 0) + { + binValues[j] -= a[i]; + break; + } + } + for (int i = 0; i < n; i++) + if (binValues[i] != size) + binCount++; + cout << "Number of bins required using first fit decreasing algorithm is:" + << binCount; +} + +int* sort(int *sequence, int n) +{ + // Bubble Sort descending order + for (int i = 0; i < n; i++) + for (int j = 0; j < n - 1; j++) + if (sequence[j] < sequence[j + 1]) + { + sequence[j] = sequence[j] + sequence[j + 1]; + sequence[j + 1] = sequence[j] - sequence[j + 1]; + sequence[j] = sequence[j] - sequence[j + 1]; + } + return sequence; +} + +int main(int argc, char **argv) +{ + cout << "BIN - PACKING Algorithm 1D Objects(First Fit Decreasing)"; + cout << "Enter the number of items in Set: "; + int n; + cin >> n; + cout << "Enter " << n << " items:"; + int a[n]; + for (int i = 0; i < n; i++) + cin >> a[i]; + cout << "Enter the bin size: "; + int size; + cin >> size; + int *sequence = sort(a, n); + binPacking(sequence, size, n); +} + +/* + +BIN - PACKING Algorithm 1D Objects(First Fit Decreasing)Enter the number of items in Set: 9 +Enter 9 items: +4 +1 +2 +5 +3 +2 +3 +6 +3 +Enter the bin size: 6 +Number of bins required using first fit decreasing algorithm is:5 \ No newline at end of file diff --git a/c++/Computational_Geometry/C++ Program to Implement GAUSS ELIMINATION METHOD TO SOLVE LINEAR EQUATIONS.cpp b/c++/Computational_Geometry/C++ Program to Implement GAUSS ELIMINATION METHOD TO SOLVE LINEAR EQUATIONS.cpp new file mode 100644 index 0000000..e8db6c1 --- /dev/null +++ b/c++/Computational_Geometry/C++ Program to Implement GAUSS ELIMINATION METHOD TO SOLVE LINEAR EQUATIONS.cpp @@ -0,0 +1,78 @@ + + +/*-------- GAUSS ELIMINATION METHOD TO SOLVE LINEAR EQUATIONS ---------*/ + +/* THE PROGRAM SOLVES THE SYSTEM OF LINEAR EQUATIONS USING + + GAUSS ELIMINATION METHOD. + + INPUTS : 1) Number of variables in the equation. + + 2) Coefficient's of linear equations. + + OUTPUT : Calculated values of x1,x2,x3,...,xn etc. */ + +/*------------------------------ PROGRAM --------------------------*/ + +#include +#include +#include +#include + +void main() +{ + double a[10][10],x[10],ratio,coefsum; + /* ARRAY OF a[n][n] STORING COEFFICIENTS OF EQUATIONS */ + int i,j,n,k; + clrscr(); + printf("\n Computational Techniques - J. S. CHITODE"); + printf("\n GAUSS ELIMINATION METHOD TO SOLVE LINEAR EQUATIONS"); + printf("\n\n The form of equations is as follows\n\n" + " a11x1 + a12x2 + ... + a1nxn = b1\n" + " a21x1 + a22x2 + ... + a2nxn = b2\n" + " a31x1 + a32x2 + ... + a3nxn = b3\n" + " ................................\n" + " an1x1 + an2x2 + ... + annxn = bn\n" + "\n\nHere a11,a22,a33,a44,.....etc. should not be zero\n"); + printf("\n\nEnter the number of variables (max 10) = "); + /* ENTER THE NUMBER OF VARIABLES IN THE EQUATION */ + scanf("%d",&n); + for(i = 1; i <= n; i++) + { + /* LOOP TO GET COEFFICIENTS a11,a12...,ann & so on */ + for(j = 1; j <= n; j++) + { + printf("a%d%d = ",i,j); + scanf("%lf",&a[i][j]); + } + printf("b%d = ",i); + scanf("%lf",&a[i][j]); + x[i] = 0; + } + for(k = 1; k <= n-1; k++) + { + /* LOOP TO GENERATE UPPER TRIANGULAR SYSTEM */ + for(i = k+1; i <= n; i++) + { + ratio = a[i][k]/a[k][k]; + for(j = k+1; j <= n+1; j++) + { + a[i][j] = a[i][j] - ratio * a[k][j]; + } + } + for(i = k+1; i <= n; i++) a[i][k] = 0; + } + x[n] = a[n][n+1]/a[n][n]; + for(i = n-1; i >= 1; i--) + { + /* LOOP FOR BACKWARD SUBSTITUTION */ + coefsum = 0; + for(j = i+1; j <= n; j++) coefsum = coefsum + a[i][j] * x[j]; + x[i] = (a[i][n+1] - coefsum)/a[i][i]; + } + printf("\n\nThe values of variables in the given equations are " + "as follows....\n"); + for(i = 1; i <= n; i++) printf("\n x%d = %lf ",i,x[i]); + /* LOOP TO PRINT VALUES OF x1,x2,...xn etc */ +} +/*-------------------------------- END OF PROGRAM ----------------------*/ diff --git a/c++/Computational_Geometry/C++ Program to Implement GAUSS SIEDEL ITERATION METHOD TO SOLVE LINEAR EQUATIONS.cpp b/c++/Computational_Geometry/C++ Program to Implement GAUSS SIEDEL ITERATION METHOD TO SOLVE LINEAR EQUATIONS.cpp new file mode 100644 index 0000000..8a9e8bc --- /dev/null +++ b/c++/Computational_Geometry/C++ Program to Implement GAUSS SIEDEL ITERATION METHOD TO SOLVE LINEAR EQUATIONS.cpp @@ -0,0 +1,79 @@ + + +/*------- GAUSS SIEDEL ITERATION METHOD TO SOLVE LINEAR EQUATIONS -----*/ + +/* THE PROGRAM SOLVES THE SYSTEM OF LINEAR EQUATIONS USING + + GAUSS SIEDEL ITERATION METHOD. + + INPUTS : 1) Number of variables in the equation. + + 2) Coefficient's of linear equations. + + OUTPUTS : Results of every iteration till 'q' is pressed. */ + +/*------------------------------ PROGRAM --------------------------*/ + +#include +#include +#include +#include + +void main() +{ + double a[10][10],x[10],y[10]; + /* ARRAY OF a[n][n] STORING COEFFICIENTS OF EQUATIONS */ + int i,j,n; + char ch; + clrscr(); + printf("\n GAUSS SIEDEL METHOD TO SOLVE LINEAR EQUATIONS"); + printf("\n\n The form of equations is as follows\n\n" + " a11x1 + a12x2 + ... + a1nxn = b1\n" + " a21x1 + a22x2 + ... + a2nxn = b2\n" + " a31x1 + a32x2 + ... + a3nxn = b3\n" + " ................................\n" + " an1x1 + an2x2 + ... + annxn = bn\n"); + printf("\n\nEnter the number of variables (max 10) = "); + /* ENTER THE NUMBER OF VARIABLES IN THE EQUATION */ + scanf("%d",&n); + for(i = 1; i <= n; i++) + { + /* LOOP TO GET COEFFICIENTS a11,a12...,ann & so on */ + for(j = 1; j <= n; j++) + { + printf("a%d%d = ",i,j); + scanf("%lf",&a[i][j]); + } + printf("b%d = ",i); + scanf("%lf",&a[i][j]); + x[i] = y[i] = 0; + } + printf("\n\nThe results are as follows....\n\n" + "press 'enter' key to continue iterations &" + " press 'q' to stop iterations....\n\n"); + while(ch != 'q') + { + for(i = 1; i <= n; i++) + { + /* LOOP TO CALCULATE VALUES OF x1,x2,...,xn etc */ + for(j = 1; j <= n; j++) + { + if(i == j) continue; + x[i] = x[i] - a[i][j]*y[j]; + } + x[i] = x[i] + a[i][j]; + x[i] = x[i]/a[i][i]; + y[i] = x[i]; /* TAKE VALUES FROM CURRENT ITERATIONS */ + } + for(i = 1; i <= n; i++) + { + /* LOOP TO PRINT VALUES OF x1,x2,...xn etc */ + y[i] = x[i]; + printf("x%d = %lf ",i,x[i]); + x[i] = 0; + } + ch = getch(); + printf("\n\n"); + } +} +/*-------------------------------- END OF PROGRAM ---------------------*/ diff --git a/c++/Computational_Geometry/C++ Program to Implement Gift Wrapping Algorithm in Two Dimensions.cpp b/c++/Computational_Geometry/C++ Program to Implement Gift Wrapping Algorithm in Two Dimensions.cpp new file mode 100644 index 0000000..9b403f5 --- /dev/null +++ b/c++/Computational_Geometry/C++ Program to Implement Gift Wrapping Algorithm in Two Dimensions.cpp @@ -0,0 +1,86 @@ +/*This is a C++ Program to implement Gift Wrapping algorithm to find convex hull in two dimensional space. In computational geometry, the gift wrapping algorithm is an algorithm for computing the convex hull of a given set of points. In the two-dimensional case the algorithm is also known as Jarvis march, after R. A. Jarvis, who published it in 1973; it has O(nh) time complexity, where n is the number of points and h is the number of points on the convex hull. Its real-life performance compared with other convex hull algorithms is favorable when n is small or h is expected to be very small with respect to n. In general cases the algorithm is outperformed by many others.*/ + +// A C++ program to find convex hull of a set of points +// Refer http://www.geeksforgeeks.org/check-if-two-given-line-segments-intersect/ +// for explanation of orientation() +#include +using namespace std; + +// Define Infinite (Using INT_MAX caused overflow problems) +#define INF 10000 + +struct Point +{ + int x; + int y; +}; + +// To find orientation of ordered triplet (p, q, r). +// The function returns following values +// 0 --> p, q and r are colinear +// 1 --> Clockwise +// 2 --> Counterclockwise +int orientation(Point p, Point q, Point r) +{ + int val = (q.y - p.y) * (r.x - q.x) - (q.x - p.x) * (r.y - q.y); + if (val == 0) + return 0; // colinear + return (val > 0) ? 1 : 2; // clock or counterclock wise +} + +// Prints convex hull of a set of n points. +void convexHull(Point points[], int n) +{ + // There must be at least 3 points + if (n < 3) + return; + // Initialize Result + int next[n]; + for (int i = 0; i < n; i++) + next[i] = -1; + // Find the leftmost point + int l = 0; + for (int i = 1; i < n; i++) + if (points[i].x < points[l].x) + l = i; + // Start from leftmost point, keep moving counterclockwise + // until reach the start point again + int p = l, q; + do + { + // Search for a point 'q' such that orientation(p, i, q) is + // counterclockwise for all points 'i' + q = (p + 1) % n; + for (int i = 0; i < n; i++) + if (orientation(points[p], points[i], points[q]) == 2) + q = i; + next[p] = q; // Add q to result as a next point of p + p = q; // Set p as q for next iteration + } + while (p != l); + // Print Result + for (int i = 0; i < n; i++) + { + if (next[i] != -1) + cout << "(" << points[i].x << ", " << points[i].y << ")\n"; + } +} + +// Driver program to test above functions +int main() +{ + Point points[] = { { 0, 3 }, { 2, 2 }, { 1, 1 }, { 2, 1 }, { 3, 0 }, + { 0, 0 }, { 3, 3 } + }; + cout << "The points in the convex hull are: "; + int n = sizeof(points) / sizeof(points[0]); + convexHull(points, n); + return 0; +} + +/* + +The points in the convex hull are: (0, 3) +(3, 0) +(0, 0) +(3, 3) diff --git a/c++/Computational_Geometry/C++ Program to Implement Graham Scan Algorithm to Find the Convex Hull.cpp b/c++/Computational_Geometry/C++ Program to Implement Graham Scan Algorithm to Find the Convex Hull.cpp new file mode 100644 index 0000000..523af12 --- /dev/null +++ b/c++/Computational_Geometry/C++ Program to Implement Graham Scan Algorithm to Find the Convex Hull.cpp @@ -0,0 +1,124 @@ +/*This is a C++ Program to implement Graham Scan algorithm. Graham’s scan is a method of computing the convex hull of a finite set of points in the plane with time complexity O(n log n).*/ + +// A C++ program to find convex hull of a set of points +// Refer http://www.geeksforgeeks.org/check-if-two-given-line-segments-intersect/ +// for explanation of orientation() +#include +#include +#include +using namespace std; + +struct Point +{ + int x; + int y; +}; + +Point p0; + +// A utility function to find next to top in a stack +Point nextToTop(stack &S) +{ + Point p = S.top(); + S.pop(); + Point res = S.top(); + S.push(p); + return res; +} + +// A utility function to swap two points +int swap(Point &p1, Point &p2) +{ + Point temp = p1; + p1 = p2; + p2 = temp; +} + +// A utility function to return square of distance between p1 and p2 +int dist(Point p1, Point p2) +{ + return (p1.x - p2.x) * (p1.x - p2.x) + (p1.y - p2.y) * (p1.y - p2.y); +} + +int orientation(Point p, Point q, Point r) +{ + int val = (q.y - p.y) * (r.x - q.x) - (q.x - p.x) * (r.y - q.y); + if (val == 0) + return 0; // colinear + return (val > 0) ? 1 : 2; // clock or counterclock wise +} + +// A function used by library function qsort() to sort an array of +// points with respect to the first point +int compare(const void *vp1, const void *vp2) +{ + Point *p1 = (Point *) vp1; + Point *p2 = (Point *) vp2; + // Find orientation + int o = orientation(p0, *p1, *p2); + if (o == 0) + return (dist(p0, *p2) >= dist(p0, *p1)) ? -1 : 1; + return (o == 2) ? -1 : 1; +} + +// Prints convex hull of a set of n points. +void convexHull(Point points[], int n) +{ + // Find the bottommost point + int ymin = points[0].y, min = 0; + for (int i = 1; i < n; i++) + { + int y = points[i].y; + // Pick the bottom-most or chose the left most point in case of tie + if ((y < ymin) || (ymin == y && points[i].x < points[min].x)) + ymin = points[i].y, min = i; + } + // Place the bottom-most point at first position + swap(points[0], points[min]); + // Sort n-1 points with respect to the first point. A point p1 comes + // before p2 in sorted ouput if p2 has larger polar angle (in + // counterclockwise direction) than p1 + p0 = points[0]; + qsort(&points[1], n - 1, sizeof(Point), compare); + // Create an empty stack and push first three points to it. + stack S; + S.push(points[0]); + S.push(points[1]); + S.push(points[2]); + // Process remaining n-3 points + for (int i = 3; i < n; i++) + { + // Keep removing top while the angle formed by points next-to-top, + // top, and points[i] makes a non-left turn + while (orientation(nextToTop(S), S.top(), points[i]) != 2) + S.pop(); + S.push(points[i]); + } + // Now stack has the output points, print contents of stack + while (!S.empty()) + { + Point p = S.top(); + cout << "(" << p.x << ", " << p.y << ")" << endl; + S.pop(); + } +} + +// Driver program to test above functions +int main() +{ + Point points[] = { { 0, 3 }, { 1, 1 }, { 2, 2 }, { 4, 4 }, { 0, 0 }, + { 1, 2 }, { 3, 1 }, { 3, 3 } + }; + int n = sizeof(points) / sizeof(points[0]); + cout << "The points in the convex hull are: \n"; + convexHull(points, n); + return 0; +} + +/* + +The points in the convex hull are: +(0, 3) +(4, 4) +(3, 1) +(0, 0) diff --git a/c++/Computational_Geometry/C++ Program to Implement ILLUSTRATION OF LINKED LIST TO SIMULATE A QUEUE.cpp b/c++/Computational_Geometry/C++ Program to Implement ILLUSTRATION OF LINKED LIST TO SIMULATE A QUEUE.cpp new file mode 100644 index 0000000..701c0c1 --- /dev/null +++ b/c++/Computational_Geometry/C++ Program to Implement ILLUSTRATION OF LINKED LIST TO SIMULATE A QUEUE.cpp @@ -0,0 +1,73 @@ + + +/*------------ ILLUSTRATION OF LINKED LIST TO SIMULATE A QUEUE --------*/ + +/* THIS PROGRAM ILLUSTRATES THE USE OF LINKED LISTS TO IMPLEMENT + THE DATA STRUCTURES LIKE QUEUES. THE PROGRAM ACCEPTS THE WORDS + AND STORES THEM AT DIFFERENT NODES OF THE LINKED LIST. IT THEN + PRINTS THOSE WORDS ON FIFO BASIS. + + INPUTS : WORDS TO THE LINKED LIST. + + OUTPUTS : DISPLAY OF WORDS ON FIFO BASIS + +/*------------------------------ PROGRAM ----------------------------*/ +#include +#include +#include +#include + +#define NULL 0 /* NULL pointer for last node in the list */ + +struct list_element +{ + /* This structure contains data item and pointer to the next node */ + char item[40]; /* This is data item */ + struct list_element *next; /* This is pointer */ +}; +typedef struct list_element node; +/* define the structure 'list_element' of type node */ + +void main() +{ + node *start; /* declaration of the pointer to the nodes */ + void create (node *pt); /* function declaration */ + void display (node *pt); /* function declaration */ + clrscr(); + printf("\n Computational Techniques - J. S. CHITODE"); + printf("\n ILLUSTRATION OF LINKED LIST TO SIMULATE A QUEUE\n"); + start = (node *)malloc(sizeof(node)); + /*allocate the memory for starting node; start is memory address */ + create(start); /* create starting node */ + printf("\nThe contents of the link list are ...\n"); + display (start); /* display the contents of nodes */ +} +/*-----------------------------------------------------------------------*/ + +void create(node * record) /* This function creates nodes in the + link list till 'end' is entered */ +{ + printf("\ndata item = "); + scanf("%s",record->item); /* get the value of data item */ + if(strcmpi(record->item, "end") == 0) record->next = NULL; + /* check whether 'end is entered */ + else + { + record->next = (node *)malloc(sizeof(node)); + create(record->next); + } /* create new node by calling this function recursively */ + return; +} +/*-----------------------------------------------------------------------*/ + +void display (node *record) /* This function is used to display the + contents of linked list */ +{ + if(record->next != NULL) + { + printf("\n%s",record->item); + display(record->next); + } /* This function is called recursively to display all the items */ + return; +} +/*------------------------ END OF PROGRAM ------------------------------*/ diff --git a/c++/Computational_Geometry/C++ Program to Implement ITERATIVE METHOD TO FIND ROOT OF AN EQUATION.cpp b/c++/Computational_Geometry/C++ Program to Implement ITERATIVE METHOD TO FIND ROOT OF AN EQUATION.cpp new file mode 100644 index 0000000..7c39e18 --- /dev/null +++ b/c++/Computational_Geometry/C++ Program to Implement ITERATIVE METHOD TO FIND ROOT OF AN EQUATION.cpp @@ -0,0 +1,63 @@ + +/*-------------- ITERATIVE METHOD TO FIND ROOT OF AN EQUATION -------*/ + +/* THE FUNCTION p(x) FOR AN EQUATION IS DEFINED IN function fx + + THE EQUATION IS, + + x = 1 + 0.3*cos(x) + + p(x) = 1 + 0.3*cos(x) + + i.e. x = p(x) + + INPUTS : 1) Initial approximation x0 to the root. + + 2) Number of iterations. + + OUTPUTS : Value of the root. */ + +/*------------------------------ PROGRAM ----------------------------*/ + +#include +#include +#include +#include + +void main() +{ + double px ( double x); /* DECLARATION OF FUNCTION */ + double x0,x1,p0; + int n,i; + clrscr(); + printf("\n ITERATIVE METHOD TO FIND ROOT OF AN EQUATION"); + printf("\n\n x = 1 + 0.3*cos(x)\n" + " p(x) = 1 + 0.3*cos(x)\n"); + printf("\n\nEnter the value of initial " + "approximation x0 = "); + scanf("%lf",&x0); + /* INITIAL APPROXIMATION x0 IS TO BE ENTERED HERE */ + printf("\nEnter the number of iterations = "); + scanf("%d",&n); + printf("\npress any key for display of iterations...\n"); + getch(); + i = 0; + while(n-- > 0) + { + x1 = px(x0); /* CALCULATION OF NEXT APPROXIMATION */ + i++; + printf("\n%d x%d = %10.10lf",i,i,x1); + x0 = x1; + getch(); + } + printf("\n\nThe value of root is = %20.15lf",x1); /* ROOT */ +} +/*---------- FUNCTION PROCEDURE TO CALCULATE VALUE OF EQUATION --------*/ + +double px ( double x) +{ + double p; + p = 1 + 0.3*cos(x); /* FUNCTION p(x) */ + return(p); +} +/*----------------------------- END OF PROGRAM -------------------------*/ diff --git a/c++/Computational_Geometry/C++ Program to Implement JACOBI'S ITERATION METHOD TO SOLVE LINEAR EQUATIONS.cpp b/c++/Computational_Geometry/C++ Program to Implement JACOBI'S ITERATION METHOD TO SOLVE LINEAR EQUATIONS.cpp new file mode 100644 index 0000000..6230cac --- /dev/null +++ b/c++/Computational_Geometry/C++ Program to Implement JACOBI'S ITERATION METHOD TO SOLVE LINEAR EQUATIONS.cpp @@ -0,0 +1,79 @@ + + +/*----------- JACOBI'S ITERATION METHOD TO SOLVE LINEAR EQUATIONS -----*/ + +/* THE PROGRAM SOLVES THE SYSTEM OF LINEAR EQUATIONS USING + + JACOBI'S ITERATION METHOD. + + INPUTS : 1) Number of variables in the equation. + + 2) Coefficient's of linear equations. + + OUTPUTS : Results of every iteration till 'q' is pressed. */ + +/*--------------------------- PROGRAM -----------------------------*/ + +#include +#include +#include +#include + +void main() +{ + double a[10][10],x[10],y[10]; + /* ARRAY OF a[n][n] STORING COEFFICIENTS OF EQUATIONS */ + int i,j,n; + char ch; + clrscr(); + printf("\n Computational Techniques - J. S. CHITODE"); + printf("\n JACOBI'S ITERATION METHOD TO SOLVE LINEAR EQUATIONS"); + printf("\n\n The form of equations is as follows\n\n" + " a11x1 + a12x2 + ... + a1nxn = b1\n" + " a21x1 + a22x2 + ... + a2nxn = b2\n" + " a31x1 + a32x2 + ... + a3nxn = b3\n" + " ................................\n" + " an1x1 + an2x2 + ... + annxn = bn\n"); + printf("\n\nEnter the number of variables (max 10) = "); + /* ENTER THE NUMBER OF VARIABLES IN THE EQUATION */ + scanf("%d",&n); + for(i = 1; i <= n; i++) + { + /* LOOP TO GET COEFFICIENTS a11,a12...,ann & so on */ + for(j = 1; j <= n; j++) + { + printf("a%d%d = ",i,j); + scanf("%lf",&a[i][j]); + } + printf("b%d = ",i); + scanf("%lf",&a[i][j]); + x[i] = y[i] = 0; + } + printf("\n\nThe results are as follows....\n\n" + "press 'enter' key to continue iterations &" + " press 'q' to stop iterations....\n\n"); + while(ch != 'q') + { + for(i = 1; i <= n; i++) + { + /* LOOP TO CALCULATE VALUES OF x1,x2,...,xn etc */ + for(j = 1; j <= n; j++) + { + if(i == j) continue; + x[i] = x[i] - a[i][j]*y[j]; + } + x[i] = x[i] + a[i][j]; + x[i] = x[i]/a[i][i]; + } + for(i = 1; i <= n; i++) + { + /* LOOP TO PRINT VALUES OF x1,x2,...xn etc */ + y[i] = x[i]; + printf("x%d = %lf ",i,x[i]); + x[i] = 0; + } + ch = getch(); + printf("\n\n"); + } +} +/*-------------------------------- END OF PROGRAM -----------------------*/ diff --git a/c++/Computational_Geometry/C++ Program to Implement Jarvis March to Find the Convex Hull.cpp b/c++/Computational_Geometry/C++ Program to Implement Jarvis March to Find the Convex Hull.cpp new file mode 100644 index 0000000..cba9b0e --- /dev/null +++ b/c++/Computational_Geometry/C++ Program to Implement Jarvis March to Find the Convex Hull.cpp @@ -0,0 +1,85 @@ +/*This is a C++ Program to implement Jarvis March to find convex hull. The idea of Jarvis’s Algorithm is simple, we start from the leftmost point (or point with minimum x coordinate value) and we keep wrapping points in counterclockwise direction.*/ + +// A C++ program to find convex hull of a set of points +// Refer http://www.geeksforgeeks.org/check-if-two-given-line-segments-intersect/ +// for explanation of orientation() +#include +using namespace std; + +// Define Infinite (Using INT_MAX caused overflow problems) +#define INF 10000 + +struct Point +{ + int x; + int y; +}; + +// To find orientation of ordered triplet (p, q, r). +// The function returns following values +// 0 --> p, q and r are colinear +// 1 --> Clockwise +// 2 --> Counterclockwise +int orientation(Point p, Point q, Point r) +{ + int val = (q.y - p.y) * (r.x - q.x) - (q.x - p.x) * (r.y - q.y); + if (val == 0) + return 0; // colinear + return (val > 0) ? 1 : 2; // clock or counterclock wise +} + +// Prints convex hull of a set of n points. +void convexHull(Point points[], int n) +{ + // There must be at least 3 points + if (n < 3) + return; + // Initialize Result + int next[n]; + for (int i = 0; i < n; i++) + next[i] = -1; + // Find the leftmost point + int l = 0; + for (int i = 1; i < n; i++) + if (points[i].x < points[l].x) + l = i; + // Start from leftmost point, keep moving counterclockwise + // until reach the start point again + int p = l, q; + do + { + // Search for a point 'q' such that orientation(p, i, q) is + // counterclockwise for all points 'i' + q = (p + 1) % n; + for (int i = 0; i < n; i++) + if (orientation(points[p], points[i], points[q]) == 2) + q = i; + next[p] = q; // Add q to result as a next point of p + p = q; // Set p as q for next iteration + } + while (p != l); + // Print Result + for (int i = 0; i < n; i++) + { + if (next[i] != -1) + cout << "(" << points[i].x << ", " << points[i].y << ")\n"; + } +} + +// Driver program to test above functions +int main() +{ + Point points[] = { { 0, 3 }, { 2, 2 }, { 1, 1 }, { 2, 1 }, { 3, 0 }, + { 0, 0 }, { 3, 3 } + }; + cout << "The points in the convex hull are: "; + int n = sizeof(points) / sizeof(points[0]); + convexHull(points, n); + return 0; +} + +/* +The points in the convex hull are: (0, 3) +(3, 0) +(0, 0) +(3, 3) \ No newline at end of file diff --git a/c++/Computational_Geometry/C++ Program to Implement LAGRANGE'S INTERPOLATION METHOD.cpp b/c++/Computational_Geometry/C++ Program to Implement LAGRANGE'S INTERPOLATION METHOD.cpp new file mode 100644 index 0000000..ac49536 --- /dev/null +++ b/c++/Computational_Geometry/C++ Program to Implement LAGRANGE'S INTERPOLATION METHOD.cpp @@ -0,0 +1,58 @@ + + +/*----------------- LAGRANGE'S INTERPOLATION METHOD --------------------*/ + +/* THE PROGRAM CALCULATES THE VALUE OF f(x) AT GIVEN VALUE OF x + USING LAGRANGE'S INTERPOLATION METHOD. + + INPUTS : 1) Number of entries of the data. + + 2) Values of 'x' & corresponding y = f(x). + + 3) Value of 'xr' at which y = f(x) to be calculated. + + OUTPUTS : Interpolated value f(x) at x = xr. */ + +/*------------------------------ PROGRAM ----------------------------*/ + +#include +#include +#include +#include + +void main() +{ + double y[20],x[20],xr,fy,num,den; + int i,j,n; + clrscr(); + printf("\n LAGRANGE'S INTERPOLATION TECHNIQUE"); + printf("\n\nEnter the number of entries (max 20) = "); + /* ENTER THE NUMBER OF ENTRIES */ + scanf("%d",&n); + for(i = 0; i < n; i++) + { + /* LOOP TO GET x AND y = f(x) IN THE ARRAY */ + printf("x%d = ",i); + scanf("%lf",&x[i]); + printf(" y%d = ",i); + scanf("%lf",&y[i]); + } + printf("\nEnter the value of xr at which y = f(x)\n\t\t\t" + "is to be interpolated, xr = "); + scanf("%lf",&xr); + fy = 0; + for(j = 0; j < n; j++) + { + /* LOOP TO CALCULATE LAGRANGE'S INTERPOLATION */ + num = den = 1; + for(i = 0; i < n; i++) + { + if(i == j) continue; + num = num * (xr - x[i]); + den = den * (x[j] - x[i]); + } + fy = fy + ((num/den) * y[j]); + } + printf("\nThe value of y = f(x) at xr = %lf is yr = %lf", xr,fy); +} +/*--------------------------- END OF PROGRAM ----------------------------*/ diff --git a/c++/Computational_Geometry/C++ Program to Implement MODIFIED EULER'S METHOD TO SOLVE DIFFERENTIAL EQUATION.cpp b/c++/Computational_Geometry/C++ Program to Implement MODIFIED EULER'S METHOD TO SOLVE DIFFERENTIAL EQUATION.cpp new file mode 100644 index 0000000..03460b0 --- /dev/null +++ b/c++/Computational_Geometry/C++ Program to Implement MODIFIED EULER'S METHOD TO SOLVE DIFFERENTIAL EQUATION.cpp @@ -0,0 +1,71 @@ + + +/*------- MODIFIED EULER'S METHOD TO SOLVE DIFFERENTIAL EQUATION ------*/ + +/* THIS PROGRAM CALCULATES THE VALUE y AT GIVEN VALUE OF x + USING MODIFIED EULER'S METHOD. THE FUNCTION y' = f(x,y) IS + DEFINED IN THE PROGRAM. + + y' = x*x + y + Hence f(x,y) = x*x + y + + INPUTS : 1) Initial values of x and y. + + 2) Step size h. + + OUTPUTS : Calculated values of y at every step. */ + +/*------------------------------ PROGRAM --------------------------*/ + +#include +#include +#include +#include + +void main() +{ + double f (double x0,double y0); /* DECLARATION OF A FUNCTION f */ + double y0,y1,y10,x0,x1,h,x,diff; + int i,n; + clrscr(); + printf("\n\tMODIFIED EULER'S METHOD TO SOLVE DIFFERENTIAL EQUATION"); + printf("\n\nEnter x0 = "); + scanf("%lf",&x0); /* ENTER VALUE OF x0 */ + printf("\n\nEnter y0 = "); + scanf("%lf",&y0); /* ENTER VALUE OF y0 */ + printf("\n\nEnter the value of x at which y is to be found = "); + scanf("%lf",&x); /* ENTER VALUE OF x */ + printf("\n\nEnter the value of h = "); + scanf("%lf",&h); /* ENTER THE VALUE OF h */ + i = 0; + printf("\nPress any key to see step by step display of results...\n"); + while(x0 < x) /* LOOP TO CALCULATE y USING MODIFIED EULER'S FORMULA*/ + { + i++; + x1 = x0 + h; + y1 = y0 + h * f(x0,y0); /* PREDICTOR EQUATION */ + y10 = y1; + do /* LOOP TO IMPLEMENT CORRECTOR FORMULA */ + { + y1 = y0 + (h/2) * ( f(x0,y0) + f(x1,y10) ); + diff = fabs(y1 - y10); /* CHECK FOR HOW MANY DIGITS + ARE REPEATING AFTER DECIMAL POINT*/ + y10 = y1; + } + while( diff > 0.0001); + /*REMAIN IN LOOP TILL 3 DIGITS REPEAT AFTER DECIMAL POINT*/ + printf("\nx%d = %lf y%d = %lf",i,x1,i,y1); + x0 = x1; + y0 = y1; + getch(); + } +} +/*---------------------------------------------------------------------*/ + +double f ( double x,double y) /* FUNCTION TO CALCULATE VALUE OF f(x,y)*/ +{ + double y_dash; + y_dash = x*x + y; /* function f(x,y) = y' = x*x + y */ + return(y_dash); +} +/*------------------------ END OF PROGRAM -----------------------------*/ diff --git a/c++/Computational_Geometry/C++ Program to Implement NEWTON RAPHSON METHOD TO FIND ROOT OF AN EQUATION.cpp b/c++/Computational_Geometry/C++ Program to Implement NEWTON RAPHSON METHOD TO FIND ROOT OF AN EQUATION.cpp new file mode 100644 index 0000000..4c68384 --- /dev/null +++ b/c++/Computational_Geometry/C++ Program to Implement NEWTON RAPHSON METHOD TO FIND ROOT OF AN EQUATION.cpp @@ -0,0 +1,72 @@ + +/*----------- NEWTON RAPHSON METHOD TO FIND ROOT OF AN EQUATION -------*/ + +/* THE EXPRESSION FOR AN EQUATION IS DEFINED IN function fx + YOU CAN WRITE DIFFERENT EQUATION IN function fx. + HERE, + f(x) = x*x*x - 5*x + 3 + + INPUTS : 1) Initial approximation x0 to the root. + + 2) Number of iterations. + + OUTPUTS : Value of the root. */ + +/*------------------------------ PROGRAM ----------------------------*/ + +#include +#include +#include +#include + +void main() +{ + double fx ( double x); /* DECLARATION OF FUNCTION */ + double f_x ( double x); /* CALCULATION OF DERIVATIVE */ + double x0,x1,f_0,f0; + int n,i; + clrscr(); + printf("\n NEWTON RAPHSON METHOD TO FIND ROOT OF AN EQUATION"); + printf("\n\n f(x) = x*x*x - 5*x + 3"); + printf("\n\nEnter the value of initial " + "approximation x0 = "); + scanf("%lf",&x0); + /* INITIAL APPROXIMATION x0 IS TO BE ENTERED HERE */ + printf("\nEnter the number of iterations = "); + scanf("%d",&n); + printf("\npress any key for display of iterations...\n"); + getch(); + i = 0; + while(n-- > 0) + { + f0 = fx(x0); /* CALCULATE f(x) AT x = x0 */ + f_0 = f_x(x0); /* CALCULATE f'(x) AT x = x1 */ + x1 = x0 - (f0/f_0); + /* CALCULATION OF NEXT APPROXIMATION */ + i++; + printf("\n%d x%d = %lf \n" + "\n f%d = %lf f_%d = %lf x%d = %lf\n" + ,i,i-1,x0,i-1,f0,i-1,f_0,i,x1); + x0 = x1; + getch(); + } + printf("\n\nThe value of root is = %20.15lf",x1); /* ROOT */ +} +/*---------- FUNCTION PROCEDURE TO CALCULATE VALUE OF EQUATION --------*/ + +double fx ( double x) +{ + double f; + f = x*x*x - 5*x + 3; /* FUNCTION f(x) */ + return(f); +} + +/*---------- FUNCTION PROCEDURE TO CALCULATE f'(x0) --------------------*/ + +double f_x ( double x) +{ + double f_dash; + f_dash = 3*x*x - 5; /* DERIVATIVE OF f(x) i.e. f'(x) */ + return(f_dash); +} +/*--------------------- End of program --------------------------------*/ diff --git a/c++/Computational_Geometry/C++ Program to Implement NEWTON'S BACKWARD DIFFERENCES INTERPOLATION METHOD.cpp b/c++/Computational_Geometry/C++ Program to Implement NEWTON'S BACKWARD DIFFERENCES INTERPOLATION METHOD.cpp new file mode 100644 index 0000000..346158c --- /dev/null +++ b/c++/Computational_Geometry/C++ Program to Implement NEWTON'S BACKWARD DIFFERENCES INTERPOLATION METHOD.cpp @@ -0,0 +1,74 @@ + + +/*------ NEWTON'S BACKWARD DIFFERENCES INTERPOLATION METHOD -----------*/ + +/* THE PROGRAM GENERATES A BACKWARD DIFFERENCES TABLE FROM GIVEN + + DATA, & CALCULATES THE VALUE OF f(x) AT GIVEN VALUE OF x. + + INPUTS : 1) Number of entries of the data. + + 2) Values of 'x' & corresponding y = f(x). + + 3) Value of 'xr' at which y = f(x) to be calculated. + + OUTPUTS : Interpolated value f(x) at x = xr. */ + +/*------------------------------ PROGRAM ---------------------------*/ + +#include +#include +#include +#include + +void main() +{ + double y[20][20],x[20],xr,yr,h,r,sum,fy,facto; + int i,j,k,n,m,t; + clrscr(); + printf("\n\tNEWTON'S BACKWARD DIFFERENCES INTERPOLATION TECHNIQUE"); + printf("\n\nEnter the number of entries (max 20) = "); + /* ENTER THE NUMBER OF ENTRIES IN THE TABLE */ + scanf("%d",&n); + for(i = 0; i < n; i++) + { + /* LOOP TO GET x AND y = f(x) IN THE TABLE */ + printf("x%d = ",i); + scanf("%lf",&x[i]); + printf(" y%d = ",i); + scanf("%lf",&y[i][0]); + } + printf("\nEnter the value of xr at which y = f(x)\nis to be " + "interpolated, xr = "); + scanf("%lf",&xr); + h = x[1] - x[0]; + r = (xr - x[n-1])/h; /* CALCULATE VALUE OF 'r' */ + printf("\nThe value of h = %lf and value of r = %lf\n",h,r); + k = 0; + for(j = 1; j < n; j++) + { + /* LOOP TO CALCULATE BACKWARD DIFFERENCES */ + k++; + for(i = n-1; i >= k; i--) + { + y[i][j] = y[i][j-1] - y[i-1][j-1]; + } + } + sum = 0; + for(t = 1; t < n; t++) + { + /* LOOP FOR NEWTON'S BACKWARD DIFFERENCE INTERPOLATION FORMULA */ + fy = 1; + facto = 1; + for(m = 0; m < t; m++) + { + fy = fy * (r + m); + facto = facto * (m + 1); + } + fy = fy * (y[n-1][t]/facto); + sum = sum + fy; + } + yr = sum + y[n-1][0]; + printf("\nThe value of y = f(x) at xr = %lf is yr = %lf", xr,yr); +} +/*--------------------------- END OF PROGRAM ---------------------------*/ diff --git a/c++/Computational_Geometry/C++ Program to Implement NEWTON'S DIVIDED DIFFERENCES INTERPOLATION METHOD.cpp b/c++/Computational_Geometry/C++ Program to Implement NEWTON'S DIVIDED DIFFERENCES INTERPOLATION METHOD.cpp new file mode 100644 index 0000000..6d474f3 --- /dev/null +++ b/c++/Computational_Geometry/C++ Program to Implement NEWTON'S DIVIDED DIFFERENCES INTERPOLATION METHOD.cpp @@ -0,0 +1,74 @@ + + +/*------------ NEWTON'S DIVIDED DIFFERENCES INTERPOLATION METHOD --------*/ + +/* THE PROGRAM GENERATES A DIVIDED DIFFERENCES TABLE FROM GIVEN + + DATA, AND IT CALCULATES THE VALUE OF f(x) AT GIVEN VALUE + + OF xr. + + INPUTS : 1) Number of entries of the data. + + 2) Values of 'x' & corresponding y = f(x). + + 3) Value of xr at which f(x) is to be interpolated. + + VALUES OF x NEED NOT BE EQUALLY SPACED. + + OUTPUTS : Interpolated value of f(x) at x = xr. */ + +/*------------------------------ PROGRAM ----------------------------*/ + +#include +#include +#include +#include + +void main() +{ + double y[20][20],x[20],sum,fy,xr; + /* ARRAY OF y[n][n] ELEMENTS FOR DIVIDED DIFFERENCE TABLE */ + int i,j,k,n,t,m; + clrscr(); + printf("\n NEWTON'S DIVIDED DIFFERENCES INTERPOLATION METHOD"); + printf("\n\nEnter the number of entries (max 20) = "); + /* ENTER THE NUMBER OF ENTRIES IN THE TABLE */ + scanf("%d",&n); + for(i = 0; i < n; i++) + { + /* LOOP TO GET x AND y = f(x) IN THE TABLE */ + printf("x%d = ",i); + scanf("%lf",&x[i]); + printf(" y%d = ",i); + scanf("%lf",&y[i][0]); + } + printf("\nEnter the value of xr at which y = f(x) is to be" + " calculated xr = "); + scanf("%lf",&xr); + k = n; + for(j = 1; j < n; j++) + { + /* LOOP TO CALCULATE DIVIDED DIFFERENCES IN THE TABLE */ + k = k - 1; + for(i = 0; i < k; i++) + { + y[i][j] = (y[i+1][j-1] - y[i][j-1])/(x[i+j]-x[i]); + } + } + sum = 0; + for(t = 1; t < n; t++) + { + /* LOOP TO CALCULATE INTERPOLATED VALUE OF 'y' */ + fy = 1; + for(m = 0; m < t; m++) + { + fy = fy * (xr - x[m]); + } + sum = sum + (fy * y[0][t]); + } + sum = sum + y[0][0]; + printf("\nThe interpolated value of y at xr = %lf" + " is yr = %lf\n",xr,sum); +} +/*-------------------- END OF PROGRAM ---------------------------------*/ diff --git a/c++/Computational_Geometry/C++ Program to Implement NEWTON'S FORWARD DIFFERENCES INTERPOLATION METHOD.cpp b/c++/Computational_Geometry/C++ Program to Implement NEWTON'S FORWARD DIFFERENCES INTERPOLATION METHOD.cpp new file mode 100644 index 0000000..963b6e9 --- /dev/null +++ b/c++/Computational_Geometry/C++ Program to Implement NEWTON'S FORWARD DIFFERENCES INTERPOLATION METHOD.cpp @@ -0,0 +1,74 @@ + + +/*------ NEWTON'S FORWARD DIFFERENCES INTERPOLATION METHOD ------------*/ + +/* THE PROGRAM GENERATES A FORWARD DIFFERENCES TABLE FROM GIVEN + + DATA, & CALCULATES THE VALUE OF f(x) AT GIVEN VALUE OF x. + + INPUTS : 1) Number of entries of the data. + + 2) Values of 'x' & corresponding y = f(x). + + 3) Value of 'xr' at which y = f(x) to be calculated. + + OUTPUTS : Interpolated value f(x) at x = xr. */ + +/*------------------------------ PROGRAM ---------------------------*/ + +#include +#include +#include +#include + +void main() +{ + double y[20][20],x[20],xr,yr,h,r,sum,fy,facto; + int i,j,k,n,m,t; + clrscr(); + printf("\n\tNEWTON'S FORWARD DIFFERENCES INTERPOLATION TECHNIQUE"); + printf("\n\nEnter the number of entries (max 20) = "); + /* ENTER THE NUMBER OF ENTRIES IN THE TABLE */ + scanf("%d",&n); + for(i = 0; i < n; i++) + { + /* LOOP TO GET x AND y = f(x) IN THE TABLE */ + printf("x%d = ",i); + scanf("%lf",&x[i]); + printf(" y%d = ",i); + scanf("%lf",&y[i][0]); + } + printf("\nEnter the value of xr at which y = f(x) is to be " + "interpolated, xr = "); + scanf("%lf",&xr); + h = x[1] - x[0]; + r = (xr - x[0])/h; /* CALCULATE VALUE OF 'r' */ + printf("\nThe value of h = %lf and value of r = %lf\n",h,r); + k = n; + for(j = 1; j < n; j++) + { + /* LOOP TO CALCULATE FORWARD DIFFERENCES IN THE TABLE */ + k = k - 1; + for(i = 0; i < k; i++) + { + y[i][j] = y[i+1][j-1] - y[i][j-1]; + } + } + sum = 0; + for(t = 1; t < n; t++) + { + /* LOOP FOR NEWTON'S FORWARD DIFFERENCE INTERPOLATION FORMULA */ + fy = 1; + facto = 1; + for(m = 0; m < t; m++) + { + fy = fy * (r - m); + facto = facto * (m + 1); + } + fy = fy * (y[0][t]/facto); + sum = sum + fy; + } + yr = sum + y[0][0]; + printf("\nThe value of y = f(x) at xr = %lf is yr = %lf", xr,yr); +} +/*--------------------------- END OF PROGRAM --------------------------*/ diff --git a/c++/Computational_Geometry/C++ Program to Implement NUMERICAL INTEGRATION USING MONTE CARLO METHOD.cpp b/c++/Computational_Geometry/C++ Program to Implement NUMERICAL INTEGRATION USING MONTE CARLO METHOD.cpp new file mode 100644 index 0000000..753001d --- /dev/null +++ b/c++/Computational_Geometry/C++ Program to Implement NUMERICAL INTEGRATION USING MONTE CARLO METHOD.cpp @@ -0,0 +1,55 @@ + + +/*----------- NUMERICAL INTEGRATION USING MONTE CARLO METHOD ----------*/ + +/* THIS PROGRAM INTEGRATES A FUNCTION USING MONTE CARLO METHOD. + IT USES PSEUDORANDOM NUMBERS FOR INTEGRATION. + + f(x) = x*x*x + 7*x*x + 8*x + 1 + + INPUTS : Number of random numbers to be used for integration. + + OUTPUTS : Integration of f(x) over 0 to 1. */ + +/*------------------------------ PROGRAM ---------------------------*/ + +#include +#include +#include +#include + +void main() +{ + double f ( double x); /* FUNCTION TO EVALUATE f(x) */ + double x,sum,n,k; + clrscr(); + printf("\n Computational Techniques - J. S. CHITODE"); + printf("\n NUMERICAL INTEGRATION USING MONTE CARLO METHOD\n"); + printf("\n The function being integrated over" + " limits (0,1) is \n\n" + " f(x) = x*x*x + 7*x*x + 8*x + 1\n"); + randomize(); /* INITIALIZATION OF PSEUDORANDOM NUMBER GENERATOR */ + printf("\nEnter the number of pseudorandom numbers\nto be " + "used for monte carlo integration = "); + scanf("%lf",&n); + k = n; + sum = 0; + while(n-- > 0) + { + x = rand()/(RAND_MAX + 1.0); + /* CALLING PSEUDORANDOM NUMBER GENERATOR */ + sum = sum + f(x); + } + sum = sum/k; + printf("\nThe result of integration is = %lf",sum); +} +/*--------------------------------------------------------------------*/ + +double f ( double x) +{ + double fx; + fx = x*x*x + 7*x*x + 8*x + 1; + /* EVALUATION OF f(x) AT x = PSEUDORANDOM NUMBER */ + return(fx); +} +/*------------------------- END OF PROGRAM --------------------------*/ diff --git a/c++/Computational_Geometry/C++ Program to Implement PSEUDORANDOM NUMBER GENERATION.cpp b/c++/Computational_Geometry/C++ Program to Implement PSEUDORANDOM NUMBER GENERATION.cpp new file mode 100644 index 0000000..2e1564b --- /dev/null +++ b/c++/Computational_Geometry/C++ Program to Implement PSEUDORANDOM NUMBER GENERATION.cpp @@ -0,0 +1,47 @@ + + +/*------------------ PSEUDORANDOM NUMBER GENERATION -------------------*/ + +/* THIS PROGRAM GENERATES A PSEUDORANDOM NUMBER USING STANDARD + FUNCTIONS IN C. + + INPUTS : None + + OUTPUTS : Random numbers between 0 and 1. */ + +/*------------------------------ PROGRAM ---------------------------*/ + +#include +#include +#include +#include + +void main() +{ + double x; + int k; + char ch; + clrscr(); + printf("\n Computational Techniques - J. S. CHITODE"); + printf("\n PSEUDORANDOM NUMBER GENERATION\n"); + randomize(); /* INITIALIZATION OF PSEUDORANDOM NUMBER GENERATOR */ + printf("\nThe sequence of pesudorandom numbers between 0 & 1 " + "is displayed below.\nPress any key to continue and " + "press 'q' to stop....\n\n"); + k = 0; + while(ch != 'q') + { + x = rand()/(RAND_MAX + 1.0); + /* CALLING PSEUDORANDOM NUMBER GENERATOR */ + printf("%lf ",x); + k++; + if(k == 6) + { + /* TO PRINT 6 PSEUDORANDOM NUMBERS ON ONE LINE */ + printf("\n"); + k = 0; + } + ch = getch(); + } +} +/*------------------------- END OF PROGRAM ----------------------------*/ diff --git a/c++/Computational_Geometry/C++ Program to Implement REGULA FALSI METHOD TO FIND ROOT OF AN EQUATION.cpp b/c++/Computational_Geometry/C++ Program to Implement REGULA FALSI METHOD TO FIND ROOT OF AN EQUATION.cpp new file mode 100644 index 0000000..3ed87c7 --- /dev/null +++ b/c++/Computational_Geometry/C++ Program to Implement REGULA FALSI METHOD TO FIND ROOT OF AN EQUATION.cpp @@ -0,0 +1,74 @@ + +/*----------- REGULA FALSI METHOD TO FIND ROOT OF AN EQUATION --------*/ + +/* THE EXPRESSION FOR AN EQUATION IS DEFINED IN function fx + YOU CAN WRITE DIFFERENT EQUATION IN function fx. + HERE, + f(x) = exp(x) - 4*x + + INPUTS : 1) Initial interval [x0,x1] in which root is to + be found. + 2) Number of iterations for given interval and + permissible error. + + OUTPUTS : Value of the root in given interval. */ + +/*------------------------------ PROGRAM --------------------------*/ + +#include +#include +#include +#include + +void main() +{ + double fx ( double x); /* DECLARATION OF FUNCTION */ + double x0,x1,x2,f0,f1,f2,err; + int n,i; + clrscr(); + printf("\n REGULA FALSI METHOD TO FIND ROOT OF AN EQUATION"); + printf("\n\n f(x) = exp(x) - 4*x"); + printf("\n\nEnter an interval [x0,x1] in " + "which root is to be found"); + printf("\nx0 = "); + scanf("%lf",&x0); /* INTERVAL [x0,x1] IS TO BE ENTERED HERE */ + printf("x1 = "); + scanf("%lf",&x1); + printf("\nEnter the number of iterations = "); + scanf("%d",&n); + printf("\npress any key for display of iterations...\n"); + getch(); + i = 0; + while(n-- > 0) + { + f0 = fx(x0); /* CALCULATE f(x) AT x = x0 */ + f1 = fx(x1); /* CALCULATE f(x) AT x = x1 */ + x2 = x1 - ((x1 - x0)/(f1 - f0)) * f1; + /* CALCULATION OF NEXT APPROXIMATION */ + f2 = fx(x2); + i++; + printf("\n\n%d\tx[%d] = %lf\t\tx[%d] = %lf\tx[%d] = %lf\n" + "\tf[%d] = %lf\tf[%d] = %lf\t f[%d] = %lf\n" + ,i,i,x1,i-1,x0,i+1,x2,i,f1,i-1,f0,i+1,f2); + if((f0 * f2) < 0) x1 = x2; + if((f1 * f2) < 0) + { + x0 = x1; + x1 = x2; + } + printf("\nNew interval : x[%d] = %lf\t x[%d] = %lf" + ,i-1,x0,i+1,x1); + getch(); + } + printf("\n\nThe value of root is = %20.15lf",x2); /* ROOT */ +} +/*---------- FUNCTION PROCEDURE TO CALCULATE VALUE OF EQUATION --------*/ + +double fx ( double x) +{ + double f; + f = exp(x) - 4*x; /* FUNCTION f(x) */ + return(f); +} +/*------------------------- END OF PROGRAM ----------------------------*/ + diff --git a/c++/Computational_Geometry/C++ Program to Implement RUNG KUTTA METHOD TO SOLVE DIFFERENTIAL EQUATION.cpp b/c++/Computational_Geometry/C++ Program to Implement RUNG KUTTA METHOD TO SOLVE DIFFERENTIAL EQUATION.cpp new file mode 100644 index 0000000..2cbee78 --- /dev/null +++ b/c++/Computational_Geometry/C++ Program to Implement RUNG KUTTA METHOD TO SOLVE DIFFERENTIAL EQUATION.cpp @@ -0,0 +1,67 @@ + + +/*----------- RUNG KUTTA METHOD TO SOLVE DIFFERENTIAL EQUATION --------*/ + +/* THIS PROGRAM CALCULATES THE VALUE y AT GIVEN VALUE OF x + USING FOURTH ORDER RUNG KUTTA METHOD. THE FUNCTION y' = f(x,y) + IS DEFINED IN THE PROGRAM. + + y' = 1 + y*y + Hence f(x,y) = 1 + y*y + + INPUTS : 1) Initial values of x and y. + + 2) Step size h. + + OUTPUTS : Calculated values of y at every step. */ + +/*------------------------------ PROGRAM --------------------------*/ + +#include +#include +#include +#include + +void main() +{ + double f (double x0,double y0); /* DECLARATION OF A FUNCTION f */ + double y0,y1,x0,x1,h,x,k1,k2,k3,k4,k; + int i,n; + clrscr(); + printf("\n\tRUNG KUTTA METHOD TO SOLVE DIFFERENTIAL EQUATION\n"); + printf("\n\nEnter x0 = "); + scanf("%lf",&x0); /* ENTER VALUE OF x0 */ + printf("\n\nEnter y0 = "); + scanf("%lf",&y0); /* ENTER VALUE OF y0 */ + printf("\n\nEnter the value of x at which y is to be found = "); + scanf("%lf",&x); /* ENTER VALUE OF x */ + printf("\n\nEnter the value of h = "); + scanf("%lf",&h); /* ENTER THE VALUE OF h */ + i = 0; + printf("\nPress any key to see step by step display of results...\n"); + while(x0 < x) /* LOOP TO CALCULATE y USING RUNG KUTTA METHOD */ + { + i++; + k1 = f(x0,y0); + k2 = f(x0+h/2, y0+(h*k1/2)); + k3 = f(x0+h/2, y0+(h*k2/2)); + k4 = f(x0+h, y0+h*k3); + /* CALCULATION OF k USING RUNG KUTTA METHOD */ + y1 = y0 + (h/6)*(k1 + 2*k2 + 2*k3 + k4); + /* CALCULATION OF y FROM VALUES OF k */ + x1 = x0 + h; + printf("\nx%d = %lf y%d = %lf",i,x1,i,y1); + x0 = x1; + y0 = y1; + getch(); + } +} +/*---------------------------------------------------------------------*/ + +double f ( double x,double y) /* FUNCTION TO CALCULATE VALUE OF f(x,y)*/ +{ + double y_dash; + y_dash = 1 + y*y; /* function f(x,y) = y' = 1 + y*y */ + return(y_dash); +} +/*------------------------ END OF PROGRAM -----------------------------*/ diff --git a/c++/Computational_Geometry/C++ Program to Implement SECANT METHOD TO FIND ROOT OF AN EQUATION.cpp b/c++/Computational_Geometry/C++ Program to Implement SECANT METHOD TO FIND ROOT OF AN EQUATION.cpp new file mode 100644 index 0000000..6261f46 --- /dev/null +++ b/c++/Computational_Geometry/C++ Program to Implement SECANT METHOD TO FIND ROOT OF AN EQUATION.cpp @@ -0,0 +1,67 @@ + + +/*--------------- SECANT METHOD TO FIND ROOT OF AN EQUATION ----------*/ + +/* THE EXPRESSION FOR AN EQUATION IS DEFINED IN function fx + YOU CAN WRITE DIFFERENT EQUATION IN function fx. + HERE, + f(x) = x*x*x - 5*x - 7 + + INPUTS : 1) Initial interval [x0,x1] in which root is to + be found. + 2) Number of iterations for given interval and + permissible error. + + OUTPUTS : Value of the root in given interval. */ + +/*---------------Program starts here ----------------------------------*/ + +#include +#include +#include +#include + +void main() +{ + double fx ( double x); /* DECLARATION OF FUNCTION */ + double x0,x1,x2,f0,f1,f2,err; + int n,i; + clrscr(); + printf("\n SECANT METHOD TO FIND ROOT OF AN EQUATION"); + printf("\n\n f(x) = x*x*x - 5*x - 7"); + printf("\n\nEnter an interval [x0,x1] in " + "which root is to be found"); + printf("\nx0 = "); + scanf("%lf",&x0); /* INTERVAL [x0,x1] IS TO BE ENTERED HERE */ + printf("x1 = "); + scanf("%lf",&x1); + printf("\nEnter the number of iterations = "); + scanf("%d",&n); + printf("\npress any key for display of iterations...\n"); + getch(); + i = 0; + while(n-- > 0) + { + f0 = fx(x0); /* CALCULATE f(x) AT x = x0 */ + f1 = fx(x1); /* CALCULATE f(x) AT x = x1 */ + x2 = x1 - ((x1 - x0)/(f1 - f0)) * f1; + /* CALCULATION OF NEXT APPROXIMATION */ + i++; + printf("\n%d x[%d] = %lf x[%d] = %lf",i,i-1,x0,i,x1); + printf("\n f[%d] = %lf f[%d] = %lf",i-1,f0,i,f1); + printf("\n x[%d] = %lf",i+1,x2); + x0 = x1; + x1 = x2; + getch(); + } + printf("\n\nThe value of root is = %20.15lf",x2); /* ROOT */ +} +/*---------- FUNCTION PROCEDURE TO CALCULATE VALUE OF EQUATION --------*/ + +double fx ( double x) +{ + double f; + f = x*x*x - 5*x - 7; /* FUNCTION f(x) */ + return(f); +} +/*-------------------------- END OF PROGRAM ---------------------------*/ diff --git a/c++/Computational_Geometry/C++ Program to Implement SELECTION SORT METHOD.cpp b/c++/Computational_Geometry/C++ Program to Implement SELECTION SORT METHOD.cpp new file mode 100644 index 0000000..58a948e --- /dev/null +++ b/c++/Computational_Geometry/C++ Program to Implement SELECTION SORT METHOD.cpp @@ -0,0 +1,57 @@ + + +/*-------------------- SELECTION SORT METHOD -------------------------*/ + +/* THIS PROGRAM SORTS THE INPUT ARRAY INTO ASCENDING ORDER + USING SELECTION SORT METHOD. + + INPUTS : 1) The total number of elements to be sorted. + + 2) Array of numbers. + + OUTPUTS : Sorted array of elements. */ + +/*------------------------------ PROGRAM -------------------------*/ + +#include +#include +#include +#include + +void main() +{ + double x[100],z; /*DECLARATION OF ARRAY */ + int i,n,k; + clrscr(); + printf("\n Computational Techniques - J. S. CHITODE"); + printf("\n SELECTION SORT METHOD\n"); + printf("\n\nEnter the total number of elements " + "to sorted (max 100) = "); + scanf("%d",&n); /* ENTER THE NUMBER OF ELEMENTS TO BE SORTED */ + for(i = 0; i < n; i++) + { + /* LOOP TO ENTER ACTUAL VALUES OF ARRAY ELEMENTS */ + printf("\nx%d = ",i); + scanf("%lf",&x[i]); + } + for(i = 0; i < n-1; i++) + { + /* LOOP TO SORT THE ARRAY */ + for(k = i; k < n-1; k++) + { + if(x[i] > x[k+1]) + { + z = x[i]; + x[i] = x[k+1]; + x[k+1] = z; + } + } + } + printf("\nThe sorted array in ascending order is ....\n"); + for(i = 0; i < n; i++) + { + /* LOOP TO PRINT THE ARRAY */ + printf("\nx%d = %lf",i,x[i]); + } +} +/*------------------------ END OF PROGRAM ------------------------------*/ diff --git a/c++/Computational_Geometry/C++ Program to Implement SIMPSON'S (One Third) RULE OF INTEGRATION.cpp b/c++/Computational_Geometry/C++ Program to Implement SIMPSON'S (One Third) RULE OF INTEGRATION.cpp new file mode 100644 index 0000000..11061ba --- /dev/null +++ b/c++/Computational_Geometry/C++ Program to Implement SIMPSON'S (One Third) RULE OF INTEGRATION.cpp @@ -0,0 +1,64 @@ + + +/*----------------- SIMPSON'S 1/3 RULE OF INTEGRATION -----------------*/ + +/* THIS PROGRAM CALCULATES THE VALUE OF INTEGRATION USING + SIMPSON'S 1/3 RULE. THE FUNCTION TO BE INTEGRATED IS, + + f(x) = 1/(1+x) + + INPUTS : 1) Lower and upper limits of integration. + + 2) Number of intervals. + + OUTPUTS : Result of integration. */ + +/*------------------------------ PROGRAM --------------------------*/ + +#include +#include +#include +#include + +void main() +{ + double fx (double x0); /* DECLARATION OF A FUNCTION fx */ + double lo,up,f[20],h,x0,sum,result; + int i,n; + clrscr(); + printf("\n\t SIMPSON'S 1/3 RULE OF INTEGRATION"); + printf("\n\nEnter the lower limit of integration = "); + scanf("%lf",&lo); /* ENTER LOWER LIMIT OF INTEGRATION */ + printf("\n\nEnter the upper limit of integration = "); + scanf("%lf",&up); /* ENTER UPPER LIMIT OF INTEGRATION */ + printf("\n\nEnter the value of h = "); + scanf("%lf",&h); /* ENTER THE VALUE OF h */ + n = (up - lo)/h; /* CALCULATION VALUE OF n i.e.STRIPS */ + x0 = lo; + for(i = 0; i <= n; i++) /* LOOP TO CALCULATE VALUE OF f(x) */ + { + f[i] = fx(x0); /* FUNCTION fx IS CALLED HERE */ + x0 = x0 + h; /* NEXT VALUE OF x IS CALCULATED HERE */ + } + sum = 0; + for(i = 1; i <= n-1; i = i + 2) + { + sum = sum + 4*f[i]; /* THIS IS sum = 4 * ( odd ordinates ) */ + } + for(i = 2; i <= n-1; i = i + 2) + { + sum = sum + 2*f[i]; /* THIS IS sum = 2 * ( even ordinates ) */ + } + result = (h/3) * ( f[0] + f[n] + sum ); + /* Result = (h/3) * (4 * sum of odd ordinates + + 2 * sum of even rdinates ) */ + printf("\n\nThe result of integration is = %lf",result); +} + +double fx ( double x) /* FUNCTION TO CALCULATE VALUE OF f(x) */ +{ + double f; + f = 1/(1+x); /* function f(x) = 1(1 + x) */ + return(f); +} +/*------------------------ END OF PROGRAM -----------------------------*/ diff --git a/c++/Computational_Geometry/C++ Program to Implement SIMPSON'S (Three Eight) RULE OF INTEGRATION.cpp b/c++/Computational_Geometry/C++ Program to Implement SIMPSON'S (Three Eight) RULE OF INTEGRATION.cpp new file mode 100644 index 0000000..e2a8617 --- /dev/null +++ b/c++/Computational_Geometry/C++ Program to Implement SIMPSON'S (Three Eight) RULE OF INTEGRATION.cpp @@ -0,0 +1,65 @@ + + +/*----------------- SIMPSON'S 3/8 RULE OF INTEGRATION ----------------*/ + +/* THIS PROGRAM CALCULATES THE VALUE OF INTEGRATION USING + SIMPSON'S 3/8 RULE. THE FUNCTION TO BE INTEGRATED IS, + + f(x) = 4 + 2 sin x + + INPUTS : 1) Lower and upper limits of integration. + + 2) Number of intervals. + + OUTPUTS : Result of integration. */ + +/*------------------------------ PROGRAM -------------------------*/ + +#include +#include +#include +#include + +void main() +{ + double fx (double x0); /* DECLARATION OF A FUNCTION fx */ + double lo,up,f[20],h,x0,sum,result; + int i,n; + clrscr(); + printf("\n\t SIMPSON'S 3/8 RULE OF INTEGRATION"); + printf("\n\nEnter the lower limit of integration = "); + scanf("%lf",&lo); /* ENTER LOWER LIMIT OF INTEGRATION */ + printf("\n\nEnter the upper limit of integration = "); + scanf("%lf",&up); /* ENTER UPPER LIMIT OF INTEGRATION */ + printf("\n\nEnter the value of h = "); + scanf("%lf",&h); /* ENTER THE VALUE OF h */ + n = (up - lo)/h; /* CALCULATION VALUE OF n i.e.STRIPS */ + x0 = lo; + for(i = 0; i <= n; i++) /* LOOP TO CALCULATE VALUE OF f(x) */ + { + f[i] = fx(x0); /* FUNCTION fx IS CALLED HERE */ + x0 = x0 + h; /* NEXT VALUE OF x IS CALCULATED HERE */ + } + sum = 0; + for(i = 1; i <= n-1; i++) + { + if(i == 3*(i/3) ) continue; + sum = sum + 3*f[i]; /* 3 * SUM OF ORDINATES NOT MULTIPLE OF 3 */ + } + for(i = 3; i <= n-1; i = i + 3) + { + sum = sum + 2*f[i]; /*2 * SUM OF ORDINATES WHICH ARE MULTIPLE OF 3*/ + } + result = (3*h/8) * ( f[0] + f[n] + sum ); + /*Result = (3h/8) * (3 * sum of ordinates not multiple of 3 + + 2 * sum of ordinates which are multiple of 3 ) */ + printf("\n\nThe result of integration is = %lf",result); +} + +double fx ( double x) /* FUNCTION TO CALCULATE VALUE OF f(x) */ +{ + double f; + f = 4 + 2 * sin(x); /* function f(x) = 4 + 2 sin x */ + return(f); +} +/*------------------------ END OF PROGRAM ------------------------------*/ diff --git a/c++/Computational_Geometry/C++ Program to Implement Slicker Algorithm that avoids Triangulation to Find Area of a Polygon.cpp b/c++/Computational_Geometry/C++ Program to Implement Slicker Algorithm that avoids Triangulation to Find Area of a Polygon.cpp new file mode 100644 index 0000000..4fe109f --- /dev/null +++ b/c++/Computational_Geometry/C++ Program to Implement Slicker Algorithm that avoids Triangulation to Find Area of a Polygon.cpp @@ -0,0 +1,80 @@ +/*This is a C++ Program to find the area of ploygon using slicker algorithm. The algorithm assumes the usual mathematical convention that positive y points upwards. In computer systems where positive y is downwards (most of them) the easiest thing to do is list the vertices counter-clockwise using the “positive y down” coordinates. The two effects then cancel out to produce a positive area.*/ + +#include + +using namespace std; + +const int MAXPOLY = 200; +double EPSILON = 0.000001; + +class Point +{ +private: +public: + double x, y; +}; + +class Polygon +{ +private: +public: + Point p[MAXPOLY]; + int n; + + Polygon() + { + for (int i = 0; i < MAXPOLY; i++) + Point p[i];// = new Point(); + } +}; + +double area(Polygon p) +{ + double total = 0; + for (int i = 0; i < p.n; i++) + { + int j = (i + 1) % p.n; + total += (p.p[i].x * p.p[j].y) - (p.p[j].x * p.p[i].y); + } + return total / 2; +} + +int main(int argc, char **argv) +{ + Polygon p; + cout << "Enter the number of points in Polygon: "; + cin >> p.n; + cout << "Enter the coordinates of each point: "; + for (int i = 0; i < p.n; i++) + { + cin >> p.p[i].x; + cin >> p.p[i].y; + } + double a = area(p); + if (a > 0) + cout << "The Area of Polygon with " << (p.n) + << " points using Slicker Algorithm is : " << a; + else + cout << "The Area of Polygon with " << p.n + << " points using Slicker Algorithm is : " << (a * -1); +} + +/* + +Enter the number of points in Polygon: 4 +Enter the coordinates of each point: +1 1 +1 6 +6 6 +6 1 +The Area of Polygon with 4 points using Slicker Algorithm is : 25 + +Enter the number of points in Polygon: +5 +Enter the coordinates of each point: +1 2 +4 5 +9 8 +3 2 +1 5 +The Area of Polygon with 5points using Slicker Algorithm is : 6.0 \ No newline at end of file diff --git a/c++/Computational_Geometry/C++ Program to Implement TRAPEZOIDAL RULE OF INTEGRATION.cpp b/c++/Computational_Geometry/C++ Program to Implement TRAPEZOIDAL RULE OF INTEGRATION.cpp new file mode 100644 index 0000000..7d0580d --- /dev/null +++ b/c++/Computational_Geometry/C++ Program to Implement TRAPEZOIDAL RULE OF INTEGRATION.cpp @@ -0,0 +1,58 @@ + + +/*----------------- TRAPEZOIDAL RULE OF INTEGRATION -------------------*/ + +/* THIS PROGRAM CALCULATES THE VALUE OF INTEGRATION USING + TRAPEZIODAL RULE. THE FUNCTION TO BE INTEGRATED IS, + + f(x) = 1/x + + INPUTS : 1) Lower and upper limits of integration. + + 2) Number of intervals. + + OUTPUTS : Result of integration. */ + +/*------------------------------ PROGRAM --------------------------*/ + +#include +#include +#include +#include + +void main() +{ + double fx (double x0); + double lo,up,f[20],h,x0,sum,result; + int i,n; + clrscr(); + printf("\n\t TRAPEZOIDAL RULE OF INTEGRATION"); + printf("\n\nEnter the lower limit of integration = "); + scanf("%lf",&lo); /* ENTER LOWER LIMIT OF INTEGRATION */ + printf("\n\nEnter the upper limit of integration = "); + scanf("%lf",&up); /* ENTER UPPER LIMIT OF INTEGRATION */ + printf("\n\nEnter the value of h = "); + scanf("%lf",&h); /* ENTER THE VALUE OF h */ + n = (up - lo)/h; /* CALCULATION VALUE OF n */ + x0 = lo; + for(i = 0; i <= n; i++) /* LOOP TO CALCULATE VALUE OF f(x) */ + { + f[i] = fx(x0); /* FUNCTION fx IS CALLED HERE */ + x0 = x0 + h; /* NEXT VALUE OF x IS CALCULATED HERE */ + } + sum = 0; + for(i = 1; i <= n-1; i++) + { + sum = sum + 2*f[i]; /*SUMMATION OF ORDINATES FROM y(1) to y(n-1)*/ + } + result = (h/2) * ( f[0] + f[n] + sum ); /* RESULT OF INTEGRATION */ + printf("\n\nThe result of integration is = %lf",result); +} + +double fx ( double x) /* FUNCTION TO CALCULATE VALUE OF f(x) */ +{ + double f; + f = 1/x; + return(f); +} +/*------------------------ END OF PROGRAM ------------------------------*/ diff --git a/c++/Computational_Geometry/C++ Program to Show the Duality Transformation of Line and Point.cpp b/c++/Computational_Geometry/C++ Program to Show the Duality Transformation of Line and Point.cpp new file mode 100644 index 0000000..c71c5ad --- /dev/null +++ b/c++/Computational_Geometry/C++ Program to Show the Duality Transformation of Line and Point.cpp @@ -0,0 +1,58 @@ +#include +#include +#include + +using namespace std; + +void performLineTransformation(double a, double b) +{ + cout << "X: " << (b / a) << ", Y: " << (b * -1); +} + +void performPointTransformation(double x, double y) +{ + cout << "y=" << (-1 * y / x) << "x +" << (-1 * y); +} + +int main(int argc, char **argv) +{ + cout + << "Perform what transformation.\n1. Line Transformation\n2. Point Transformation"; + int option; + cin >> option; + switch (option) + { + case 1: + cout << "Enter the coefficients of line "; + double a, b; + cin >> a >> b; + performLineTransformation(a, b); + break; + case 2: + cout << "Enter the coordinate of point "; + double x, y; + cin >> x >> y; + performPointTransformation(x, y); + break; + default: + break; + } +} + +/* + +Perform what transformation. +1. Line Transformation +2. Point Transformation +1 +Enter the coefficients of line +1 2 +X: 2.0, Y: -2.0 + +Perform what transformation. +1. Line Transformation +2. Point Transformation +2 +Enter the coordinate of point +2 -2 +y=1.0x +2.0 \ No newline at end of file diff --git a/c++/Computational_Geometry/C++ Program to Solve N-Queen Problem.cpp b/c++/Computational_Geometry/C++ Program to Solve N-Queen Problem.cpp new file mode 100644 index 0000000..ac4d037 --- /dev/null +++ b/c++/Computational_Geometry/C++ Program to Solve N-Queen Problem.cpp @@ -0,0 +1,89 @@ +/* + * C++ Program to Solve N-Queen Problem + */ +#include +#include +#include +#define N 8 +using namespace std; + +/* print solution */ +void printSolution(int board[N][N]) +{ + for (int i = 0; i < N; i++) + { + for (int j = 0; j < N; j++) + cout<= 0 && j >= 0; i--, j--) + { + if (board[i][j]) + return false; + } + for (i = row, j = col; j >= 0 && i < N; i++, j--) + { + if (board[i][j]) + return false; + } + return true; +} + +/*solve N Queen problem */ +bool solveNQUtil(int board[N][N], int col) +{ + if (col >= N) + return true; + for (int i = 0; i < N; i++) + { + if ( isSafe(board, i, col) ) + { + board[i][col] = 1; + if (solveNQUtil(board, col + 1) == true) + return true; + board[i][col] = 0; + } + } + return false; +} + +/* solves the N Queen problem using Backtracking.*/ +bool solveNQ() +{ + int board[N][N] = {0}; + if (solveNQUtil(board, 0) == false) + { + cout<<"Solution does not exist"< +#include +#include +#include + +using namespace std; +const int LOW = 0; +const int HIGH = 10; +int main(int argc, char **argv) +{ + time_t seconds; + time(&seconds); + srand((unsigned int) seconds); + int x1, x2, y1, y2; + x1 = rand() % (HIGH - LOW + 1) + LOW; + x2 = rand() % (HIGH - LOW + 1) + LOW; + y1 = rand() % (HIGH - LOW + 1) + LOW; + y2 = rand() % (HIGH - LOW + 1) + LOW; + cout << "The Equation of the 1st line is : (" << (y2 - y1) << ")x+(" << (x1 + - x2) << ")y+(" << (x2 * y1 - x1 * y2) << ") = 0\n"; + int p1, p2, q1, q2; + p1 = rand() % (HIGH - LOW + 1) + LOW; + p2 = rand() % (HIGH - LOW + 1) + LOW; + q1 = rand() % (HIGH - LOW + 1) + LOW; + q2 = rand() % (HIGH - LOW + 1) + LOW; + cout << "The Equation of the 2nd line is : (" << (q2 - q1) << ")x+(" << (p1 + - p2) << ")y+(" << (p2 * q1 - p1 * q2) << ") = 0\n"; + int s1 = (y2 - y1) * p1 + (x1 - x2) * q1 + (x2 * y1 - x1 * y2); + if (s1 < 0) + { + int s2 = (y2 - y1) * p2 + (x1 - x2) * q2 + (x2 * y1 - x1 * y2); + if (s2 >= 0) + cout << "The lines intersect"; + else if (s2 < 0) + cout << "The lines doesn't intersect"; + } + else if (s1 > 0) + { + int s2 = (y2 - y1) * p2 + (x1 - x2) * q2 + (x2 * y1 - x1 * y2); + if (s2 <= 0) + cout << "The lines intersect"; + else if (s2 > 0) + cout << "The lines doesn't intersect"; + } + else + cout << "The point lies on the line"; + return 0; +} + +/* +The Equation of the 1st line is : (4)x+(1)y+(-6) = 0 +The Equation of the 2nd line is : (-1)x+(-9)y+(46) = 0 +The lines doesn't intersect + +The Equation of the 1st line is : (3)x+(7)y+(-59) = 0 +The Equation of the 2nd line is : (-8)x+(1)y+(56) = 0 +The lines intersect \ No newline at end of file diff --git a/c++/Hard_Graph_Problems/C++ Program to Check Whether Graph is DAG.cpp b/c++/Hard_Graph_Problems/C++ Program to Check Whether Graph is DAG.cpp new file mode 100644 index 0000000..5283c48 --- /dev/null +++ b/c++/Hard_Graph_Problems/C++ Program to Check Whether Graph is DAG.cpp @@ -0,0 +1,137 @@ +/*This is a C++ Program to check whether graph is DAG. In mathematics and computer science, a directed acyclic graph (DAG Listeni/’dæg/), is a directed graph with no directed cycles. That is, it is formed by a collection of vertices and directed edges, each edge connecting one vertex to another, such that there is no way to start at some vertex v and follow a sequence of edges that eventually loops back to v again.*/ + +#include +#include +#include +using namespace std; +int c = 0; +struct adj_list +{ + int dest; + adj_list *next; +}*np = NULL, *np1 = NULL, *p = NULL, *q = NULL; +struct Graph +{ + int v; + adj_list *ptr; +} array[6]; +void addReverseEdge(int src, int dest) +{ + np1 = new adj_list; + np1->dest = src; + np1->next = NULL; + if (array[dest].ptr == NULL) + { + array[dest].ptr = np1; + q = array[dest].ptr; + q->next = NULL; + } + else + { + q = array[dest].ptr; + while (q->next != NULL) + { + q = q->next; + } + q->next = np1; + } +} +void addEdge(int src, int dest) +{ + np = new adj_list; + np->dest = dest; + np->next = NULL; + if (array[src].ptr == NULL) + { + array[src].ptr = np; + p = array[src].ptr; + p->next = NULL; + } + else + { + p = array[src].ptr; + while (p->next != NULL) + { + p = p->next; + } + p->next = np; + } + //addReverseEdge(src, dest); +} +void print_graph(int n) +{ + for (int i = 0; i < n; i++) + { + cout << "Adjacency List of " << array[i].v << ": "; + while (array[i].ptr != NULL) + { + cout << (array[i].ptr)->dest << " "; + array[i].ptr = (array[i].ptr)->next; + } + cout << endl; + } +} + +int checkDAG(int n) +{ + int count = 0; + int size = n - 1; + for (int i = 0; i < n; i++) + { + //cout << "Adjacency List of " << array[i].v << ": "; + if (count == size) + { + return 1; + } + if (array[i].ptr == NULL) + { + count++; + for (int j = 0; j < n; j++) + { + while (array[j].ptr != NULL) + { + if ((array[j].ptr)->dest == (array[i].ptr)->dest) + { + (array[j].ptr)->dest = -1; + } + array[i].ptr = (array[i].ptr)->next; + } + } + } + } + return 0; +} +int main() +{ + int n = 6; + cout << "Number of vertices: " << n << endl; + for (int i = 0; i < n; i++) + { + array[i].v = i; + array[i].ptr = NULL; + } + addEdge(0, 1); + addEdge(1, 2); + addEdge(1, 3); + addEdge(3, 4); + addEdge(4, 5); + addEdge(5, 3); + addEdge(5, 2); + print_graph(n); + cout << "The given graph is 'Directed Acyclic Graph' :"; + if (checkDAG(n) == 1) + cout << " True"; + else + cout << " False"; +} + +/* + +Number of vertices: 6 +Adjacency List of 0: 1 +Adjacency List of 1: 2 3 +Adjacency List of 2: +Adjacency List of 3: 4 +Adjacency List of 4: 5 +Adjacency List of 5: 3 2 +The given graph is 'Directed Acyclic Graph' : True \ No newline at end of file diff --git a/c++/Hard_Graph_Problems/C++ Program to Find All the Cliques of a Given Size k.cpp b/c++/Hard_Graph_Problems/C++ Program to Find All the Cliques of a Given Size k.cpp new file mode 100644 index 0000000..fca9cab --- /dev/null +++ b/c++/Hard_Graph_Problems/C++ Program to Find All the Cliques of a Given Size k.cpp @@ -0,0 +1,261 @@ +/*This is a C++ Program to find the cliques of size k in a a graph. An undirected graph is formed by a finite set of vertices and a set of unordered pairs of vertices, which are called edges. By convention, in algorithm analysis, the number of vertices in the graph is denoted by n and the number of edges is denoted by m. A clique in a graph G is a complete subgraph of G; that is, it is a subset S of the vertices such that every two vertices in S are connected by an edge in G. A maximal clique is a clique to which no more vertices can be added; a maximum clique is a clique that includes the largest possible number of vertices, and the clique number ?(G) is the number of vertices in a maximum clique of G.*/ + +#include +#include +#include +#include +using namespace std; + +bool removable(vector neighbor, vector cover); +int max_removable(vector > neighbors, vector cover); +vector procedure_1(vector > neighbors, vector cover); +vector procedure_2(vector > neighbors, vector cover, + int k); +int cover_size(vector cover); +ifstream infile("graph.txt"); +ofstream outfile("cliques.txt"); + +int main() +{ + //Read Graph (note we work with the complement of the input graph) + cout << "Clique Algorithm." << endl; + int n, i, j, k, K, p, q, r, s, min, edge, counter = 0; + infile >> n; + vector > graph; + for (i = 0; i < n; i++) + { + vector row; + for (j = 0; j < n; j++) + { + infile >> edge; + if (edge == 0) + row.push_back(1); + else + row.push_back(0); + } + graph.push_back(row); + } + //Find Neighbors + vector > neighbors; + for (i = 0; i < graph.size(); i++) + { + vector neighbor; + for (j = 0; j < graph[i].size(); j++) + if (graph[i][j] == 1) + neighbor.push_back(j); + neighbors.push_back(neighbor); + } + cout << "Graph has n = " << n << " vertices." << endl; + //Read maximum size of Clique wanted + cout << "Find a Clique of size at least k = "; + cin >> K; + k = n - K; + //Find Cliques + bool found = false; + cout << "Finding Cliques..." << endl; + min = n + 1; + vector > covers; + vector allcover; + for (i = 0; i < graph.size(); i++) + allcover.push_back(1); + for (i = 0; i < allcover.size(); i++) + { + if (found) + break; + counter++; + cout << counter << ". "; + outfile << counter << ". "; + vector cover = allcover; + cover[i] = 0; + cover = procedure_1(neighbors, cover); + s = cover_size(cover); + if (s < min) + min = s; + if (s <= k) + { + outfile << "Clique (" << n - s << "): "; + for (j = 0; j < cover.size(); j++) + if (cover[j] == 0) + outfile << j + 1 << " "; + outfile << endl; + cout << "Clique Size: " << n - s << endl; + covers.push_back(cover); + found = true; + break; + } + for (j = 0; j < n - k; j++) + cover = procedure_2(neighbors, cover, j); + s = cover_size(cover); + if (s < min) + min = s; + outfile << "Clique (" << n - s << "): "; + for (j = 0; j < cover.size(); j++) + if (cover[j] == 0) + outfile << j + 1 << " "; + outfile << endl; + cout << "Clique Size: " << n - s << endl; + covers.push_back(cover); + if (s <= k) + { + found = true; + break; + } + } + //Pairwise Intersections + for (p = 0; p < covers.size(); p++) + { + if (found) + break; + for (q = p + 1; q < covers.size(); q++) + { + if (found) + break; + counter++; + cout << counter << ". "; + outfile << counter << ". "; + vector cover = allcover; + for (r = 0; r < cover.size(); r++) + if (covers[p][r] == 0 && covers[q][r] == 0) + cover[r] = 0; + cover = procedure_1(neighbors, cover); + s = cover_size(cover); + if (s < min) + min = s; + if (s <= k) + { + outfile << "Clique (" << n - s << "): "; + for (j = 0; j < cover.size(); j++) + if (cover[j] == 0) + outfile << j + 1 << " "; + outfile << endl; + cout << "Clique Size: " << n - s << endl; + found = true; + break; + } + for (j = 0; j < k; j++) + cover = procedure_2(neighbors, cover, j); + s = cover_size(cover); + if (s < min) + min = s; + outfile << "Clique (" << n - s << "): "; + for (j = 0; j < cover.size(); j++) + if (cover[j] == 0) + outfile << j + 1 << " "; + outfile << endl; + cout << "Clique Size: " << n - s << endl; + if (s <= k) + { + found = true; + break; + } + } + } + if (found) + cout << "Found Clique of size at least " << K << "." << endl; + else + cout << "Could not find Clique of size at least " << K << "." << endl + << "Maximum Clique size found is " << n - min << "." << endl; + cout << "See cliques.txt for results." << endl; + return 0; +} + +bool removable(vector neighbor, vector cover) +{ + bool check = true; + for (int i = 0; i < neighbor.size(); i++) + if (cover[neighbor[i]] == 0) + { + check = false; + break; + } + return check; +} + +int max_removable(vector > neighbors, vector cover) +{ + int r = -1, max = -1; + for (int i = 0; i < cover.size(); i++) + { + if (cover[i] == 1 && removable(neighbors[i], cover) == true) + { + vector temp_cover = cover; + temp_cover[i] = 0; + int sum = 0; + for (int j = 0; j < temp_cover.size(); j++) + if (temp_cover[j] == 1 && removable(neighbors[j], temp_cover) + == true) + sum++; + if (sum > max) + { + max = sum; + r = i; + } + } + } + return r; +} + +vector procedure_1(vector > neighbors, vector cover) +{ + vector temp_cover = cover; + int r = 0; + while (r != -1) + { + r = max_removable(neighbors, temp_cover); + if (r != -1) + temp_cover[r] = 0; + } + return temp_cover; +} + +vector procedure_2(vector > neighbors, vector cover, + int k) +{ + int count = 0; + vector temp_cover = cover; + int i = 0; + for (int i = 0; i < temp_cover.size(); i++) + { + if (temp_cover[i] == 1) + { + int sum = 0, index; + for (int j = 0; j < neighbors[i].size(); j++) + if (temp_cover[neighbors[i][j]] == 0) + { + index = j; + sum++; + } + if (sum == 1 && cover[neighbors[i][index]] == 0) + { + temp_cover[neighbors[i][index]] = 1; + temp_cover[i] = 0; + temp_cover = procedure_1(neighbors, temp_cover); + count++; + } + if (count > k) + break; + } + } + return temp_cover; +} + +int cover_size(vector cover) +{ + int count = 0; + for (int i = 0; i < cover.size(); i++) + if (cover[i] == 1) + count++; + return count; +} + +/* + +graph.txt: +4 +0 1 1 1 +1 0 1 1 +1 1 0 1 +1 1 1 0 + +cliques.txt: +Clique ( 4 ): 1 2 3 4 \ No newline at end of file diff --git a/c++/Hard_Graph_Problems/C++ Program to Find Hamiltonian Cycle.cpp b/c++/Hard_Graph_Problems/C++ Program to Find Hamiltonian Cycle.cpp new file mode 100644 index 0000000..5ac117b --- /dev/null +++ b/c++/Hard_Graph_Problems/C++ Program to Find Hamiltonian Cycle.cpp @@ -0,0 +1,111 @@ +/* + * C++ Program to Find Hamiltonian Cycle + */ +#include +#include +#include +#define V 5 +using namespace std; + +void printSolution(int path[]); + +/* + * check if the vertex v can be added at index 'pos' in the Hamiltonian Cycle + */ +bool isSafe(int v, bool graph[V][V], int path[], int pos) +{ + if (graph [path[pos-1]][v] == 0) + return false; + for (int i = 0; i < pos; i++) + if (path[i] == v) + return false; + return true; +} + +/* solve hamiltonian cycle problem */ +bool hamCycleUtil(bool graph[V][V], int path[], int pos) +{ + if (pos == V) + { + if (graph[ path[pos-1] ][ path[0] ] == 1) + return true; + else + return false; + } + for (int v = 1; v < V; v++) + { + if (isSafe(v, graph, path, pos)) + { + path[pos] = v; + if (hamCycleUtil (graph, path, pos+1) == true) + return true; + path[pos] = -1; + } + } + return false; +} + +/* solves the Hamiltonian Cycle problem using Backtracking.*/ +bool hamCycle(bool graph[V][V]) +{ + int *path = new int[V]; + for (int i = 0; i < V; i++) + path[i] = -1; + path[0] = 0; + if (hamCycleUtil(graph, path, 1) == false) + { + cout<<"\nSolution does not exist"< +#include +#include +#include +using namespace std; + +bool removable(vector neighbor, vector cover); +int max_removable(vector > neighbors, vector cover); +vector procedure_1(vector > neighbors, vector cover); +vector procedure_2(vector > neighbors, vector cover, + int k); +int cover_size(vector cover); +ifstream infile("graph.txt"); +ofstream outfile("sets.txt"); + +int main() +{ + //Read Graph + cout << "Independent Set Algorithm." << endl; + int n, i, j, k, K, p, q, r, s, min, edge, counter = 0; + infile >> n; + vector > graph; + for (i = 0; i < n; i++) + { + vector row; + for (j = 0; j < n; j++) + { + infile >> edge; + row.push_back(edge); + } + graph.push_back(row); + } + //Find Neighbors + vector > neighbors; + for (i = 0; i < graph.size(); i++) + { + vector neighbor; + for (j = 0; j < graph[i].size(); j++) + if (graph[i][j] == 1) + neighbor.push_back(j); + neighbors.push_back(neighbor); + } + cout << "Graph has n = " << n << " vertices." << endl; + //Read maximum size of Independent Set wanted + cout << "Find an Independent Set of size at least k = "; + cin >> K; + k = n - K; + //Find Independent Sets + bool found = false; + cout << "Finding Independent Sets..." << endl; + min = n + 1; + vector > covers; + vector allcover; + for (i = 0; i < graph.size(); i++) + allcover.push_back(1); + for (i = 0; i < allcover.size(); i++) + { + if (found) + break; + counter++; + cout << counter << ". "; + outfile << counter << ". "; + vector cover = allcover; + cover[i] = 0; + cover = procedure_1(neighbors, cover); + s = cover_size(cover); + if (s < min) + min = s; + if (s <= k) + { + outfile << "Independent Set (" << n - s << "): "; + for (j = 0; j < cover.size(); j++) + if (cover[j] == 0) + outfile << j + 1 << " "; + outfile << endl; + cout << "Independent Set Size: " << n - s << endl; + covers.push_back(cover); + found = true; + break; + } + for (j = 0; j < n - k; j++) + cover = procedure_2(neighbors, cover, j); + s = cover_size(cover); + if (s < min) + min = s; + outfile << "Independent Set (" << n - s << "): "; + for (j = 0; j < cover.size(); j++) + if (cover[j] == 0) + outfile << j + 1 << " "; + outfile << endl; + cout << "Independent Set Size: " << n - s << endl; + covers.push_back(cover); + if (s <= k) + { + found = true; + break; + } + } + //Pairwise Intersections + for (p = 0; p < covers.size(); p++) + { + if (found) + break; + for (q = p + 1; q < covers.size(); q++) + { + if (found) + break; + counter++; + cout << counter << ". "; + outfile << counter << ". "; + vector cover = allcover; + for (r = 0; r < cover.size(); r++) + if (covers[p][r] == 0 && covers[q][r] == 0) + cover[r] = 0; + cover = procedure_1(neighbors, cover); + s = cover_size(cover); + if (s < min) + min = s; + if (s <= k) + { + outfile << "Independent Set (" << n - s << "): "; + for (j = 0; j < cover.size(); j++) + if (cover[j] == 0) + outfile << j + 1 << " "; + outfile << endl; + cout << "Independent Set Size: " << n - s << endl; + found = true; + break; + } + for (j = 0; j < k; j++) + cover = procedure_2(neighbors, cover, j); + s = cover_size(cover); + if (s < min) + min = s; + outfile << "Independent Set (" << n - s << "): "; + for (j = 0; j < cover.size(); j++) + if (cover[j] == 0) + outfile << j + 1 << " "; + outfile << endl; + cout << "Independent Set Size: " << n - s << endl; + if (s <= k) + { + found = true; + break; + } + } + } + if (found) + cout << "Found Independent Set of size at least " << K << "." << endl; + else + cout << "Could not find Independent Set of size at least " << K << "." + << endl << "Maximum Independent Set size found is " << n - min + << "." << endl; + cout << "See sets.txt for results." << endl; + system("PAUSE"); + return 0; +} + +bool removable(vector neighbor, vector cover) +{ + bool check = true; + for (int i = 0; i < neighbor.size(); i++) + if (cover[neighbor[i]] == 0) + { + check = false; + break; + } + return check; +} + +int max_removable(vector > neighbors, vector cover) +{ + int r = -1, max = -1; + for (int i = 0; i < cover.size(); i++) + { + if (cover[i] == 1 && removable(neighbors[i], cover) == true) + { + vector temp_cover = cover; + temp_cover[i] = 0; + int sum = 0; + for (int j = 0; j < temp_cover.size(); j++) + if (temp_cover[j] == 1 && removable(neighbors[j], temp_cover) + == true) + sum++; + if (sum > max) + { + max = sum; + r = i; + } + } + } + return r; +} + +vector procedure_1(vector > neighbors, vector cover) +{ + vector temp_cover = cover; + int r = 0; + while (r != -1) + { + r = max_removable(neighbors, temp_cover); + if (r != -1) + temp_cover[r] = 0; + } + return temp_cover; +} + +vector procedure_2(vector > neighbors, vector cover, + int k) +{ + int count = 0; + vector temp_cover = cover; + int i = 0; + for (int i = 0; i < temp_cover.size(); i++) + { + if (temp_cover[i] == 1) + { + int sum = 0, index; + for (int j = 0; j < neighbors[i].size(); j++) + if (temp_cover[neighbors[i][j]] == 0) + { + index = j; + sum++; + } + if (sum == 1 && cover[neighbors[i][index]] == 0) + { + temp_cover[neighbors[i][index]] = 1; + temp_cover[i] = 0; + temp_cover = procedure_1(neighbors, temp_cover); + count++; + } + if (count > k) + break; + } + } + return temp_cover; +} + +int cover_size(vector cover) +{ + int count = 0; + for (int i = 0; i < cover.size(); i++) + if (cover[i] == 1) + count++; + return count; +} + +/* +graph.txt: +4 +0 1 1 1 +1 0 1 1 +1 1 0 1 +1 1 1 0 + +set.txt: +Independent Set ( 1 ): 2 \ No newline at end of file diff --git a/c++/Hard_Graph_Problems/C++ Program to Find Minimum Number of Edges to Cut to make the Graph Disconnected.cpp b/c++/Hard_Graph_Problems/C++ Program to Find Minimum Number of Edges to Cut to make the Graph Disconnected.cpp new file mode 100644 index 0000000..1e84642 --- /dev/null +++ b/c++/Hard_Graph_Problems/C++ Program to Find Minimum Number of Edges to Cut to make the Graph Disconnected.cpp @@ -0,0 +1,126 @@ +/*This is a C++ Program to find minimum number of edges to cut to make the graph disconnected. An edge in an undirected connected graph is a bridge if removing it disconnects the graph. For a disconnected undirected graph, definition is similar, a bridge is an edge removing which increases number of connected components.*/ + +// A C++ program to find bridges in a given undirected graph +#include +#include +#define NIL -1 +using namespace std; + +// A class that represents an undirected graph +class Graph +{ + int V; // No. of vertices + list *adj; // A dynamic array of adjacency lists + void bridgeUtil(int v, bool visited[], int disc[], int low[], + int parent[]); +public: + Graph(int V); // Constructor + void addEdge(int v, int w); // function to add an edge to graph + void bridge(); // prints all bridges +}; + +Graph::Graph(int V) +{ + this->V = V; + adj = new list [V]; +} + +void Graph::addEdge(int v, int w) +{ + adj[v].push_back(w); + adj[w].push_back(v); // Note: the graph is undirected +} + +void Graph::bridgeUtil(int u, bool visited[], int disc[], int low[], + int parent[]) +{ + // A static variable is used for simplicity, we can avoid use of static + // variable by passing a pointer. + static int time = 0; + // Mark the current node as visited + visited[u] = true; + // Initialize discovery time and low value + disc[u] = low[u] = ++time; + // Go through all vertices aadjacent to this + list::iterator i; + for (i = adj[u].begin(); i != adj[u].end(); ++i) + { + int v = *i; // v is current adjacent of u + // If v is not visited yet, then recur for it + if (!visited[v]) + { + parent[v] = u; + bridgeUtil(v, visited, disc, low, parent); + // Check if the subtree rooted with v has a connection to + // one of the ancestors of u + low[u] = min(low[u], low[v]); + // If the lowest vertex reachable from subtree under v is + // below u in DFS tree, then u-v is a bridge + if (low[v] > disc[u]) + cout << u << " " << v << endl; + } + // Update low value of u for parent function calls. + else if (v != parent[u]) + low[u] = min(low[u], disc[v]); + } +} + +// DFS based function to find all bridges. It uses recursive function bridgeUtil() +void Graph::bridge() +{ + // Mark all the vertices as not visited + bool *visited = new bool[V]; + int *disc = new int[V]; + int *low = new int[V]; + int *parent = new int[V]; + // Initialize parent and visited arrays + for (int i = 0; i < V; i++) + { + parent[i] = NIL; + visited[i] = false; + } + // Call the recursive helper function to find Bridges + // in DFS tree rooted with vertex 'i' + for (int i = 0; i < V; i++) + if (visited[i] == false) + bridgeUtil(i, visited, disc, low, parent); +} + +// Driver program to test above function +int main() +{ + // Create graphs given in above diagrams + cout << "\nBridges in first graph \n"; + Graph g1(5); + g1.addEdge(1, 0); + g1.addEdge(0, 2); + g1.addEdge(2, 1); + g1.addEdge(0, 3); + g1.addEdge(3, 4); + g1.bridge(); + cout << "\nBridges in second graph \n"; + Graph g2(4); + g2.addEdge(0, 1); + g2.addEdge(1, 2); + g2.addEdge(2, 3); + g2.bridge(); + cout << "\nBridges in third graph \n"; + Graph g3(7); + g3.addEdge(0, 1); + g3.addEdge(1, 2); + g3.addEdge(2, 0); + g3.addEdge(1, 3); + g3.addEdge(1, 4); + g3.addEdge(1, 6); + g3.addEdge(3, 5); + g3.addEdge(4, 5); + g3.bridge(); + return 0; +} + +/* +Bridges in first graph + +3 4 + + diff --git a/c++/Hard_Graph_Problems/C++ Program to Find Size of the Largest Independent Set(LIS) in a Given a Binary Tree.cpp b/c++/Hard_Graph_Problems/C++ Program to Find Size of the Largest Independent Set(LIS) in a Given a Binary Tree.cpp new file mode 100644 index 0000000..2f52a4c --- /dev/null +++ b/c++/Hard_Graph_Problems/C++ Program to Find Size of the Largest Independent Set(LIS) in a Given a Binary Tree.cpp @@ -0,0 +1,75 @@ +/*This is a C++ Program to find largest independent set in a binary tree. In graph theory, an independent set or stable set is a set of vertices in a graph, no two of which are adjacent. That is, it is a set I of vertices such that for every two vertices in I, there is no edge connecting the two. Equivalently, each edge in the graph has at most one endpoint in I. The size of an independent set is the number of vertices it contains. Independent sets have also been called internally stable sets. A maximal independent set is either an independent set such that adding any other vertex to the set forces the set to contain an edge or the set of all vertices of the empty graph.*/ + +/* Dynamic programming based program for Largest Independent Set problem */ +#include +#include +#include + +using namespace std; + +// A utility function to find max of two integers +int max(int x, int y) +{ + return (x > y) ? x : y; +} + +/* A binary tree node has data, pointer to left child and a pointer to + right child */ +struct node +{ + int data; + int liss; + struct node *left, *right; +}; + +// A memoization function returns size of the largest independent set in +// a given binary tree +int LISS(struct node *root) +{ + if (root == NULL) + return 0; + if (root->liss) + return root->liss; + if (root->left == NULL && root->right == NULL) + return (root->liss = 1); + // Caculate size excluding the current node + int liss_excl = LISS(root->left) + LISS(root->right); + // Calculate size including the current node + int liss_incl = 1; + if (root->left) + liss_incl += LISS(root->left->left) + LISS(root->left->right); + if (root->right) + liss_incl += LISS(root->right->left) + LISS(root->right->right); + // Return the maximum of two sizes + root->liss = max(liss_incl, liss_excl); + return root->liss; +} + +// A utility function to create a node +struct node* newNode(int data) +{ + struct node* temp = (struct node *) malloc(sizeof(struct node)); + temp->data = data; + temp->left = temp->right = NULL; + temp->liss = 0; + return temp; +} + +// Driver program to test above functions +int main() +{ + // Let us construct the tree given in the above diagram + struct node *root = newNode(20); + root->left = newNode(8); + root->left->left = newNode(4); + root->left->right = newNode(12); + root->left->right->left = newNode(10); + root->left->right->right = newNode(14); + root->right = newNode(22); + root->right->right = newNode(25); + cout<<"Size of the Largest Independent Set is "<< LISS(root); + return 0; +} + +/* +Size of the Largest Independent Set is 5 \ No newline at end of file diff --git a/c++/Hard_Graph_Problems/C++ Program to Find a Good Feedback Edge Set in a Graph.cpp b/c++/Hard_Graph_Problems/C++ Program to Find a Good Feedback Edge Set in a Graph.cpp new file mode 100644 index 0000000..b77a136 --- /dev/null +++ b/c++/Hard_Graph_Problems/C++ Program to Find a Good Feedback Edge Set in a Graph.cpp @@ -0,0 +1,157 @@ +#include +#include +#include +using namespace std; +int c = 0; +struct adj_list +{ + int dest; + adj_list *next; +}*np = NULL, *np1 = NULL, *p = NULL, *q = NULL; +struct Graph +{ + int v; + adj_list *ptr; +} array[6]; +void addReverseEdge(int src, int dest) +{ + np1 = new adj_list; + np1->dest = src; + np1->next = NULL; + if (array[dest].ptr == NULL) + { + array[dest].ptr = np1; + q = array[dest].ptr; + q->next = NULL; + } + else + { + q = array[dest].ptr; + while (q->next != NULL) + { + q = q->next; + } + q->next = np1; + } +} +void addEdge(int src, int dest) +{ + np = new adj_list; + np->dest = dest; + np->next = NULL; + if (array[src].ptr == NULL) + { + array[src].ptr = np; + p = array[src].ptr; + p->next = NULL; + } + else + { + p = array[src].ptr; + while (p->next != NULL) + { + p = p->next; + } + p->next = np; + } + //addReverseEdge(src, dest); +} +void print_graph(int n) +{ + for (int i = 0; i < n; i++) + { + cout << "Adjacency List of " << array[i].v << ": "; + while (array[i].ptr != NULL) + { + cout << (array[i].ptr)->dest << " "; + array[i].ptr = (array[i].ptr)->next; + } + cout << endl; + } +} + +int checkDAG(int n) +{ + int count = 0; + int size = n - 1; + for (int i = 0; i < n; i++) + { + if (count == size) + { + return 0; + } + if (array[i].ptr == NULL) + { + count++; + for (int j = 0; j < n; j++) + { + while (array[j].ptr != NULL) + { + if ((array[j].ptr)->dest == (array[i].ptr)->dest) + { + (array[j].ptr)->dest = -1; + } + array[i].ptr = (array[i].ptr)->next; + } + } + } + } + cout<<"after checking dag"; + int visited[n + 1]; + for (int i = 0; i < n; i++) + { + while (array[i].ptr != NULL) + { + cout << (array[i].ptr)->dest << " "; + visited[i] = 1; + for (int j = 0; j < n; j++) + { + while (array[j].ptr != NULL) + { + cout << (array[j].ptr)->dest << " "; + if (visited[array[j].v] == 1) + { + cout << array[i].v << " - " << array[j].v; + } + array[j].ptr = (array[j].ptr)->next; + } + cout << endl; + } + array[i].ptr = (array[i].ptr)->next; + } + cout << endl; + } + return 1; +} +int main() +{ + int n = 6; + cout << "Number of vertices: " << n << endl; + for (int i = 0; i < n; i++) + { + array[i].v = i; + array[i].ptr = NULL; + } + addEdge(0, 1); + addEdge(1, 2); + addEdge(1, 3); + addEdge(3, 4); + addEdge(4, 5); + addEdge(3, 5); + addEdge(5, 2); + print_graph(n); + cout << "Feedback arc Set: "; + if (checkDAG(n) == 0) + cout << " None"; +} + +/* + +Number of vertices: 6 +Adjacency List of 0: 1 +Adjacency List of 1: 2 3 +Adjacency List of 2: +Adjacency List of 3: 4 5 +Adjacency List of 4: 5 +Adjacency List of 5: 2 +Feedback arc Set: None \ No newline at end of file diff --git a/c++/Hard_Graph_Problems/C++ Program to Find a Good Feedback Vertex Set.cpp b/c++/Hard_Graph_Problems/C++ Program to Find a Good Feedback Vertex Set.cpp new file mode 100644 index 0000000..910d0e9 --- /dev/null +++ b/c++/Hard_Graph_Problems/C++ Program to Find a Good Feedback Vertex Set.cpp @@ -0,0 +1,157 @@ +#include +#include +#include +using namespace std; +int c = 0; +struct adj_list +{ + int dest; + adj_list *next; +}*np = NULL, *np1 = NULL, *p = NULL, *q = NULL; +struct Graph +{ + int v; + adj_list *ptr; +} array[6]; +void addReverseEdge(int src, int dest) +{ + np1 = new adj_list; + np1->dest = src; + np1->next = NULL; + if (array[dest].ptr == NULL) + { + array[dest].ptr = np1; + q = array[dest].ptr; + q->next = NULL; + } + else + { + q = array[dest].ptr; + while (q->next != NULL) + { + q = q->next; + } + q->next = np1; + } +} +void addEdge(int src, int dest) +{ + np = new adj_list; + np->dest = dest; + np->next = NULL; + if (array[src].ptr == NULL) + { + array[src].ptr = np; + p = array[src].ptr; + p->next = NULL; + } + else + { + p = array[src].ptr; + while (p->next != NULL) + { + p = p->next; + } + p->next = np; + } + //addReverseEdge(src, dest); +} +void print_graph(int n) +{ + for (int i = 0; i < n; i++) + { + cout << "Adjacency List of " << array[i].v << ": "; + while (array[i].ptr != NULL) + { + cout << (array[i].ptr)->dest << " "; + array[i].ptr = (array[i].ptr)->next; + } + cout << endl; + } +} + +int checkDAG(int n) +{ + int count = 0; + int size = n - 1; + for (int i = 0; i < n; i++) + { + if (count == size) + { + return 0; + } + if (array[i].ptr == NULL) + { + count++; + for (int j = 0; j < n; j++) + { + while (array[j].ptr != NULL) + { + if ((array[j].ptr)->dest == (array[i].ptr)->dest) + { + (array[j].ptr)->dest = -1; + } + array[i].ptr = (array[i].ptr)->next; + } + } + } + } + cout << "after checking dag"; + int visited[n + 1]; + for (int i = 0; i < n; i++) + { + while (array[i].ptr != NULL) + { + cout << (array[i].ptr)->dest << " "; + visited[i] = 1; + for (int j = 0; j < n; j++) + { + while (array[j].ptr != NULL) + { + cout << (array[j].ptr)->dest << " "; + if (visited[array[j].v] == 1) + { + cout << array[j].v; + } + array[j].ptr = (array[j].ptr)->next; + } + cout << endl; + } + array[i].ptr = (array[i].ptr)->next; + } + cout << endl; + } + return 1; +} +int main() +{ + int n = 6; + cout << "Number of vertices: " << n << endl; + for (int i = 0; i < n; i++) + { + array[i].v = i; + array[i].ptr = NULL; + } + addEdge(0, 1); + addEdge(1, 2); + addEdge(1, 3); + addEdge(3, 4); + addEdge(4, 5); + addEdge(3, 5); + addEdge(5, 2); + print_graph(n); + cout << "Feedback Vertex Set: "; + if (checkDAG(n) == 0) + cout << " None"; +} + +/* + +Number of vertices: 6 +Adjacency List of 0: 1 +Adjacency List of 1: 2 3 +Adjacency List of 2: +Adjacency List of 3: 4 5 +Adjacency List of 4: 5 +Adjacency List of 5: 2 +Feedback Vertex Set: None \ No newline at end of file diff --git a/c++/Hard_Graph_Problems/C++ Program to Find the Largest clique in a Planar Graph.cpp b/c++/Hard_Graph_Problems/C++ Program to Find the Largest clique in a Planar Graph.cpp new file mode 100644 index 0000000..fca9cab --- /dev/null +++ b/c++/Hard_Graph_Problems/C++ Program to Find the Largest clique in a Planar Graph.cpp @@ -0,0 +1,261 @@ +/*This is a C++ Program to find the cliques of size k in a a graph. An undirected graph is formed by a finite set of vertices and a set of unordered pairs of vertices, which are called edges. By convention, in algorithm analysis, the number of vertices in the graph is denoted by n and the number of edges is denoted by m. A clique in a graph G is a complete subgraph of G; that is, it is a subset S of the vertices such that every two vertices in S are connected by an edge in G. A maximal clique is a clique to which no more vertices can be added; a maximum clique is a clique that includes the largest possible number of vertices, and the clique number ?(G) is the number of vertices in a maximum clique of G.*/ + +#include +#include +#include +#include +using namespace std; + +bool removable(vector neighbor, vector cover); +int max_removable(vector > neighbors, vector cover); +vector procedure_1(vector > neighbors, vector cover); +vector procedure_2(vector > neighbors, vector cover, + int k); +int cover_size(vector cover); +ifstream infile("graph.txt"); +ofstream outfile("cliques.txt"); + +int main() +{ + //Read Graph (note we work with the complement of the input graph) + cout << "Clique Algorithm." << endl; + int n, i, j, k, K, p, q, r, s, min, edge, counter = 0; + infile >> n; + vector > graph; + for (i = 0; i < n; i++) + { + vector row; + for (j = 0; j < n; j++) + { + infile >> edge; + if (edge == 0) + row.push_back(1); + else + row.push_back(0); + } + graph.push_back(row); + } + //Find Neighbors + vector > neighbors; + for (i = 0; i < graph.size(); i++) + { + vector neighbor; + for (j = 0; j < graph[i].size(); j++) + if (graph[i][j] == 1) + neighbor.push_back(j); + neighbors.push_back(neighbor); + } + cout << "Graph has n = " << n << " vertices." << endl; + //Read maximum size of Clique wanted + cout << "Find a Clique of size at least k = "; + cin >> K; + k = n - K; + //Find Cliques + bool found = false; + cout << "Finding Cliques..." << endl; + min = n + 1; + vector > covers; + vector allcover; + for (i = 0; i < graph.size(); i++) + allcover.push_back(1); + for (i = 0; i < allcover.size(); i++) + { + if (found) + break; + counter++; + cout << counter << ". "; + outfile << counter << ". "; + vector cover = allcover; + cover[i] = 0; + cover = procedure_1(neighbors, cover); + s = cover_size(cover); + if (s < min) + min = s; + if (s <= k) + { + outfile << "Clique (" << n - s << "): "; + for (j = 0; j < cover.size(); j++) + if (cover[j] == 0) + outfile << j + 1 << " "; + outfile << endl; + cout << "Clique Size: " << n - s << endl; + covers.push_back(cover); + found = true; + break; + } + for (j = 0; j < n - k; j++) + cover = procedure_2(neighbors, cover, j); + s = cover_size(cover); + if (s < min) + min = s; + outfile << "Clique (" << n - s << "): "; + for (j = 0; j < cover.size(); j++) + if (cover[j] == 0) + outfile << j + 1 << " "; + outfile << endl; + cout << "Clique Size: " << n - s << endl; + covers.push_back(cover); + if (s <= k) + { + found = true; + break; + } + } + //Pairwise Intersections + for (p = 0; p < covers.size(); p++) + { + if (found) + break; + for (q = p + 1; q < covers.size(); q++) + { + if (found) + break; + counter++; + cout << counter << ". "; + outfile << counter << ". "; + vector cover = allcover; + for (r = 0; r < cover.size(); r++) + if (covers[p][r] == 0 && covers[q][r] == 0) + cover[r] = 0; + cover = procedure_1(neighbors, cover); + s = cover_size(cover); + if (s < min) + min = s; + if (s <= k) + { + outfile << "Clique (" << n - s << "): "; + for (j = 0; j < cover.size(); j++) + if (cover[j] == 0) + outfile << j + 1 << " "; + outfile << endl; + cout << "Clique Size: " << n - s << endl; + found = true; + break; + } + for (j = 0; j < k; j++) + cover = procedure_2(neighbors, cover, j); + s = cover_size(cover); + if (s < min) + min = s; + outfile << "Clique (" << n - s << "): "; + for (j = 0; j < cover.size(); j++) + if (cover[j] == 0) + outfile << j + 1 << " "; + outfile << endl; + cout << "Clique Size: " << n - s << endl; + if (s <= k) + { + found = true; + break; + } + } + } + if (found) + cout << "Found Clique of size at least " << K << "." << endl; + else + cout << "Could not find Clique of size at least " << K << "." << endl + << "Maximum Clique size found is " << n - min << "." << endl; + cout << "See cliques.txt for results." << endl; + return 0; +} + +bool removable(vector neighbor, vector cover) +{ + bool check = true; + for (int i = 0; i < neighbor.size(); i++) + if (cover[neighbor[i]] == 0) + { + check = false; + break; + } + return check; +} + +int max_removable(vector > neighbors, vector cover) +{ + int r = -1, max = -1; + for (int i = 0; i < cover.size(); i++) + { + if (cover[i] == 1 && removable(neighbors[i], cover) == true) + { + vector temp_cover = cover; + temp_cover[i] = 0; + int sum = 0; + for (int j = 0; j < temp_cover.size(); j++) + if (temp_cover[j] == 1 && removable(neighbors[j], temp_cover) + == true) + sum++; + if (sum > max) + { + max = sum; + r = i; + } + } + } + return r; +} + +vector procedure_1(vector > neighbors, vector cover) +{ + vector temp_cover = cover; + int r = 0; + while (r != -1) + { + r = max_removable(neighbors, temp_cover); + if (r != -1) + temp_cover[r] = 0; + } + return temp_cover; +} + +vector procedure_2(vector > neighbors, vector cover, + int k) +{ + int count = 0; + vector temp_cover = cover; + int i = 0; + for (int i = 0; i < temp_cover.size(); i++) + { + if (temp_cover[i] == 1) + { + int sum = 0, index; + for (int j = 0; j < neighbors[i].size(); j++) + if (temp_cover[neighbors[i][j]] == 0) + { + index = j; + sum++; + } + if (sum == 1 && cover[neighbors[i][index]] == 0) + { + temp_cover[neighbors[i][index]] = 1; + temp_cover[i] = 0; + temp_cover = procedure_1(neighbors, temp_cover); + count++; + } + if (count > k) + break; + } + } + return temp_cover; +} + +int cover_size(vector cover) +{ + int count = 0; + for (int i = 0; i < cover.size(); i++) + if (cover[i] == 1) + count++; + return count; +} + +/* + +graph.txt: +4 +0 1 1 1 +1 0 1 1 +1 1 0 1 +1 1 1 0 + +cliques.txt: +Clique ( 4 ): 1 2 3 4 \ No newline at end of file diff --git a/c++/Hard_Graph_Problems/C++ Program to Find the Longest Path in a DAG.cpp b/c++/Hard_Graph_Problems/C++ Program to Find the Longest Path in a DAG.cpp new file mode 100644 index 0000000..7fd28b6 --- /dev/null +++ b/c++/Hard_Graph_Problems/C++ Program to Find the Longest Path in a DAG.cpp @@ -0,0 +1,155 @@ +/*This is a C++ Program to find longest path in DAG. Given a Weighted Directed Acyclic Graph (DAG) and a source vertex s in it, find the longest distances from s to all other vertices in the given graph. Following is complete algorithm for finding longest distances. +1) Initialize dist[] = {NINF, NINF, ….} and dist[s] = 0 where s is the source vertex. Here NINF means negative infinite. +2) Create a toplogical order of all vertices. +3) Do following for every vertex u in topological order. +………..Do following for every adjacent vertex v of u +………………if (dist[v] < dist[u] + weight(u, v)) ………………………dist[v] = dist[u] + weight(u, v) */ + +// A C++ program to find single source longest distances in a DAG +#include +#include +#include +#include +#define NINF INT_MIN +using namespace std; + +// Graph is represented using adjacency list. Every node of adjacency list +// contains vertex number of the vertex to which edge connects. It also +// contains weight of the edge +class AdjListNode +{ + int v; + int weight; +public: + AdjListNode(int _v, int _w) + { + v = _v; + weight = _w; + } + int getV() + { + return v; + } + int getWeight() + { + return weight; + } +}; + +// Class to represent a graph using adjacency list representation +class Graph +{ + int V; // No. of vertices’ + + // Pointer to an array containing adjacency lists + list *adj; + + // A function used by longestPath + void topologicalSortUtil(int v, bool visited[], stack &Stack); +public: + Graph(int V); // Constructor + + // function to add an edge to graph + void addEdge(int u, int v, int weight); + + // Finds longest distances from given source vertex + void longestPath(int s); +}; + +Graph::Graph(int V) // Constructor +{ + this->V = V; + adj = new list [V]; +} + +void Graph::addEdge(int u, int v, int weight) +{ + AdjListNode node(v, weight); + adj[u].push_back(node); // Add v to u’s list +} + +// A recursive function used by longestPath. See below link for details +// http://www.geeksforgeeks.org/topological-sorting/ +void Graph::topologicalSortUtil(int v, bool visited[], stack &Stack) +{ + // Mark the current node as visited + visited[v] = true; + // Recur for all the vertices adjacent to this vertex + list::iterator i; + for (i = adj[v].begin(); i != adj[v].end(); ++i) + { + AdjListNode node = *i; + if (!visited[node.getV()]) + topologicalSortUtil(node.getV(), visited, Stack); + } + // Push current vertex to stack which stores topological sort + Stack.push(v); +} + +// The function to find longest distances from a given vertex. It uses +// recursive topologicalSortUtil() to get topological sorting. +void Graph::longestPath(int s) +{ + stack Stack; + int dist[V]; + // Mark all the vertices as not visited + bool *visited = new bool[V]; + for (int i = 0; i < V; i++) + visited[i] = false; + // Call the recursive helper function to store Topological Sort + // starting from all vertices one by one + for (int i = 0; i < V; i++) + if (visited[i] == false) + topologicalSortUtil(i, visited, Stack); + // Initialize distances to all vertices as infinite and distance + // to source as 0 + for (int i = 0; i < V; i++) + dist[i] = NINF; + dist[s] = 0; + // Process vertices in topological order + while (Stack.empty() == false) + { + // Get the next vertex from topological order + int u = Stack.top(); + Stack.pop(); + // Update distances of all adjacent vertices + list::iterator i; + if (dist[u] != NINF) + { + for (i = adj[u].begin(); i != adj[u].end(); ++i) + if (dist[i->getV()] < dist[u] + i->getWeight()) + dist[i->getV()] = dist[u] + i->getWeight(); + } + } + // Print the calculated longest distances + for (int i = 0; i < V; i++) + (dist[i] == NINF) ? cout << "INF " : cout << dist[i] << " "; +} + +// Driver program to test above functions +int main() +{ + // Create a graph given in the above diagram. Here vertex numbers are + // 0, 1, 2, 3, 4, 5 with following mappings: + // 0=r, 1=s, 2=t, 3=x, 4=y, 5=z + Graph g(6); + g.addEdge(0, 1, 5); + g.addEdge(0, 2, 3); + g.addEdge(1, 3, 6); + g.addEdge(1, 2, 2); + g.addEdge(2, 4, 4); + g.addEdge(2, 5, 2); + g.addEdge(2, 3, 7); + g.addEdge(3, 5, 1); + g.addEdge(3, 4, -1); + g.addEdge(4, 5, -2); + int s = 1; + cout << "Following are longest distances from source vertex " << s << " \n"; + g.longestPath(s); + return 0; +} + +/* + +Following are longest distances from source vertex 1 +INF 0 2 9 8 10 \ No newline at end of file diff --git a/c++/Hard_Graph_Problems/C++ Program to Find the Maximum Size Clique in a Graph.cpp b/c++/Hard_Graph_Problems/C++ Program to Find the Maximum Size Clique in a Graph.cpp new file mode 100644 index 0000000..fca9cab --- /dev/null +++ b/c++/Hard_Graph_Problems/C++ Program to Find the Maximum Size Clique in a Graph.cpp @@ -0,0 +1,261 @@ +/*This is a C++ Program to find the cliques of size k in a a graph. An undirected graph is formed by a finite set of vertices and a set of unordered pairs of vertices, which are called edges. By convention, in algorithm analysis, the number of vertices in the graph is denoted by n and the number of edges is denoted by m. A clique in a graph G is a complete subgraph of G; that is, it is a subset S of the vertices such that every two vertices in S are connected by an edge in G. A maximal clique is a clique to which no more vertices can be added; a maximum clique is a clique that includes the largest possible number of vertices, and the clique number ?(G) is the number of vertices in a maximum clique of G.*/ + +#include +#include +#include +#include +using namespace std; + +bool removable(vector neighbor, vector cover); +int max_removable(vector > neighbors, vector cover); +vector procedure_1(vector > neighbors, vector cover); +vector procedure_2(vector > neighbors, vector cover, + int k); +int cover_size(vector cover); +ifstream infile("graph.txt"); +ofstream outfile("cliques.txt"); + +int main() +{ + //Read Graph (note we work with the complement of the input graph) + cout << "Clique Algorithm." << endl; + int n, i, j, k, K, p, q, r, s, min, edge, counter = 0; + infile >> n; + vector > graph; + for (i = 0; i < n; i++) + { + vector row; + for (j = 0; j < n; j++) + { + infile >> edge; + if (edge == 0) + row.push_back(1); + else + row.push_back(0); + } + graph.push_back(row); + } + //Find Neighbors + vector > neighbors; + for (i = 0; i < graph.size(); i++) + { + vector neighbor; + for (j = 0; j < graph[i].size(); j++) + if (graph[i][j] == 1) + neighbor.push_back(j); + neighbors.push_back(neighbor); + } + cout << "Graph has n = " << n << " vertices." << endl; + //Read maximum size of Clique wanted + cout << "Find a Clique of size at least k = "; + cin >> K; + k = n - K; + //Find Cliques + bool found = false; + cout << "Finding Cliques..." << endl; + min = n + 1; + vector > covers; + vector allcover; + for (i = 0; i < graph.size(); i++) + allcover.push_back(1); + for (i = 0; i < allcover.size(); i++) + { + if (found) + break; + counter++; + cout << counter << ". "; + outfile << counter << ". "; + vector cover = allcover; + cover[i] = 0; + cover = procedure_1(neighbors, cover); + s = cover_size(cover); + if (s < min) + min = s; + if (s <= k) + { + outfile << "Clique (" << n - s << "): "; + for (j = 0; j < cover.size(); j++) + if (cover[j] == 0) + outfile << j + 1 << " "; + outfile << endl; + cout << "Clique Size: " << n - s << endl; + covers.push_back(cover); + found = true; + break; + } + for (j = 0; j < n - k; j++) + cover = procedure_2(neighbors, cover, j); + s = cover_size(cover); + if (s < min) + min = s; + outfile << "Clique (" << n - s << "): "; + for (j = 0; j < cover.size(); j++) + if (cover[j] == 0) + outfile << j + 1 << " "; + outfile << endl; + cout << "Clique Size: " << n - s << endl; + covers.push_back(cover); + if (s <= k) + { + found = true; + break; + } + } + //Pairwise Intersections + for (p = 0; p < covers.size(); p++) + { + if (found) + break; + for (q = p + 1; q < covers.size(); q++) + { + if (found) + break; + counter++; + cout << counter << ". "; + outfile << counter << ". "; + vector cover = allcover; + for (r = 0; r < cover.size(); r++) + if (covers[p][r] == 0 && covers[q][r] == 0) + cover[r] = 0; + cover = procedure_1(neighbors, cover); + s = cover_size(cover); + if (s < min) + min = s; + if (s <= k) + { + outfile << "Clique (" << n - s << "): "; + for (j = 0; j < cover.size(); j++) + if (cover[j] == 0) + outfile << j + 1 << " "; + outfile << endl; + cout << "Clique Size: " << n - s << endl; + found = true; + break; + } + for (j = 0; j < k; j++) + cover = procedure_2(neighbors, cover, j); + s = cover_size(cover); + if (s < min) + min = s; + outfile << "Clique (" << n - s << "): "; + for (j = 0; j < cover.size(); j++) + if (cover[j] == 0) + outfile << j + 1 << " "; + outfile << endl; + cout << "Clique Size: " << n - s << endl; + if (s <= k) + { + found = true; + break; + } + } + } + if (found) + cout << "Found Clique of size at least " << K << "." << endl; + else + cout << "Could not find Clique of size at least " << K << "." << endl + << "Maximum Clique size found is " << n - min << "." << endl; + cout << "See cliques.txt for results." << endl; + return 0; +} + +bool removable(vector neighbor, vector cover) +{ + bool check = true; + for (int i = 0; i < neighbor.size(); i++) + if (cover[neighbor[i]] == 0) + { + check = false; + break; + } + return check; +} + +int max_removable(vector > neighbors, vector cover) +{ + int r = -1, max = -1; + for (int i = 0; i < cover.size(); i++) + { + if (cover[i] == 1 && removable(neighbors[i], cover) == true) + { + vector temp_cover = cover; + temp_cover[i] = 0; + int sum = 0; + for (int j = 0; j < temp_cover.size(); j++) + if (temp_cover[j] == 1 && removable(neighbors[j], temp_cover) + == true) + sum++; + if (sum > max) + { + max = sum; + r = i; + } + } + } + return r; +} + +vector procedure_1(vector > neighbors, vector cover) +{ + vector temp_cover = cover; + int r = 0; + while (r != -1) + { + r = max_removable(neighbors, temp_cover); + if (r != -1) + temp_cover[r] = 0; + } + return temp_cover; +} + +vector procedure_2(vector > neighbors, vector cover, + int k) +{ + int count = 0; + vector temp_cover = cover; + int i = 0; + for (int i = 0; i < temp_cover.size(); i++) + { + if (temp_cover[i] == 1) + { + int sum = 0, index; + for (int j = 0; j < neighbors[i].size(); j++) + if (temp_cover[neighbors[i][j]] == 0) + { + index = j; + sum++; + } + if (sum == 1 && cover[neighbors[i][index]] == 0) + { + temp_cover[neighbors[i][index]] = 1; + temp_cover[i] = 0; + temp_cover = procedure_1(neighbors, temp_cover); + count++; + } + if (count > k) + break; + } + } + return temp_cover; +} + +int cover_size(vector cover) +{ + int count = 0; + for (int i = 0; i < cover.size(); i++) + if (cover[i] == 1) + count++; + return count; +} + +/* + +graph.txt: +4 +0 1 1 1 +1 0 1 1 +1 1 0 1 +1 1 1 0 + +cliques.txt: +Clique ( 4 ): 1 2 3 4 \ No newline at end of file diff --git a/c++/Hard_Graph_Problems/C++ Program to Implement Nearest Neighbour Algorithm.cpp b/c++/Hard_Graph_Problems/C++ Program to Implement Nearest Neighbour Algorithm.cpp new file mode 100644 index 0000000..57fd280 --- /dev/null +++ b/c++/Hard_Graph_Problems/C++ Program to Implement Nearest Neighbour Algorithm.cpp @@ -0,0 +1,61 @@ +/*This is a C++ Program to implement nearest neighbour algorithm to solve TSP. This C++ program implements the Travelling Salesman Problem which computes the minimum cost required to visit all the nodes by traversing across the edges only once.*/ + +#include +#include +#include + +using namespace std; + +int c = 0, cost = 999; +int graph[4][4] = { { 0, 10, 15, 20 }, { 10, 0, 35, 25 }, { 15, 35, 0, 30 }, { + 20, 25, 30, 0 + } +}; + +void swap(int *x, int *y) +{ + int temp; + temp = *x; + *x = *y; + *y = temp; +} +void copy_array(int *a, int n) +{ + int i, sum = 0; + for (i = 0; i <= n; i++) + { + sum += graph[a[i % 4]][a[(i + 1) % 4]]; + } + if (cost > sum) + { + cost = sum; + } +} +void permute(int *a, int i, int n) +{ + int j, k; + if (i == n) + { + copy_array(a, n); + } + else + { + for (j = i; j <= n; j++) + { + swap((a + i), (a + j)); + permute(a, i + 1, n); + swap((a + i), (a + j)); + } + } +} +int main() +{ + int i, j; + int a[] = { 0, 1, 2, 3 }; + permute(a, 0, 3); + cout << "minimum cost:" << cost << endl; +} + +/* + +minimum cost:80 \ No newline at end of file diff --git a/c++/Hard_Graph_Problems/C++ Program to Implement Traveling Salesman Problem using Nearest neighbour Algorithm.cpp b/c++/Hard_Graph_Problems/C++ Program to Implement Traveling Salesman Problem using Nearest neighbour Algorithm.cpp new file mode 100644 index 0000000..7b7c0fc --- /dev/null +++ b/c++/Hard_Graph_Problems/C++ Program to Implement Traveling Salesman Problem using Nearest neighbour Algorithm.cpp @@ -0,0 +1,60 @@ +/* +* C++ Program to Implement Traveling Salesman Problem using Nearest neighbour Algorithm + */ +#include +#include +#include +using namespace std; +int c = 0,cost = 999; +int graph[4][4] = { {0, 10, 15, 20}, + {10, 0, 35, 25}, + {15, 35, 0, 30}, + {20, 25, 30, 0} +}; +void swap (int *x, int *y) +{ + int temp; + temp = *x; + *x = *y; + *y = temp; +} +void copy_array(int *a, int n) +{ + int i, sum = 0; + for(i = 0; i <= n; i++) + { + sum += graph[a[i % 4]][a[(i + 1) % 4]]; + } + if (cost > sum) + { + cost = sum; + } +} +void permute(int *a, int i, int n) +{ + int j, k; + if (i == n) + { + copy_array(a, n); + } + else + { + for (j = i; j <= n; j++) + { + swap((a + i), (a + j)); + permute(a, i + 1, n); + swap((a + i), (a + j)); + } + } +} +int main() +{ + int i, j; + int a[] = {0, 1, 2, 3}; + permute(a, 0, 3); + cout<<"minimum cost:"< + # include + # include + + + + class Matrix + { + private: + float matrix_a[3][3]; + float matrix_b[3][3]; + float matrix_c[3][3]; + + public: + Matrix( ); + + void get_matrix_a( ); + void get_matrix_b( ); + void multiply_matrices( ); + void show_result_Matrix( ); + }; + + + + + Matrix::Matrix( ) + { + for(int i=0;i<3;i++) + { + for(int j=0;j<3;j++) + { + matrix_a[i][j]=0; + matrix_b[i][j]=0; + matrix_c[i][j]=0; + } + } + + gotoxy(1,1); + cout<<" +************************************************************************** +****"< + # include + + + //------------------------ Function +rototypes ------------------------// + + + + const long fibonacci(const int); + + + //----------------------------- +main( ) -------------------------------// + + + + int main() + { + clrscr( ); + + int number; + + cout<<" + Enter the number ( 1 - 25 ) = "; + cin>>number; + + number=((number>25)?25:number); + + cout<<" + + The "< +using namespace std; +void line(), message(); +int main() +{ + cout << "The program starts in main()." << endl; + line(); + message(); + line(); + cout << "At the end of main()." << endl; + return 0; +} +void line() +{ + cout << "line();" << endl; +} +void message() +{ + cout << "In function message()." << endl; +} diff --git a/c++/Others/A Class as a Member Variable of Another Class.cpp b/c++/Others/A Class as a Member Variable of Another Class.cpp new file mode 100644 index 0000000..74efb83 --- /dev/null +++ b/c++/Others/A Class as a Member Variable of Another Class.cpp @@ -0,0 +1,178 @@ +A Class as a Member Variable of Another Class +This is an example of one object (the shape class implements a rectangle) being a member variable of another object (a brick). + +Header File: shape.h + +#ifndef _SHAPE_H +#define _SHAPE_H + +class FRectangle +{ +public: + FRectangle(double l = 0, double w = 0) + : Length(l), Width(w) {} + void setLength(double lgt); + void setWidth(double wdt); + double getLength() const; + double getWidth() const; + double Perimeter() const; + double Area() const; + void Properties(); +private: + double Length; + double Width; +}; + +#endif // _SHAPE_H + +Source File: shape.cpp + +#include +#include "shape.h" + +void FRectangle::setLength(double lgt) +{ + Length = lgt; +} + +void FRectangle::setWidth(double wdt) +{ + Width = wdt; +} + +double FRectangle::getLength() const +{ + return Length; +} + +double FRectangle::getWidth() const +{ + return Width; +} + +double FRectangle::Perimeter() const +{ + return 2 * (Length + Width); +} + +double FRectangle::Area() const +{ + return Length * Width; +} + +void FRectangle::Properties() +{ + cout << "\nRectangle characteristics"; + cout << "\n\tLength = " << Length; + cout << "\n\tWidth = " << Width; + cout << "\n\tPerimeter = " << Perimeter(); + cout << "\n\tArea = " << Area() << endl; +} + +Header File: brick.h + +#ifndef BRICK_H_ +#define BRICK_H_ + +#include "shape.h" + +class Brick +{ +public: + Brick() {} + void setThickness(double Tck); + void setDimensions(double l, double w, double t); + void setColor(char* clr); + void setTexture(char* txr); + char* getColor() const; + char* getTexture() const; + double Volume() const; + void Display(); +private: + FRectangle shape; + char* Color; + char* Texture; + double Thickness; +}; + +#endif // BRICK_H_ + +Source File: brick.cpp + +#include +#include "brick.h" + +void Brick::setThickness(double Tck) +{ + Thickness = Tck; +} + +void Brick::setColor(char* clr) +{ + Color = clr; +} + +void Brick::setTexture(char* txr) +{ + Texture = txr; +} + +void Brick::setDimensions(double l, double w, double t) +{ + shape.setLength(l); + shape.setWidth(w); + setThickness(t); +} + +char* Brick::getColor() const +{ + return Color; +} + +char* Brick::getTexture() const +{ + return Texture; +} + +double Brick::Volume() const +{ + return shape.getLength() * shape.getWidth() * Thickness; +} + +void Brick::Display() +{ + cout << "\nBrick characteristics"; + cout << "\n\tLength = " << shape.getLength(); + cout << "\n\tWidth = " << shape.getWidth(); + cout << "\n\tArea = " << shape.Area(); + cout << "\n\tVolume = " << Volume(); + cout << "\n\tColor = " << getColor(); + cout << "\n\tTextture = " << getTexture(); + cout << endl; +} + +Main File: Exo.cpp + +#include "shape.h" +#include "brick.h" + +void main() +{ + Brick brick; + + brick.setDimensions(12.50, 8.75, 5.55); + brick.setColor("Bone White"); + brick.setTexture("Early Breeze"); + + brick.Display(); +} + +Here is an example of running the program: + +Brick characteristics + Length = 12.5 + Width = 8.75 + Area = 109.375 + Volume = 607.031 + Color = Bone White + Textture = Early Breeze diff --git a/c++/Others/A Closer Look at the IO Operators.cpp b/c++/Others/A Closer Look at the IO Operators.cpp new file mode 100644 index 0000000..8fcb91d --- /dev/null +++ b/c++/Others/A Closer Look at the IO Operators.cpp @@ -0,0 +1,26 @@ +A Closer Look at the I/O Operators +#include + +using namespace std; + +int main() +{ + + float f; + + char str[80]; + + double d; + + cout << "Enter two floating point numbers: "; + + cin >> f >> d; + + cout << "Enter a string: "; + + cin >> str; + + cout << f << " " << d << " " << str; + + return 0; +} diff --git a/c++/Others/A Simple for Statement - generate the square root of 1 to 10.cpp b/c++/Others/A Simple for Statement - generate the square root of 1 to 10.cpp new file mode 100644 index 0000000..c9df834 --- /dev/null +++ b/c++/Others/A Simple for Statement - generate the square root of 1 to 10.cpp @@ -0,0 +1,19 @@ +A Simple for Statement - generate the square root of 1 to 10 + +#include +#include // for newer compilers, use +using namespace std; + +int main() +{ + int num; + double sq_root; + + for(num=1; num < 10; num++) { + sq_root = sqrt((double) num); //casting num from integer to double + // then taking its square root + cout << num << " " << sq_root << '\n'; + } + + return 0; +} diff --git a/c++/Others/A Simple if Statement.cpp b/c++/Others/A Simple if Statement.cpp new file mode 100644 index 0000000..65bbff2 --- /dev/null +++ b/c++/Others/A Simple if Statement.cpp @@ -0,0 +1,22 @@ +A Simple if Statement +This program illustrates a simple if statement. +It reads in two integers and prints out a +message on the screen according to their values. + +#include +using namespace std; + +int main() +{ + int a, b; + + cout << "Enter first number: "; + cin >> a; + cout << "Enter second number: "; + cin >> b; + + if(a < b) + cout << "First number is less than second.\n"; + + return 0; +} diff --git a/c++/Others/A Simple program finding the absolute value of an integer.cpp b/c++/Others/A Simple program finding the absolute value of an integer.cpp new file mode 100644 index 0000000..520262b --- /dev/null +++ b/c++/Others/A Simple program finding the absolute value of an integer.cpp @@ -0,0 +1,60 @@ +A Simple program finding the absolute value of an integer +A Simple program without using functions + +This program find the absolute value of an integer without using a function + +#include +using namespace std; + +int main() +{ + int number; + int abs_number; + + // Ask for input + cout << "This program finds the absolute value of an integer." << endl; + cout << "Enter an integer (positive or negative): "; + cin >> number; + + // Find the absolute value + if(number >= 0) + { + abs_number = number; + } + else + abs_number = -number; + + // Print out output + cout << "The absolute value of " << number << " is " << abs_number; + cout << endl; + return 0; +} + +The same program using function + +This program finds the absolute value of an integer using a function + +int Abs(int i); // Function prototype +int main() +{ + int number; + int abs_number; + + cout << "This program finds the absolute value of an integer." << endl; + cout << "Enter an integer (positive or negative): "; + cin >> number; + + // Calling the function Abs() + abs_number = Abs(number); + cout << "The absolute value of " << number << " is " << abs_number; + cout << endl; + return 0; +} +// Function definition +int Abs(int i) +{ + if( i >= 0) + return i; + else + return -i; +} diff --git a/c++/Others/A base pointer to access derived objects.cpp b/c++/Others/A base pointer to access derived objects.cpp new file mode 100644 index 0000000..990b839 --- /dev/null +++ b/c++/Others/A base pointer to access derived objects.cpp @@ -0,0 +1,34 @@ +A base pointer to access derived objects +#include +using namespace std; +class BaseClass { + int i; +public: + void setInt(int num) { + i = num; + } + int getInt() { + return i; + } +}; +class derived: public BaseClass { + int j; +public: + void setJ(int num) { + j = num; + } + int getJ() { + return j; + } +}; +int main() +{ + BaseClass *baseClassPointer; + derived d; + baseClassPointer = &d; // BaseClass pointer points to derived object + // access derived object using BaseClass pointer + baseClassPointer->setInt(10); + cout << baseClassPointer->getInt() << " "; + + return 0; +} diff --git a/c++/Others/A classical stack operation using a string of char.cpp b/c++/Others/A classical stack operation using a string of char.cpp new file mode 100644 index 0000000..4dcb61f --- /dev/null +++ b/c++/Others/A classical stack operation using a string of char.cpp @@ -0,0 +1,63 @@ +A classical stack operation using a string of characters. +#include +#include +using namespace std; +#define maxlen 80 + +class stack { + char str1[maxlen]; + int first; +public: + void clear(void); + char top(void); + int empty(void); + int full(void); + void push(char chr); + char pop(void); +}; + +void stack::clear(void) +{ + first=0; +} + char stack::top(void) +{ + return (str1[first]); +} + +int stack::empty(void) +{ + return (first==0); +} + +int stack::full(void) +{ + return (first==maxlen-1); +} + +void stack::push(char chr) +{ + str1[++first]=chr; +} +char stack::pop(void) +{ + return (str1[first-1]); +} + +main( ) +{ + stack mystack; + char str[11]="0123456789"; + + mystack.clear( ); + + for(int i=0; (int) i +#include +using namespace std; +#define maxlen 80 + +class stack { + char str1[maxlen]; + int first; +public: + void clear(void); + char top(void); + int empty(void); + int full(void); + void push(char chr); + char pop(void); +}; + +void stack::clear(void) +{ + first=0; +} + char stack::top(void) +{ + return (str1[first]); +} + +int stack::empty(void) +{ + return (first==0); +} + +int stack::full(void) +{ + return (first==maxlen-1); +} + +void stack::push(char chr) +{ + str1[++first]=chr; +} +char stack::pop(void) +{ + return (str1[first-1]); +} + +main( ) +{ + stack mystack; + char str[11]="0123456789"; + + mystack.clear( ); + + for(int i=0; (int) i +#include +#include +using namespace std; + +class StringClass { + char *p; +public: + StringClass(char *s); // constructor + StringClass(const StringClass &o); // copy constructor + ~StringClass() { // destructor + delete [] p; + } + char *get() { + return p; + } +}; + + +StringClass::StringClass(char *s) // "Normal" constructor +{ + int l; + + l = strlen(s)+1; + + p = new char [l]; + if(!p) { + cout << "Allocation error\n"; + exit(1); + } + + strcpy(p, s); +} + + +StringClass::StringClass(const StringClass &o) // Copy constructor +{ + int l; + + l = strlen(o.p)+1; + + p = new char [l]; // allocate memory for new copy + if(!p) { + cout << "Allocation error\n"; + exit(1); + } + + strcpy(p, o.p); // copy string into copy +} + +void show(StringClass x) +{ + char *s; + + s = x.get(); + cout << s << endl; +} + +int main() +{ + StringClass a("Hello World"), b("Hello World"); + + show(a); + show(b); + + return 0; +} diff --git a/c++/Others/A filter to remove white-space characters at the ends of lines..cpp b/c++/Others/A filter to remove white-space characters at the ends of lines..cpp new file mode 100644 index 0000000..acd9441 --- /dev/null +++ b/c++/Others/A filter to remove white-space characters at the ends of lines..cpp @@ -0,0 +1,24 @@ +A filter to remove white-space characters at the ends of lines. +#include +#include +using namespace std; +void cutline( void ); +string line; +int main() +{ + while( getline(cin, line)) { + cutline(); + cout << line << endl; + } + return 0; +} + +void cutline() +{ + int i = line.size(); + + while( i-- >= 0 ) + if( line[i] != ' ' && line[i] != '\t' ) + break; + line.resize(++i); +} diff --git a/c++/Others/A four-function postfix calculator..cpp b/c++/Others/A four-function postfix calculator..cpp new file mode 100644 index 0000000..9c644a0 --- /dev/null +++ b/c++/Others/A four-function postfix calculator..cpp @@ -0,0 +1,91 @@ +A four-function postfix calculator. +#include +#include +#include +#include +using namespace std; + +int main() +{ + stack stackObject; + double a, b; + string s; + + do { + cout << ": "; + cin >> s; + switch( s[ 0 ]) { + case 'q': // quit the calculator + break; + case '.': // show top-of-stack + cout << stackObject.top() << endl; + break; + case '+': // add + if(stackObject.size() < 2) { + cout << "Operand Missing\n"; + break; + } + + a = stackObject.top(); + stackObject.pop(); + b = stackObject.top(); + stackObject.pop(); + cout << a + b << endl; + stackObject.push(a + b); + break; + case '-': // subtract + // see if user entering a negative number + if(s.size() != 1) { + // push value onto the stack + stackObject.push(atof(s.c_str())); + break; + } + + // otherwise, is a subtraction + if(stackObject.size() < 2) { + cout << "Operand Missing\n"; + break; + } + + a = stackObject.top(); + stackObject.pop(); + b = stackObject.top(); + stackObject.pop(); + cout << b - a << endl; + stackObject.push(b - a); + break; + case '*': // multiply + if(stackObject.size() < 2) { + cout << "Operand Missing\n"; + break; + } + + a = stackObject.top(); + stackObject.pop(); + b = stackObject.top(); + stackObject.pop(); + cout << a*b << endl; + stackObject.push(a*b); + break; + case '/': // divide + if(stackObject.size() < 2) { + cout << "Operand Missing\n"; + break; + } + + a = stackObject.top(); + stackObject.pop(); + b = stackObject.top(); + stackObject.pop(); + cout << b/a << endl; + stackObject.push(b/a); + break; + default: + // push value onto the stack + stackObject.push(atof(s.c_str())); + break; + } + } while(s != "q"); + + return 0; +} diff --git a/c++/Others/A function object that computes an integer sum..cpp b/c++/Others/A function object that computes an integer sum..cpp new file mode 100644 index 0000000..863a3f7 --- /dev/null +++ b/c++/Others/A function object that computes an integer sum..cpp @@ -0,0 +1,34 @@ +A function object that computes an integer sum. +#include +#include +#include +#include +using namespace std; + +class sum : unary_function { +public: + argument_type sum; + + sum() { sum = 0; } + + result_type operator()(argument_type i) { + sum += i; + } +}; + +int main() +{ + vector v; + + for(int i=1; i < 11; i++) v.push_back(i); + + for(unsigned i=0; i < v.size(); ++i){ + cout << v[i] << endl; + } + sum s; + + s = for_each(v.begin(), v.end(), sum()); + cout << "sum of v: " << s.sum << endl; + + return 0; +} diff --git a/c++/Others/A generic bubble sort..cpp b/c++/Others/A generic bubble sort..cpp new file mode 100644 index 0000000..aace5f3 --- /dev/null +++ b/c++/Others/A generic bubble sort..cpp @@ -0,0 +1,38 @@ +A generic bubble sort. +#include +using namespace std; + + +template void bubble(X *data, int size) +{ + register int a, b; + X t; + + for(a=1; a < size; a++) + for(b=size-1; b >= a; b--) + if(data[b-1] > data[b]) { + t = data[b-1]; + data[b-1] = data[b]; + data[b] = t; + } +} + +int main() +{ + int i[] = {3, 2, 5, 6, 1, 8, 9, 3, 6, 9}; + double d[] = {1.2, 5.5, 2.2, 3.3}; + int j; + + bubble(i, 10); // sort ints + bubble(d, 4); // sort doubles + + for(j=0; j<10; j++) + cout << i[j] << ' '; + cout << endl; + + for(j=0; j<4; j++) + cout << d[j] << ' '; + cout << endl; + + return 0; +} diff --git a/c++/Others/A generic mode finding function..cpp b/c++/Others/A generic mode finding function..cpp new file mode 100644 index 0000000..d0eb958 --- /dev/null +++ b/c++/Others/A generic mode finding function..cpp @@ -0,0 +1,37 @@ +A generic mode finding function. +#include +#include +using namespace std; + + +template X mode(X *data, int size) +{ + register int t, w; + X md, oldmd; + int count, oldcount; + + oldmd = 0; + oldcount = 0; + for(t=0; t oldcount) { + oldmd = md; + oldcount = count; + } + } + return oldmd; +} + +int main() +{ + int i[] = { 1, 2, 3, 4, 2, 3, 2, 2, 1, 5}; + char *p = "this is a test"; + + cout << "mode of i: " << mode(i, 10) << endl; + cout << "mode of p: " << mode(p, (int) strlen(p)); + + return 0; +} diff --git a/c++/Others/A generic stack class.cpp b/c++/Others/A generic stack class.cpp new file mode 100644 index 0000000..8417579 --- /dev/null +++ b/c++/Others/A generic stack class.cpp @@ -0,0 +1,213 @@ +A generic stack class + +#include +#include +#include +#include + +using namespace std; + +#if !defined __STACK_H +#define __STACK_H + +namespace stk{ + template + class Stack; // Forward declaration of Stack class for overloaded << +operator + + template + ostream& operator<<(ostream &,Stack &); // template declaration of +<< +operator + + template + class Stack{ + private: + T *p; + int top,length; + + string str()const; + public: + Stack(); + Stack(const int); + Stack(const Stack&); + ~Stack(); + + void push(T); + T pop(); + int get_length()const; + bool is_empty()const; + Stack operator=(const Stack&); + + // only for basic types + friend ostream& operator<< <>(ostream&,Stack &); + + class StackException{ + private: + string desc; + public: + StackException(string exp){ desc="Exception : "+exp; } + string get_exp(){ return desc; } + }; + }; + + template + Stack::Stack(){ + top=-1; + length=0; + p=0; + } + + template + Stack::Stack(const int size){ + top=-1; + length=size; + try{ + p=new T[length]; + }catch(bad_alloc ba){ + cout<<"Memory can not be alllocated +"; + return; + } + } + + template + Stack::Stack(const Stack &o){ + top=o.top; + length=o.length; + try{ + p=new T[length]; + }catch(bad_alloc ba){ + cout<<"Memory allocation failed +"; + return; + } + for(int i=0;i + Stack::~Stack(){ + if(p!=0) + delete [] p; + } + + template + void Stack::push(T elem){ + if(p==0){ + try{ + p=new T[1]; + }catch(bad_alloc ba){ + throw StackException("Memory fault +"); + } + length++; + top++; + p[top]=elem; + } + else if(top==(length-1)){ + T *q; + try{ + q=new T[length+1]; + }catch(bad_alloc ba1){ + throw StackException("Memory fault +"); + } + for(int i=0;i + T Stack::pop(){ + if(p==0 || top==-1){ + throw StackException("Stack empty! +"); + } + T ret=p[top]; + top--; + length--; + + if(top==-1){ + delete [] p; + p=0; + } + else{ + T *q; + try{ + q=new T[length]; + }catch(bad_alloc ba){ + throw StackException("Memory fault +"); + } + for(int i=0;i + int Stack::get_length()const{ + return length; + } + + template + bool Stack::is_empty()const{ + return ((p==0)? true : false); + } + + template + string Stack::str()const{ // private member function + if(p==0) + return string(""); + stringstream ss; + for(int i=0;i + Stack Stack::operator=(const Stack &stk){ + length=stk.length; + top=stk.top; + + if(p!=0) + delete [] p; + try{ + p=new T[length]; + }catch(bad_alloc ba){ + throw StackException("Memory fault in copying! +"); + } + for(int i=0;i + ostream& operator<<(ostream &o,Stack &s){ + o< +using namespace std; + +#define SIZE 10 + +template class stack { + StackType stck[SIZE][2]; + int topOfStack; + +public: + void init() { topOfStack = 0; } + void push(StackType ob, StackType object2); + StackType pop(StackType &object2); +}; + +template +void stack::push(StackType ob, StackType object2) +{ + if(topOfStack==SIZE) { + cout << "Stack is full.\n"; + return; + } + stck[topOfStack][0] = ob; + stck[topOfStack][1] = object2; + topOfStack++; +} + +template +StackType stack::pop(StackType &object2) +{ + if(topOfStack==0) { + cout << "Stack is empty.\n"; + return 0; + } + topOfStack--; + object2 = stck[topOfStack][1]; + return stck[topOfStack][0]; +} + +int main() +{ + stack stack1, stackObject2; + int i; + char ch; + + stack1.init(); + stackObject2.init(); + + stack1.push('a', 'b'); + stackObject2.push('x', 'z'); + stack1.push('b', 'd'); + stackObject2.push('y', 'e'); + stack1.push('c', 'a'); + stackObject2.push('z', 'x'); + + for(i = 0; i <3; i++) { + cout << "Pop stack1: " << stack1.pop(ch); + cout << ' ' << ch << endl; + } + for(i = 0; i <3; i++) { + cout << "Pop stackObject2: " << stackObject2.pop(ch); + cout << ' ' << ch << endl; + } + + // demonstrate double stacks + stack doubleValueStack1, doubleValueStack2; // create two stacks + double d; + + doubleValueStack1.init(); + doubleValueStack2.init(); + + doubleValueStack1.push(1.1, 2.0); + doubleValueStack2.push(2.2, 3.0); + doubleValueStack1.push(3.3, 4.0); + doubleValueStack2.push(4.4, 5.0); + doubleValueStack1.push(5.5, 6.0); + doubleValueStack2.push(6.6, 7.0); + + for(i = 0; i <3; i++) { + cout << "Pop doubleValueStack1: " << doubleValueStack1.pop(d); + cout << ' '<< d << endl; + } + + for(i = 0; i <3; i++) { + cout << "Pop doubleValueStack2: " << doubleValueStack2.pop(d); + cout << ' '<< d << endl; + } + + return 0; +} diff --git a/c++/Others/A generic stack that includes exception handling..cpp b/c++/Others/A generic stack that includes exception handling..cpp new file mode 100644 index 0000000..571a5eb --- /dev/null +++ b/c++/Others/A generic stack that includes exception handling..cpp @@ -0,0 +1,86 @@ +A generic stack that includes exception handling. +#include +using namespace std; + +#define SIZE 10 + +template class stack { + StackType stck[SIZE]; + int topOfStack; + +public: + void init() { + topOfStack = 0; + } + void push(StackType ch); + StackType pop(); +}; + +template +void stack::push(StackType ob) +{ + try { + if(topOfStack==SIZE) throw SIZE; + } catch(int) { + cout << "Stack is full.\n"; + return; + } + stck[topOfStack] = ob; + topOfStack++; +} + +template +StackType stack::pop() +{ + try { + if( topOfStack == 0) + throw 0; + } catch(int) { + cout << "Stack is empty.\n"; + return 0; + } + topOfStack--; + return stck[topOfStack]; +} + +int main() +{ + stack stack1, stack2; + int i; + + stack1.init(); + stack2.init(); + + stack1.push('a'); + stack2.push('x'); + stack1.push('b'); + stack2.push('y'); + stack1.push('c'); + stack2.push('z'); + + for(i = 0; i <3; i++) + cout << "Pop stack1: " << stack1.pop() << endl; + for(i = 0; i <4; i++) + cout << "Pop stack2: " << stack2.pop() << endl; + + // demonstrate double stacks + stack doubleValueStack1, doubleValueStack2; // create two stacks + + // initialize the stacks + doubleValueStack1.init(); + doubleValueStack2.init(); + + doubleValueStack1.push(1.1); + doubleValueStack2.push(2.2); + doubleValueStack1.push(3.3); + doubleValueStack2.push(4.4); + doubleValueStack1.push(5.5); + doubleValueStack2.push(6.6); + + for(i = 0; i <3; i++) + cout << "Pop doubleValueStack1: " << doubleValueStack1.pop() << endl; + for(i = 0; i <4; i++) + cout << "Pop doubleValueStack2: " << doubleValueStack2.pop() << endl; + + return 0; +} diff --git a/c++/Others/A generic version of myabs()..cpp b/c++/Others/A generic version of myabs()..cpp new file mode 100644 index 0000000..7250df8 --- /dev/null +++ b/c++/Others/A generic version of myabs()..cpp @@ -0,0 +1,21 @@ +A generic version of myabs(). +#include +using namespace std; + +template X myabs(X val) +{ + return val < 0 ? -val : val; +} + +int main() +{ + cout << myabs(-10) << '\n'; // integer abs + + cout << myabs(-10.0) << '\n'; // double abs + + cout << myabs(-10L) << '\n'; // long abs + + cout << myabs(-10.0F) << '\n'; // float abs + + return 0; +} diff --git a/c++/Others/A list splicing example..cpp b/c++/Others/A list splicing example..cpp new file mode 100644 index 0000000..ec8d752 --- /dev/null +++ b/c++/Others/A list splicing example..cpp @@ -0,0 +1,65 @@ +A list splicing example. +#include +#include +#include +#include +using namespace std; + +int main() +{ + list sentence; + list phrase; + list::iterator p; + + string s1[] = {"A", "B", ""}; + string s2[] = {"C", "D", ""}; + string s3[] = {"E", "F", "G.", ""}; + string s4[] = {"A", "C,", "E", "G", ""}; + int i; + + for(i = 0; s1[ i ] != ""; i++) + sentence.push_back(s1[i]); + + + for(i = 0; s2[ i ] != ""; i++) + phrase.push_back(s2[ i ]); + + cout << "Original sentence:\n"; + p = sentence.begin(); + while(p != sentence.end()) + cout << *p++ << " "; + cout << endl; + + sentence.splice(sentence.begin(), phrase); + + cout << "Sentence after splicing at the front:\n"; + p = sentence.begin(); + while(p != sentence.end()) + cout << *p++ << " "; + cout << endl; + + for(i = 0; s3[ i ] != ""; i++) + phrase.push_back(s3[ i ]); + + sentence.splice(sentence.end(), phrase); + + cout << "Sentence after splicing at the end:\n"; + p = sentence.begin(); + while(p != sentence.end()) + cout << *p++ << " "; + cout << endl; + + for(i = 0; s4[ i ] != ""; i++) + phrase.push_back(s4[ i ]); + + + p = find(sentence.begin(), sentence.end(), "or"); + sentence.splice(p, phrase); + + cout << "Sentence after splicing in the middle:\n"; + p = sentence.begin(); + while(p != sentence.end()) + cout << *p++ << " "; + + return 0; +} diff --git a/c++/Others/A map insert pair, find, end.cpp b/c++/Others/A map insert pair, find, end.cpp new file mode 100644 index 0000000..2e4ea34 --- /dev/null +++ b/c++/Others/A map insert pair, find, end.cpp @@ -0,0 +1,28 @@ +A map: insert pair, find, end +#include +#include +using namespace std; + +int main() +{ + map mapObject; + int i; + + for(i = 0; i <10; i++) { + mapObject.insert(pair('A'+i, i)); + } + + char ch; + cout << "Enter key: "; + cin >> ch; + + map::iterator p; + + p = mapObject.find(ch); + if(p != mapObject.end()) + cout << p->second; + else + cout << "Key not in map.\n"; + + return 0; +} diff --git a/c++/Others/A map of opposites..cpp b/c++/Others/A map of opposites..cpp new file mode 100644 index 0000000..ab2a622 --- /dev/null +++ b/c++/Others/A map of opposites..cpp @@ -0,0 +1,64 @@ +A map of opposites. +#include +#include +#include +using namespace std; + +class StringClass { + char str[20]; +public: + StringClass() { + strcpy(str, ""); + } + StringClass(char *s) { + strcpy(str, s); + } + char *get() { + return str; + } +}; + +// must define less than relative to StringClass objects +bool operator<(StringClass a, StringClass b) +{ + return strcmp(a.get(), b.get()) < 0; +} + +class opposite { + char str[20]; +public: + opposite() { + strcmp(str, ""); + } + opposite(char *s) { + strcpy(str, s); + } + char *get() { + return str; + } +}; + + +int main() +{ + map mapObject; + + mapObject.insert(pair(StringClass("yes"), opposite("no"))); + mapObject.insert(pair(StringClass("good"), opposite("bad"))); + mapObject.insert(pair(StringClass("left"), opposite("right"))); + mapObject.insert(pair(StringClass("up"), opposite("down"))); + + char str[80]; + cout << "Enter word: "; + cin >> str; + + map::iterator p; + + p = mapObject.find(StringClass(str)); + if(p != mapObject.end()) + cout << "Opposite: " << p->second.get(); + else + cout << "Word not in map.\n"; + + return 0; +} diff --git a/c++/Others/A map of word opposites, using strings..cpp b/c++/Others/A map of word opposites, using strings..cpp new file mode 100644 index 0000000..f1f5b8c --- /dev/null +++ b/c++/Others/A map of word opposites, using strings..cpp @@ -0,0 +1,30 @@ +A map of word opposites, using strings. +#include +#include +#include +using namespace std; + +int main() +{ + map mapObject; + int i; + + mapObject.insert(pair("yes", "no")); + mapObject.insert(pair("up", "down")); + mapObject.insert(pair("left", "right")); + mapObject.insert(pair("good", "bad")); + + string s; + cout << "Enter word: "; + cin >> s; + + map::iterator p; + + p = mapObject.find(s); + if(p != mapObject.end()) + cout << "Opposite: " << p->second; + else + cout << "Word not in map.\n"; + + return 0; +} diff --git a/c++/Others/A namespace can be nested within another.cpp b/c++/Others/A namespace can be nested within another.cpp new file mode 100644 index 0000000..35f718c --- /dev/null +++ b/c++/Others/A namespace can be nested within another.cpp @@ -0,0 +1,20 @@ +A namespace can be nested within another +#include +using namespace std; +namespace MyNameSpace1 { + int i; + namespace MyNameSpace2 { // a nested namespace + int j; + } +} +int main() +{ + MyNameSpace1::i = 19; + + MyNameSpace1::MyNameSpace2::j = 10; + cout << MyNameSpace1::i << " "<< MyNameSpace1::MyNameSpace2::j << "\n"; + + using namespace MyNameSpace1; + cout << i * MyNameSpace2::j; + return 0; +} diff --git a/c++/Others/A shared resource example..cpp b/c++/Others/A shared resource example..cpp new file mode 100644 index 0000000..de15cf6 --- /dev/null +++ b/c++/Others/A shared resource example..cpp @@ -0,0 +1,56 @@ +A shared resource example. +#include +#include +using namespace std; + +class output { + static char sharedResource[255]; // this is the shared resource + static int inuse; // buffer available if 0; in use otherwise + static int oindex; // index of sharedResource + char str[80]; + int i; // index of next char in str + int who; // identifies the object, must be > 0 +public: + output(int w, char *s) { + strcpy(str, s); + i = 0; + who = w; + } + + int putbuf() + { + if(!str[ i ]) { // done outputting + inuse = 0; // release buffer + return 0; // signal termination + } + if(!inuse) // get buffer + inuse = who; + if(inuse != who) // in use by someone else + return -1; + if(str[ i ]) { // still chars to output + sharedResource[oindex] = str[ i ]; + i++; oindex++; + sharedResource[oindex] = '\0';// always keep null-terminated + return 1; + } + return 0; + } + void show() { + cout << sharedResource << '\n'; + } +}; + +char output::sharedResource[255]; // this is the shared resource +int output::inuse = 0; // buffer available if 0; in use otherwise +int output::oindex = 0; // index of sharedResource + +int main() +{ + output object1(1, "This is a test"), object2(2, " of statics"); + + while(object1.putbuf() | object2.putbuf()) ; // output chars + + object1.show(); + + return 0; +} diff --git a/c++/Others/A short string demonstration..cpp b/c++/Others/A short string demonstration..cpp new file mode 100644 index 0000000..536270a --- /dev/null +++ b/c++/Others/A short string demonstration..cpp @@ -0,0 +1,38 @@ +A short string demonstration. +#include +#include +using namespace std; + +int main() +{ + string str1("A"); + string str2("B"); + string str3("O"); + string str4; + + str4 = str1; + cout << str1 << "\n" << str3 << "\n"; + + str4 = str1 + str2; + cout << str4 << "\n"; + + str4 = str1 + " to " + str3; + cout << str4 << "\n"; + + if(str3 > str1) + cout << "str3 > str1\n"; + if(str3 == str1+str2) + cout << "str3 == str1+str2\n"; + + str1 = "This is a null-terminated string.\n"; + cout << str1; + + string str5(str1); + cout << str5; + + cout << "Enter a string: "; + cin >> str5; + cout << str5; + + return 0; +} diff --git a/c++/Others/A simple bounded 2-d array example..cpp b/c++/Others/A simple bounded 2-d array example..cpp new file mode 100644 index 0000000..5aa9aea --- /dev/null +++ b/c++/Others/A simple bounded 2-d array example..cpp @@ -0,0 +1,60 @@ +A simple bounded 2-d array example. +#include +#include +using namespace std; + +class MyArray { + int isize, jsize; + int *p; +public: + MyArray(int i, int j); + int &put(int i, int j); + int get(int i, int j); +}; + +MyArray::MyArray(int i, int j) +{ + p = new int [i*j]; + if(!p) { + cout << "Allocation error\n"; + exit(1); + } + isize = i; + jsize = j; +} + +int &MyArray::put(int i, int j) +{ + if(i <0 || i>=isize || j<0 || j>=jsize) { + cout << "Bounds error!!!\n"; + exit(1); + } + return p[i*jsize + j]; +} + +int MyArray::get(int i, int j) +{ + if(i <0 || i>=isize || j<0 || j>=jsize) { + cout << "Bounds error!!!\n"; + exit(1); + } + return p[i*jsize +j]; +} + +int main() +{ + MyArray a(2, 3); + int i, j; + + for(i = 0; i <2; i++) + for(j=0; j<3; j++) + a.put(i, j) = i+j; + + for(i = 0; i <2; i++) + for(j=0; j<3; j++) + cout << a.get(i, j) << ' '; + + a.put(10, 10); + + return 0; +} diff --git a/c++/Others/A simple class called Point, with all necessary functions.cpp b/c++/Others/A simple class called Point, with all necessary functions.cpp new file mode 100644 index 0000000..c66410b --- /dev/null +++ b/c++/Others/A simple class called Point, with all necessary functions.cpp @@ -0,0 +1,60 @@ +A simple class called Point, with all necessary functions + +# include +# include +# include + +class point +{ + int x,y,z; +public: + point() + { + x=y=z=0; + } + point(int i,int j,int k) + { + x=i; + y=j; + z=k; + } + point(point &a) + { + x=a.x; + y=a.y; + z=a.z; + } + + negate() + { + x=-x; + y=-y; + z=-z; + } + void print() + { + cout<<"("< +using namespace std; + +class who { + char name; +public: + who(char c) { + name = c; + cout << "Constructing who"; + cout << name << endl; + } + ~who() { + cout << "Destructing who: " << name << endl; + } +}; + +who makewho() +{ + who temp('B'); + return temp; +} + +int main() +{ + who ob('A'); + + makewho(); + + return 0; +} diff --git a/c++/Others/A simple conversion function example..cpp b/c++/Others/A simple conversion function example..cpp new file mode 100644 index 0000000..2f5f9f3 --- /dev/null +++ b/c++/Others/A simple conversion function example..cpp @@ -0,0 +1,60 @@ +A simple class with member variable, constructor, destructor +#include +using namespace std; + +class who { + char name; +public: + who(char c) { + name = c; + cout << "Constructing who"; + cout << name << endl; + } + ~who() { + cout << "Destructing who: " << name << endl; + } +}; + +who makewho() +{ + who temp('B'); + return temp; +} + +int main() +{ + who ob('A'); + + makewho(); + + return 0; +} +A simple conversion function example. +#include +using namespace std; + +class MyClass { + int x, y; +public: + MyClass(int i, int j) { + x = i; + y = j; + } + operator int() { + return x*y; + } +}; + +int main() +{ + MyClass object1(2, 3), object2(4, 3); + int i; + + i = object1; // automatically convert to integer + cout << i << '\n'; + + i = 100 + object2; // convert object2 to integer + cout << i << '\n'; + + return 0; +} diff --git a/c++/Others/A simple example of inheritance..cpp b/c++/Others/A simple example of inheritance..cpp new file mode 100644 index 0000000..ef96642 --- /dev/null +++ b/c++/Others/A simple example of inheritance..cpp @@ -0,0 +1,49 @@ +A simple example of inheritance. +#include +using namespace std; + +class BaseClass { + int i; +public: + void setInt(int n); + int getInt(); +}; + +class DerivedClass : public BaseClass { + int j; +public: + void setJ(int n); + int mul(); +}; + +void BaseClass::setInt(int n) +{ + i = n; +} + +int BaseClass::getInt() +{ + return i; +} + +void DerivedClass::setJ(int n) +{ + j = n; +} + +int DerivedClass::mul() +{ + return j * getInt(); +} + +int main() +{ + DerivedClass ob; + + ob.setInt(10); // load i in BaseClass + ob.setJ(4); // load j in DerivedClass + + cout << ob.mul(); // displays 40 + + return 0; +} diff --git a/c++/Others/A simple example using a virtual function..cpp b/c++/Others/A simple example using a virtual function..cpp new file mode 100644 index 0000000..d869cc5 --- /dev/null +++ b/c++/Others/A simple example using a virtual function..cpp @@ -0,0 +1,55 @@ +A simple example using a virtual function. +#include +using namespace std; + +class BaseClass { +public: + int i; + BaseClass(int x) { + i = x; + } + virtual void myFunction() + { + cout << "Using BaseClass version of myFunction(): "; + cout << i << '\n'; + } +}; + +class DerivedClass1 : public BaseClass { +public: + DerivedClass1(int x) : BaseClass(x) {} + void myFunction() + { + cout << "Using DerivedClass1's version of myFunction(): "; + cout << i*i << '\n'; + } +}; + +class DerivedClass2 : public BaseClass { +public: + DerivedClass2(int x) : BaseClass(x) {} + void myFunction() + { + cout << "Using DerivedClass2's version of myFunction(): "; + cout << i+i << '\n'; + } +}; + +int main() +{ + BaseClass *p; + BaseClass ob(10); + DerivedClass1 derivedObject1(10); + DerivedClass2 derivedObject2(10); + + p = &ob; + p->myFunction(); // use BaseClass's myFunction() + + p = &derivedObject1; + p->myFunction(); // use DerivedClass1's myFunction() + + p = &derivedObject2; + p->myFunction(); // use DerivedClass2's myFunction() + + return 0; +} diff --git a/c++/Others/A simple generic linked list..cpp b/c++/Others/A simple generic linked list..cpp new file mode 100644 index 0000000..65ec44f --- /dev/null +++ b/c++/Others/A simple generic linked list..cpp @@ -0,0 +1,48 @@ +A simple generic linked list. +#include +using namespace std; + +template class list { + dataType data; + list *next; +public: + list(dataType d); + void add(list *node) { + node->next = this; + next = 0; + } + list *getnext() { + return next; + } + dataType getdata() { + return data; + } +}; + +template list::list(dataType d) +{ + data = d; + next = 0; +} + +int main() +{ + list start('a'); + list *p, *last; + int i; + + last = &start; + for(i=1; i <26; i++) { + p = new list ('a' + i); + p->add(last); + last = p; + } + + p = &start; + while(p) { + cout << p->getdata(); + p = p->getnext(); + } + + return 0; +} diff --git a/c++/Others/A simple map char and int.cpp b/c++/Others/A simple map char and int.cpp new file mode 100644 index 0000000..f121e8a --- /dev/null +++ b/c++/Others/A simple map char and int.cpp @@ -0,0 +1,28 @@ +A simple map: char and int +#include +#include +using namespace std; + +int main() +{ + map mapObject; + int i; + + for(i = 0; i <26; i++) { + mapObject.insert(pair('A'+i, 65+i)); + } + + char ch; + cout << "Enter key: "; + cin >> ch; + + map::iterator p; + + p = mapObject.find(ch); + if(p != mapObject.end()) + cout << "Its ASCII value is " << p->second; + else + cout << "Key not in map.\n"; + + return 0; +} diff --git a/c++/Others/A simple output manipulator sethex.cpp b/c++/Others/A simple output manipulator sethex.cpp new file mode 100644 index 0000000..f7fc8c1 --- /dev/null +++ b/c++/Others/A simple output manipulator sethex.cpp @@ -0,0 +1,20 @@ +A simple output manipulator: sethex +#include +#include +using namespace std; + + +ostream &sethex(ostream &stream) +{ + stream.setf(ios::showbase); + stream.setf(ios::hex, ios::basefield); + + return stream; +} + +int main() +{ + cout << 256 << " " << sethex << 256; + + return 0; +} diff --git a/c++/Others/A simple program demonstrating the use of pointers..cpp b/c++/Others/A simple program demonstrating the use of pointers..cpp new file mode 100644 index 0000000..a377ad1 --- /dev/null +++ b/c++/Others/A simple program demonstrating the use of pointers..cpp @@ -0,0 +1,47 @@ +A simple program demonstrating the use of pointers. + +#include +using namespace std; + +int main() +{ + // declare an integer and a float variable + int IntNum; + float FloatNum; + + // declare integer and float pointers + int *pIntNum; + float *pFloatNum; + + // initialize the integer and float variables + IntNum = 10; + FloatNum = 12.34; + + // store addresses in pointers + pIntNum = &IntNum; + pFloatNum = &FloatNum; + + // print out the original values + cout << "Before increment: " << endl; + cout << "\t IntNum is: " << IntNum << endl; + cout << "\t FloatNum is: " << FloatNum << endl; + + // note that we need to dereference a pointer in order + // to extract the value it contains. + cout << "\t pIntNum contains: " << *pIntNum << endl; + cout << "\t pFloatNum contains: " << *pFloatNum << endl; + + // increment values of the integer and float variables + (*pIntNum)++; // dereference and then increment + (*pFloatNum)++; + + // print out the values after increment + cout << "After increment: " << endl; + cout << "\t IntNum is: " << IntNum << endl; + cout << "\t FloatNum is: " << FloatNum << endl; + + cout << "\t pIntNum contains: " << *pIntNum << endl; + cout << "\t pFloatNum contains: " << *pFloatNum << endl; + + return 0; +} diff --git a/c++/Others/A simple program demonstrating the use of reference.cpp b/c++/Others/A simple program demonstrating the use of reference.cpp new file mode 100644 index 0000000..dd1ee47 --- /dev/null +++ b/c++/Others/A simple program demonstrating the use of reference.cpp @@ -0,0 +1,40 @@ +A simple program demonstrating the use of reference + +#include +using namespace std; + +int main() +{ + int Len, Wid; // declare int variables + + // Create references to int variables. + // Now rLen and Len are aliases to each other, + // and rWid and Wid are also aliases to each other. + int &rLen = Len; + int &rWid = Wid; + + // Initialized the two int variables + Len = 10; // rLen is also initialized to be 10 + Wid = 20; // rWid is also initialized to be 20 + + // Printing out the values for int and int references + cout << "Len is: " << Len << ", and Wid is: " << Wid << endl; + cout << "rLen is: " << rLen << ", and rWid is: " << rWid << endl; + cout << endl; + + // Printing out the address of int and references to int + cout << "Address of Len is: " << &Len << endl; + cout << "Address of rLen is: " << &rLen << endl; + if(&Len == &rLen) + { + cout << "Address of Len is equal to address of rLen!" << endl; + } + cout << "Address of Wid is: " << &Wid << endl; + cout << "Address of rWid is: " << &rWid << endl; + if(&Wid == &Wid) + { + cout << "Address of Wid is equal to address of rWid!" << endl; + } + + return 0; +} diff --git a/c++/Others/A simple program showing inheritance.cpp b/c++/Others/A simple program showing inheritance.cpp new file mode 100644 index 0000000..c655432 --- /dev/null +++ b/c++/Others/A simple program showing inheritance.cpp @@ -0,0 +1,31 @@ +A simple program showing inheritance + +#include +using namespace std; + +class base { + int i, j; +public: + void set(int a, int b) { i = a; j = b; } + void show() { cout << i << " " << j << "\n"; } +}; + +// inheritance +class derived : public base { + int k; +public: + derived(int x) { k = x; } + void showk() { cout << k << "\n"; } +}; + +int main() +{ + derived ob(3); + + ob.set(1, 2); // access member of base + ob.show(); // access member of base + + ob.showk(); // uses member of derived class + + return 0; +} diff --git a/c++/Others/A simple stack example push, empty, pop and top.cpp b/c++/Others/A simple stack example push, empty, pop and top.cpp new file mode 100644 index 0000000..6fa9d82 --- /dev/null +++ b/c++/Others/A simple stack example push, empty, pop and top.cpp @@ -0,0 +1,22 @@ +A simple stack example: push, empty, pop and top +#include +#include +using namespace std; + +int main() +{ + stack stackObject; + + stackObject.push('A'); + stackObject.push('B'); + stackObject.push('C'); + stackObject.push('D'); + + while(!stackObject.empty()) { + cout << "Popping: "; + cout << stackObject.top() << endl; + stackObject.pop(); + } + + return 0; +} diff --git a/c++/Others/A static member variable example..cpp b/c++/Others/A static member variable example..cpp new file mode 100644 index 0000000..d37dccf --- /dev/null +++ b/c++/Others/A static member variable example..cpp @@ -0,0 +1,29 @@ +A static member variable example. +#include +using namespace std; + +class myclass { + static int i; +public: + void setInt(int n) { + i = n; + } + int getInt() { + return i; + } +}; + + +int myclass::i; // Definition of myclass::i. i is still private to myclass. + +int main() +{ + myclass object1, object2; + + object1.setInt(10); + + cout << "object1.i: " << object1.getInt() << '\n'; // displays 10 + cout << "object2.i: " << object2.getInt() << '\n'; // also displays 10 + + return 0; +} diff --git a/c++/Others/A string demonstration assignment, concatenate, compare.cpp b/c++/Others/A string demonstration assignment, concatenate, compare.cpp new file mode 100644 index 0000000..0bbe7da --- /dev/null +++ b/c++/Others/A string demonstration assignment, concatenate, compare.cpp @@ -0,0 +1,42 @@ +A string demonstration: assignment, concatenate, compare +#include +#include +using namespace std; + +int main() +{ + string str1("Alpha"); + string str2("Beta"); + string str3("Omega"); + string str4; + + str4 = str1; + cout << str1 << endl << str3 << endl; + + + str4 = str1 + str2; // concatenate two strings + cout << str4 << endl; + + str4 = str1 + " to " + str3; + cout << str4 << endl; + + + if(str3 > str1) // compare strings + cout << "str3 > str1\n"; + if(str3 == str1 + str2) + cout << "str3 == str1+str2\n"; + + str1 = "This is a null-terminated string.\n"; + cout << str1; + + // create a string object using another string object + string str5(str1); + cout << str5; + + // input a string + cout << "Enter a string: "; + cin >> str5; + cout << str5; + + return 0; +} diff --git a/c++/Others/A switch statement in action.cpp b/c++/Others/A switch statement in action.cpp new file mode 100644 index 0000000..9cfacf5 --- /dev/null +++ b/c++/Others/A switch statement in action.cpp @@ -0,0 +1,31 @@ +A switch statement in action +#include +using namespace std; +int main(void) +{ + char grade; + cout << "Enter your grade: "; + cin >> grade; + switch (grade) + { + case 'A': + cout << "Your average must be between 90 - 100" + << endl; + break; + case 'B': + cout << "Your average must be between 80 - 89" + << endl; + break; + case 'C': + cout << "Your average must be between 70 - 79" + << endl; + break; + case 'D': + cout << "Your average must be between 60 - 69" + << endl; + break; + default: + cout << "Your average must be below 60" << endl; + } + return 0; +} diff --git a/c++/Others/A vector may allocate more memory than it currently needs..cpp b/c++/Others/A vector may allocate more memory than it currently needs..cpp new file mode 100644 index 0000000..729618f --- /dev/null +++ b/c++/Others/A vector may allocate more memory than it currently needs..cpp @@ -0,0 +1,33 @@ +A vector may allocate more memory than it currently needs. +#include +#include +using namespace std; + +int main() +{ + vector vectorObject(10); + + cout << "Initial size: " << vectorObject.size() << endl; + cout << "Initial capacity: " << vectorObject.capacity(); + cout << "\n\n"; + + vectorObject.push_back('X'); + + cout << "Size after push_back: " << vectorObject.size() << endl; + cout << "New capacity: " << vectorObject.capacity(); + cout << "\n\n"; + + vectorObject.resize(100); + + cout << "Size after resize: " << vectorObject.size() << endl; + cout << "Capacity after resize: " << vectorObject.capacity(); + cout << "\n\n"; + + vectorObject.push_back('Y'); + + cout << "Size after push_back: " << vectorObject.size() << endl; + cout << "New capacity: " << vectorObject.capacity(); + cout << "\n\n"; + + return 0; +} diff --git a/c++/Others/A while Loop - Generate a random number between 0 and 9.cpp b/c++/Others/A while Loop - Generate a random number between 0 and 9.cpp new file mode 100644 index 0000000..b70da08 --- /dev/null +++ b/c++/Others/A while Loop - Generate a random number between 0 and 9.cpp @@ -0,0 +1,38 @@ +A while Loop - Generate a random number between 0 and 9 +and let the user guess it. +Use a while loop. Exit when user guessed right. + +#include +// is needed in order to use the rand(). +// For older compilers, use +#include +using namespace std; + +int main() +{ + int magic; // magic number + int guess; // user's guess + + cout << "I will come up with a magic number between 0 and 9 "; + cout << "and ask you to guess it." << endl; + + magic = rand()%10; // get a random number between 0 and 9 + + cout << "Enter your guess: "; + cin >> guess; + + while (guess != magic) // as long as guess is incorrect + { + if(guess > magic) + { + cout << "Too big! Guess again..." << endl; + } + else // guess is less than magic + { + cout << "Too small! Guess again..." << endl; + } + cin >> guess; + } + cout << "You are RIGHT!" << endl;; + return 0; +} diff --git a/c++/Others/Absolute Value Calculation.cpp b/c++/Others/Absolute Value Calculation.cpp new file mode 100644 index 0000000..8724500 --- /dev/null +++ b/c++/Others/Absolute Value Calculation.cpp @@ -0,0 +1,29 @@ +Absolute Value Calculation +This is a simple function that calculates the absolute value of a number: + +#include +using namespace std; + +double Abs(double Nbr) +{ +// return (Nbr >= 0) ? Nbr : -Nbr; + if( Nbr >= 0 ) + return Nbr; + else + return -Nbr; +} + +int main() +{ + double Number = -88; + double Nbr = Abs(Number); + + cout << "The absolute value of " << Number << " is " << Nbr << endl; + + return 0; +} + +Here is an example of running the program: + +The absolute value of -88 is 88 + diff --git a/c++/Others/Abstract base class.cpp b/c++/Others/Abstract base class.cpp new file mode 100644 index 0000000..4270ea2 --- /dev/null +++ b/c++/Others/Abstract base class.cpp @@ -0,0 +1,36 @@ +Abstract base class +#include +using namespace std; + +class CPolygon { + protected: + int width, height; + public: + void set_values (int a, int b) + { width=a; height=b; } + virtual int area (void) =0; +}; + +class CRectangle: public CPolygon { + public: + int area (void) + { return (width * height); } +}; + +class CTriangle: public CPolygon { + public: + int area (void) + { return (width * height / 2); } +}; + +int main () { + CRectangle rect; + CTriangle trgl; + CPolygon * ppoly1 = ▭ + CPolygon * ppoly2 = &trgl; + ppoly1->set_values (4,5); + ppoly2->set_values (4,5); + cout << ppoly1->area() << endl; + cout << ppoly2->area() << endl; + return 0; +} diff --git a/c++/Others/Abstract classes by virtual function with no body.cpp b/c++/Others/Abstract classes by virtual function with no body.cpp new file mode 100644 index 0000000..324d18a --- /dev/null +++ b/c++/Others/Abstract classes by virtual function with no body.cpp @@ -0,0 +1,42 @@ +Abstract classes by virtual function with no body +#include +using namespace std; + +class Animal{ +public: + Animal(int health = 100); + virtual void Greet() const = 0; //pure virtual member function + virtual void DisplayHealth() const; + +protected: + int m_Health; +}; + +Animal::Animal(int health): m_Health(health){} +void Animal::DisplayHealth() const{ + cout << "Health: " << m_Health << endl; +} + +class Orc : public Animal{ +public: + Orc(int health = 120); + virtual void Greet() const; +}; + +Orc::Orc(int health): + Animal(health) +{} + +void Orc::Greet() const +{ + cout << "The orc grunts hello.\n"; +} + +int main() +{ + Animal* pAnimal = new Orc(); + pAnimal->Greet(); + pAnimal->DisplayHealth(); + + return 0; +} diff --git a/c++/Others/Access a vector using an iterator..cpp b/c++/Others/Access a vector using an iterator..cpp new file mode 100644 index 0000000..a18a6bd --- /dev/null +++ b/c++/Others/Access a vector using an iterator..cpp @@ -0,0 +1,25 @@ +Access a vector using an iterator. +#include +#include +using namespace std; + +int main() +{ + vector v; + int i; + + for(i = 0; i <10; i++) + v.push_back(i); + + for(i = 0; i <10; i++) + cout << v[ i ] << " "; + cout << endl; + + vector::iterator p = v.begin(); + while(p != v.end()) { + cout << *p << " "; + p++; + } + + return 0; +} diff --git a/c++/Others/Access control under inheritance.cpp b/c++/Others/Access control under inheritance.cpp new file mode 100644 index 0000000..c2d18e6 --- /dev/null +++ b/c++/Others/Access control under inheritance.cpp @@ -0,0 +1,40 @@ +Access control under inheritance +#include +using namespace std; + +class Enemy +{ +public: + Enemy(): m_Damage(10) {} + + void Attack() const + { cout << "Attack inflicts " << m_Damage << " damage points!\n"; } + +protected: + int m_Damage; +}; + +class Boss : public Enemy +{ +public: + Boss(): m_DamageMultiplier(3) {} + + void SpecialAttack() const + { cout << "Special Attack inflicts " << (m_DamageMultiplier * m_Damage); + cout << " damage points!\n"; } + +private: + int m_DamageMultiplier; +}; + +int main() +{ + Enemy enemy1; + enemy1.Attack(); + + Boss boss1; + boss1.Attack(); + boss1.SpecialAttack(); + + return 0; +} diff --git a/c++/Others/Access out-of-range element.cpp b/c++/Others/Access out-of-range element.cpp new file mode 100644 index 0000000..5e56eea --- /dev/null +++ b/c++/Others/Access out-of-range element.cpp @@ -0,0 +1,39 @@ +Access out-of-range element +#include +using std::cout; +using std::endl; + +#include // vector class-template definition +#include // copy algorithm +#include // ostream_iterator iterator +#include // out_of_range exception + +int main() +{ + int array[ 6 ] = { 1, 2, 3, 4, 5, 6 }; + std::vector< int > integers( array, array + 6 ); + std::ostream_iterator< int > output( cout, " " ); + + integers.push_back( 2 ); + integers.push_back( 3 ); + integers.push_back( 4 ); + + cout << "Vector integers contains: "; + std::copy( integers.begin(), integers.end(), output ); + + try + { + integers.at( 100 ) = 777; + } catch ( std::out_of_range outOfRange ) // out_of_range exception + { + cout << "\n\nException: " << outOfRange.what(); + } + + return 0; +} + + /* +Vector integers contains: 1 2 3 4 5 6 2 3 4 + +Exception: vector::_M_range_check + */ diff --git a/c++/Others/Access the elements of a vector through an iterator..cpp b/c++/Others/Access the elements of a vector through an iterator..cpp new file mode 100644 index 0000000..1876e8e --- /dev/null +++ b/c++/Others/Access the elements of a vector through an iterator..cpp @@ -0,0 +1,45 @@ +Access the elements of a vector through an iterator. +#include +#include +using namespace std; + +int main() +{ + vector vectorObject(10); + vector::iterator p; + int i; + + p = vectorObject.begin(); + i = 0; + while(p != vectorObject.end()) { + *p = i; + p++; + i++; + } + + + cout << "Original contents:\n"; + p = vectorObject.begin(); + while(p != vectorObject.end()) { + cout << *p << " "; + p++; + } + cout << "\n\n"; + + + p = vectorObject.begin(); + while(p != vectorObject.end()) { + *p = *p * 2; // change contents of vector + p++; + } + + cout << "Modified Contents:\n"; + p = vectorObject.begin(); + while(p != vectorObject.end()) { + cout << *p << " "; // display contents of vector + p++; + } + cout << endl; + + return 0; +} diff --git a/c++/Others/Accessing Character Elements of an STL String.cpp b/c++/Others/Accessing Character Elements of an STL String.cpp new file mode 100644 index 0000000..dfee64d --- /dev/null +++ b/c++/Others/Accessing Character Elements of an STL String.cpp @@ -0,0 +1,17 @@ +Accessing Character Elements of an STL String +#include +#include + +int main(){ + using namespace std; + + string str ("Hello String"); + + for(size_t i = 0; i < str.length(); ++ i){ + cout << "Character [" << i << "] is: "; + cout << str [i] << endl; + } + cout << endl; + + return 0; +} diff --git a/c++/Others/Accessing Characters In Strings.cpp b/c++/Others/Accessing Characters In Strings.cpp new file mode 100644 index 0000000..68f4b86 --- /dev/null +++ b/c++/Others/Accessing Characters In Strings.cpp @@ -0,0 +1,40 @@ +Accessing Characters In Strings +#include +#include +#include +using namespace std; +int main() +{ + string text; + + cout << "Counts words. Enter a text and terminate with a period and return:\n"; + + getline( cin, text, '.'); // Reads a text up to the first '.' + + int i, // Index + + numberOfWhiteSpace = 0, // Number of white spaces + + numberOfWords = 0; // Number of words + + bool fSpace = true; // Flag for white space + for( i = 0; i < text.length(); ++i) + { + if( isspace( text[i]) ) // white space? + { + ++numberOfWhiteSpace; + fSpace = true; + } + else if( fSpace) // At the beginning of a word? + { + ++numberOfWords; + fSpace = false; + } + } + cout << "\nYour text contains (without periods)" + << "\ncharacters: " << text.length() + << "\nwords: " << numberOfWords + << "\nwhite spaces: " << numberOfWhiteSpace + << endl; + return 0; +} diff --git a/c++/Others/Accessing Data in a File.cpp b/c++/Others/Accessing Data in a File.cpp new file mode 100644 index 0000000..f24fc35 --- /dev/null +++ b/c++/Others/Accessing Data in a File.cpp @@ -0,0 +1,47 @@ +Accessing Data in a File +#include +#include +#include +#include +#include +#include +#include + +using namespace std; + +template +void print(T& c){ + for( typename T::iterator i = c.begin(); i != c.end(); i++ ){ + std::cout << *i << endl; + } +} + +int main(){ + vector output_data( 10 ); + generate( output_data.begin(), output_data.end(), rand ); + + transform( output_data.begin(), output_data.end(),output_data.begin(), bind2nd( modulus(), 10 ) ); + + ofstream out( "data.txt" ); + if( !out ) + { + cout << "Couldn't open output file\n"; + return 0; + } + + copy( output_data.begin(), output_data.end(),ostream_iterator( out, "\n" ) ); + out.close(); + + ifstream in( "data.txt" ); + if( !in ) + { + cout << "Couldn't open input file\n"; + return 0; + } + + vector input_data( (istream_iterator( in )),istream_iterator() ); + in.close(); + + print( output_data ); + print( input_data ); +} diff --git a/c++/Others/Accessing Private Data Members in C++. This is a flaw in the language.cpp b/c++/Others/Accessing Private Data Members in C++. This is a flaw in the language.cpp new file mode 100644 index 0000000..729bad2 --- /dev/null +++ b/c++/Others/Accessing Private Data Members in C++. This is a flaw in the language.cpp @@ -0,0 +1,58 @@ +Accessing Private Data Members in C++. This is a flaw in the language + +#include +#include +#include + +class bestcoder +{ + private: + + char name[40]; + char grade; + int age; + + public: + + bestcoder(char* nam="Some Dude",char gr='A',int saal=25) + { + strcpy(name,nam); + grade=gr; + age=saal; + } + + friend ostream& operator <<(ostream& s,bestcoder b); +}; + +ostream& operator <<(ostream& s,bestcoder b) +{ + s<<"Best Coder :"<grade='F'; + bettercoder->age=56; + cout<name,"xxx"); + bettercoder->age=14; + bettercoder->grade='A'; + cout< +#include +#include +#include + +// Forward declarations of the error handler and message handler. + +int err_handler(PDBPROCESS, INT, INT, INT, LPCSTR, LPCSTR); +int msg_handler(PDBPROCESS, DBINT, INT, INT, LPCSTR, LPCSTR, +LPCSTR, DBUSMALLINT); +main() +{ + PDBPROCESS dbproc; // The connection with SQL Server. + PLOGINREC login; // The login information. + DBCHAR name[100]; + DBCHAR city[100]; + +// Install user-supplied error- and message-handling functions. + + dberrhandle (err_handler); + dbmsghandle (msg_handler); + +// Initialize DB-Library. + + dbinit (); + +// Get a LOGINREC. + + login = dblogin (); + DBSETLUSER (login, "my_login"); + DBSETLPWD (login, "my_password"); + DBSETLAPP (login, "example"); + +// Get a DBPROCESS structure for communication with SQL Server. + + dbproc = dbopen (login, "my_server"); + +// Retrieve some columns from the authors table in the +// pubs database. +// First, put the command into the command buffer. + + dbcmd (dbproc, "SELECT au_lname, city FROM pubs..authors"); + dbcmd (dbproc, " WHERE state = 'CA' "); + +// Send the command to SQL Server and start execution. + + dbsqlexec (dbproc); + +// Process the results. + + if (dbresults (dbproc) == SUCCEED) + { + +// Bind column to program variables. + + dbbind (dbproc, 1, NTBSTRINGBIND, 0, name); + dbbind (dbproc, 2, NTBSTRINGBIND, 0, city); + +// Retrieve and print the result rows. + + while (dbnextrow (dbproc) != NO_MORE_ROWS) + { + printf ("%s from %s\n", name, city); + } + } + +// Close the connection to SQL Server. + + dbexit (); + return (0); +} + +int err_handler (PDBPROCESS dbproc, INT severity, +INT dberr, INT oserr, LPCSTR dberrstr, LPCSTR oserrstr) +{ + printf ("DB-Library Error %i: %s\n", dberr, dberrstr); + if (oserr != DBNOERR) + { + printf ("Operating System Error %i: %s\n", oserr, oserrstr); + } + return (INT_CANCEL); +} + +int msg_handler (PDBPROCESS dbproc, DBINT msgno, INT msgstate, +INT severity, LPCSTR msgtext, LPCSTR server, +LPCSTR procedure, DBUSMALLINT line) +{ + printf ("SQL Server Message %ld: %s\n", msgno, msgtext); + return (0); +} diff --git a/c++/Others/Accessing a Vector Through an Iterator.cpp b/c++/Others/Accessing a Vector Through an Iterator.cpp new file mode 100644 index 0000000..c3c27de --- /dev/null +++ b/c++/Others/Accessing a Vector Through an Iterator.cpp @@ -0,0 +1,43 @@ +Accessing a Vector Through an Iterator +#include +#include +#include +using namespace std; +int main() +{ + vector vectorObject(10); + vector::iterator p; // create an iterator + int i; + + + p = vectorObject.begin(); + i = 0; + while(p != vectorObject.end()) { + *p = i + 'a'; + p++; + i++; + } + + cout << "Original contents:\n"; + p = vectorObject.begin(); + while(p != vectorObject.end()) { + cout << *p << " "; + p++; + } + cout << "\n\n"; + // change contents of vector + p = vectorObject.begin(); + while(p != vectorObject.end()) { + *p = toupper(*p); + p++; + } + // display contents of vector + cout << "Modified Contents:\n"; + p = vectorObject.begin(); + while(p != vectorObject.end()) { + cout << *p << " "; + p++; + } + cout << endl; + return 0; +} diff --git a/c++/Others/Accessing static members without an object..cpp b/c++/Others/Accessing static members without an object..cpp new file mode 100644 index 0000000..56ef21e --- /dev/null +++ b/c++/Others/Accessing static members without an object..cpp @@ -0,0 +1,44 @@ +Accessing static members without an object. +#include +using namespace std; +class Cat +{ +public: + Cat(int age):itsAge(age){count++; } + virtual ~Cat() { count--; } + virtual int GetAge() { return itsAge; } + virtual void SetAge(int age) { itsAge = age; } + static int count; + +private: + int itsAge; + +}; + +int Cat::count = 0; + +void TelepathicFunction(); + +int main() +{ + const int MaxCats = 5; int i; + Cat *CatHouse[MaxCats]; + for (i = 0; i +#include +#include +#include +using namespace std; + +double arithmeticMean(const vector& nums) +{ + double sum = accumulate(nums.begin(), nums.end(), 0); + return (sum / nums.size()); +} + +int product(int num1, int num2) +{ + return (num1 * num2); +} + +int main(int argc, char** argv) +{ + vector myVector; + + myVector.push_back(1); + myVector.push_back(2); + myVector.push_back(3); + myVector.push_back(4); + + cout << "The arithmetic mean is " << arithmeticMean(myVector) << endl; + + return (0); +} diff --git a/c++/Others/Add a friend extractor for objects of type MyClass..cpp b/c++/Others/Add a friend extractor for objects of type MyClass..cpp new file mode 100644 index 0000000..5d2551c --- /dev/null +++ b/c++/Others/Add a friend extractor for objects of type MyClass..cpp @@ -0,0 +1,43 @@ +Add a friend extractor for objects of type MyClass. +#include +using namespace std; + +class MyClass { + int x, y; +public: + MyClass() { + x = 0; + y = 0; + } + MyClass(int i, int j) { + x = i; + y = j; + } + friend ostream &operator<<(ostream &stream, MyClass ob); + friend istream &operator>>(istream &stream, MyClass &ob); +}; + +ostream &operator<<(ostream &stream, MyClass ob) +{ + stream << ob.x << ", " << ob.y << '\n'; + return stream; +} + +istream &operator>>(istream &stream, MyClass &ob) +{ + cout << "Enter MyClassinates: "; + stream >> ob.x >> ob.y; + return stream; +} + +int main() +{ + MyClass a(1, 1), b(10, 23); + + cout << a << b; + + cin >> a; + cout << a; + + return 0; +} diff --git a/c++/Others/Add an else part to the if statement.cpp b/c++/Others/Add an else part to the if statement.cpp new file mode 100644 index 0000000..454fb65 --- /dev/null +++ b/c++/Others/Add an else part to the if statement.cpp @@ -0,0 +1,14 @@ +Add an else part to the if statement +#include +using namespace std; +int main(void) +{ + int num; + cout << "Enter a whole number: "; + cin >> num; + if ( num % 2 == 0 ) + cout << "The number is even" << endl; + else + cout << "The number is odd" << endl; + return 0; +} diff --git a/c++/Others/Add elements in a list to a set.cpp b/c++/Others/Add elements in a list to a set.cpp new file mode 100644 index 0000000..78b6c2a --- /dev/null +++ b/c++/Others/Add elements in a list to a set.cpp @@ -0,0 +1,36 @@ + + +Add elements in a list to a set +#include +#include +#include +#include +#include +using namespace std; + +int main() +{ + string s("There is no distinctly native American criminal class"); + + + list list1(s.begin(), s.end()); + + // Put the characters in list1 into set1: + set set1; + list::iterator i; + + for (i = list1.begin(); i != list1.end(); ++i) + set1.insert(*i); + + set::iterator j; + + for (j = set1.begin(); j != set1.end(); ++j) + cout << *j; + + + return 0; +} + +/* + ATacdehilmnorstvy + */ diff --git a/c++/Others/Add elements in a multiset to a list.cpp b/c++/Others/Add elements in a multiset to a list.cpp new file mode 100644 index 0000000..0345578 --- /dev/null +++ b/c++/Others/Add elements in a multiset to a list.cpp @@ -0,0 +1,36 @@ +Add elements in a multiset to a list +#include +#include +#include +#include +#include +using namespace std; + +int main() +{ + string s("There is no distinctly native American criminal class"); + + list list1(s.begin(), s.end()); + + // Put the characters in list1 into multiset1: + multiset multiset1; + list::iterator i; + for (i = list1.begin(); i != list1.end(); ++i) + multiset1.insert(*i); + + // Put the characters in multiset1 into list2: + list list2; + multiset::iterator k; + for (k = multiset1.begin(); k != multiset1.end(); ++k) + list2.push_back(*k); + + + for (i = list2.begin(); i != list2.end(); ++i) + cout << *i; + + return 0; +} + +/* + ATaaaaccccdeeeehiiiiiiilllmmnnnnnorrrsssstttvy" + */ diff --git a/c++/Others/Add elements in a set to a list.cpp b/c++/Others/Add elements in a set to a list.cpp new file mode 100644 index 0000000..1900d5a --- /dev/null +++ b/c++/Others/Add elements in a set to a list.cpp @@ -0,0 +1,39 @@ +Add elements in a set to a list +#include +#include +#include +#include +#include +using namespace std; + +int main() +{ + string s("There is no distinctly native American criminal class"); + + + list list1(s.begin(), s.end()); + + // Put the characters in list1 into set1: + set set1; + list::iterator i; + + for (i = list1.begin(); i != list1.end(); ++i) + set1.insert(*i); + + set::iterator j; + + list list2; + set::iterator k; + for (k = set1.begin(); k != set1.end(); ++k) + list2.push_back(*k); + + + for (i = list2.begin(); i != list2.end(); ++i) + cout << *i; + + return 0; +} + +/* + ATacdehilmnorstvy + */ diff --git a/c++/Others/Adding Strings.cpp b/c++/Others/Adding Strings.cpp new file mode 100644 index 0000000..cb32f7a --- /dev/null +++ b/c++/Others/Adding Strings.cpp @@ -0,0 +1,11 @@ +Adding Strings +#include +#include +using namespace std; +int main(void) +{ + string firstName = "gggg"; + string lastName = "uuuut"; + cout << "Your name is " << firstName + lastName; + return 0; +} diff --git a/c++/Others/Addition operator in cout.cpp b/c++/Others/Addition operator in cout.cpp new file mode 100644 index 0000000..4fb601f --- /dev/null +++ b/c++/Others/Addition operator in cout.cpp @@ -0,0 +1,17 @@ +Addition operator in cout +#include +using namespace std; +int main(void) +{ + int total, added, dropped; + cout << "Enter total: "; + cin >> total; + cout << "Enter added: "; + cin >> added; + total = total + added; + cout << "Enter dropped "; + cin >> dropped; + total -= dropped; + cout << "Number: " << total << endl; + return 0; +} diff --git a/c++/Others/Additional meanings for the + and = operations.cpp b/c++/Others/Additional meanings for the + and = operations.cpp new file mode 100644 index 0000000..62d2de5 --- /dev/null +++ b/c++/Others/Additional meanings for the + and = operations.cpp @@ -0,0 +1,69 @@ +Additional meanings for the + and = operations +#include +#include +using namespace std; +class str_type { + char string[80]; +public: + str_type(char *str = "\0") { strcpy(string, str); } + + str_type operator+(str_type str); + str_type operator+(char *str); + + str_type operator=(str_type str); + str_type operator=(char *str); + + void show_str(void) { cout << string; } +} ; + +str_type str_type::operator+(str_type str) { + str_type temp; + + strcpy(temp.string, string); + strcat(temp.string, str.string); + return temp; +} + +str_type str_type::operator=(str_type str) { + strcpy(string, str.string); + return *this; +} + +str_type str_type::operator=(char *str) +{ + str_type temp; + + strcpy(string, str); + strcpy(temp.string, string); + return temp; +} + +str_type str_type::operator+(char *str) +{ + str_type temp; + + strcpy(temp.string, string); + strcat(temp.string, str); + return temp; +} + +main(void) +{ + str_type a("Hello "), b("There"), c; + + c = a + b; + + c.show_str(); + cout << "\n"; + + a = "to program in because"; + a.show_str(); + cout << "\n"; + + b = c = "C++ is fun"; + + c = c+" "+a+" "+b; + c.show_str(); + + return 0; +} diff --git a/c++/Others/Address class class definition and implementation.cpp b/c++/Others/Address class class definition and implementation.cpp new file mode 100644 index 0000000..44ada2f --- /dev/null +++ b/c++/Others/Address class class definition and implementation.cpp @@ -0,0 +1,44 @@ +Address class: class definition and implementation +#include +#include +using namespace std; + +class Address { + char name[40]; + char street[40]; + char city[30]; + char state[3]; + char zip[10]; +public: + void store(char *n, char *s, char *c, char *t, char *z); + void display(); +}; + +void Address::store(char *n, char *s, char *c, char *t, char *z) +{ + strcpy(name, n); + strcpy(street, s); + strcpy(city, c); + strcpy(state, t); + strcpy(zip, z); +} + +void Address::display() +{ + cout << name << endl; + cout << street << endl; + cout << city << endl; + cout << state << endl; + cout << zip << endl; +} + +int main() +{ + Address a; + + a.store("C", "11 Lane", "W", "In", "4"); + + a.display(); + + return 0; +} diff --git a/c++/Others/An Array of Pointers to Class.cpp b/c++/Others/An Array of Pointers to Class.cpp new file mode 100644 index 0000000..85d6547 --- /dev/null +++ b/c++/Others/An Array of Pointers to Class.cpp @@ -0,0 +1,66 @@ +An Array of Pointers to Class +This program is an example of using an array of pointers to a class. +After declaring the array, you can allocate memory for each element using the new operator. +To access a member variable or a method of an element, you can use the -> operator: + +#include +using namespace std; + +class CSquare +{ +public: + double Side; + + CSquare() : Side(0.00) {} + CSquare(double side) : Side(side) { } + ~CSquare() { } + + double getSide() const { return Side; } + void setSide(const double s) + { + if( s <= 0 ) + Side = 0.00; + else + Side = s; + } + + double Perimeter() { return Side * 4; } + double Area() { return Side * Side; } +}; + +int main() +{ + CSquare *sqr[4]; + + sqr[0] = new CSquare; + sqr[0]->setSide(24.55); + sqr[1] = new CSquare; + sqr[1]->setSide(15.08); + sqr[2] = new CSquare; + sqr[2]->setSide(8.212); + sqr[3] = new CSquare; + sqr[3]->setSide(202.24); + + cout << "Squares Characteristics" << endl; + cout << "Square 1" << endl; + cout << "Side: " << sqr[0]->getSide() << endl; + cout << "Perimeter: " << sqr[0]->Perimeter() << endl; + cout << "Area: " << sqr[0]->Area() << endl; + + cout << "Square 2" << endl; + cout << "Side: " << sqr[1]->getSide() << endl; + cout << "Perimeter: " << sqr[1]->Perimeter() << endl; + cout << "Area: " << sqr[1]->Area() << endl; + + cout << "Square 3" << endl; + cout << "Side: " << sqr[2]->getSide() << endl; + cout << "Perimeter: " << sqr[2]->Perimeter() << endl; + cout << "Area: " << sqr[2]->Area() << endl; + + cout << "Square 4" << endl; + cout << "Side: " << sqr[3]->getSide() << endl; + cout << "Perimeter: " << sqr[3]->Perimeter() << endl; + cout << "Area: " << sqr[3]->Area() << endl; + + return 0; +} diff --git a/c++/Others/An Example of Exception Handling.cpp b/c++/Others/An Example of Exception Handling.cpp new file mode 100644 index 0000000..6a808ca --- /dev/null +++ b/c++/Others/An Example of Exception Handling.cpp @@ -0,0 +1,39 @@ +An Example of Exception Handling +#include +using namespace std; + +int main() +{ + unsigned int TypeOfLoan = 0; + const char *LoanType[] = { "Personal", + "Car", + "Furniture", + "Musical Instrument", + "Boat" }; + + try { + cout << "Enter the type of loan\n"; + for(int i = 0; i < 4; i++) + cout << i + 1 << ") " << LoanType[i] << endl; + cout << "Your choice: "; + cin >> TypeOfLoan; + + if( TypeOfLoan < 1 || TypeOfLoan > 5 ) + throw "Number out of range\n"; + + cout << "\nType of Loan: " << LoanType[TypeOfLoan] << endl; + } + catch(const char* Msg) + { + cout << "Error: " << Msg << endl; + } + catch(...) + { + cout << "\nSomething went wrong\n\n"; + } + + return 0; +} + + + diff --git a/c++/Others/An Example with Two Generic Data Types.cpp b/c++/Others/An Example with Two Generic Data Types.cpp new file mode 100644 index 0000000..8565d34 --- /dev/null +++ b/c++/Others/An Example with Two Generic Data Types.cpp @@ -0,0 +1,23 @@ +An Example with Two Generic Data Types +#include +using namespace std; + +template class myclass +{ + Type1 i; + Type2 j; +public: + myclass(Type1 a, Type2 b) { i = a; j = b; } + void show() { cout << i << ' ' << j << '\n'; } +}; + +int main() +{ + myclass ob1(10, 0.23); + myclass ob2('X', "Templates add power."); + + ob1.show(); + ob2.show(); + + return 0; +} diff --git a/c++/Others/An array-based output stream.cpp b/c++/Others/An array-based output stream.cpp new file mode 100644 index 0000000..f1bfeb4 --- /dev/null +++ b/c++/Others/An array-based output stream.cpp @@ -0,0 +1,15 @@ +An array-based output stream +#include +#include +using namespace std; +int main() +{ + char str[80]; + ostrstream outs(str, sizeof(str)); + outs << "array-based I/O. "; + outs << 1024 << hex << " "; + outs.setf(ios::showbase); + outs << 100 << ' ' << 99.789 << ends; + cout << str; + return 0; +} diff --git a/c++/Others/An example that uses typeid for base and derived classes.cpp b/c++/Others/An example that uses typeid for base and derived classes.cpp new file mode 100644 index 0000000..27df9c3 --- /dev/null +++ b/c++/Others/An example that uses typeid for base and derived classes.cpp @@ -0,0 +1,42 @@ +An example that uses typeid for base and derived classes +#include +#include +using namespace std; + +class BaseClass { + virtual void f() {}; // make BaseClass polymorphic + +}; + +class Derived1: public BaseClass { + +}; + +class Derived2: public BaseClass { + +}; + +int main() +{ + int i; + BaseClass *p, baseob; + Derived1 object1; + Derived2 object2; + + cout << "Typeid of i is "; + cout << typeid(i).name() << endl; + + p = &baseob; + cout << "p is pointing to an object of type "; + cout << typeid(*p).name() << endl; + + p = &object1; + cout << "p is pointing to an object of type "; + cout << typeid(*p).name() << endl; + + p = &object2; + cout << "p is pointing to an object of type "; + cout << typeid(*p).name() << endl; + + return 0; +} diff --git a/c++/Others/An example that uses typeid on a polymorphic class hierarchy.cpp b/c++/Others/An example that uses typeid on a polymorphic class hierarchy.cpp new file mode 100644 index 0000000..2028238 --- /dev/null +++ b/c++/Others/An example that uses typeid on a polymorphic class hierarchy.cpp @@ -0,0 +1,35 @@ +An example that uses typeid on a polymorphic class hierarchy +#include +#include +using namespace std; +class Mammal { +public: + virtual bool laysEggs() { + return false; + } +}; +class Cat: public Mammal { +public: +}; +class Platypus: public Mammal { +public: + bool laysEggs() { + return true; + } +}; +int main() +{ + Mammal *p, AnyMammal; + Cat cat; + Platypus platypus; + p = &AnyMammal; + cout << "p is pointing to an object of type "; + cout << typeid(*p).name() << endl; + p = &cat; + cout << "p is pointing to an object of type "; + cout << typeid(*p).name() << endl; + p = &platypus; + cout << "p is pointing to an object of type "; + cout << typeid(*p).name() << endl; + return 0; +} diff --git a/c++/Others/An exception can be thrown from outside the try block.cpp b/c++/Others/An exception can be thrown from outside the try block.cpp new file mode 100644 index 0000000..c6fa7b8 --- /dev/null +++ b/c++/Others/An exception can be thrown from outside the try block.cpp @@ -0,0 +1,25 @@ +An exception can be thrown from outside the try block +#include +using namespace std; + +void myFunction(int test) +{ + cout << "Inside myFunction, test is: " << test << "\n"; + if(test) throw test; +} +int main() +{ + cout << "Start\n"; + try { + cout << "Inside try block\n"; + myFunction(0); + myFunction(1); + myFunction(2); + } + catch (int i) { + cout << "Caught an exception -- value is: "; + cout << i << "\n"; + } + cout << "End"; + return 0; +} diff --git a/c++/Others/An implementation of Stack data structure.cpp b/c++/Others/An implementation of Stack data structure.cpp new file mode 100644 index 0000000..1505d2e --- /dev/null +++ b/c++/Others/An implementation of Stack data structure.cpp @@ -0,0 +1,189 @@ +An implementation of Stack data structure + +#include +#include +#include +#include +using namespace std; + +#if !defined __STACK_H +#define __STACK_H + +namespace stk{ + class Stack{ + private: + int *p; + int top,length; + + string str()const; + public: + Stack(); + Stack(const int); + Stack(const Stack&); + ~Stack(); + + void push(int); + int pop(); + int get_length()const; + bool is_empty()const; + Stack operator=(const Stack&); + friend ostream& operator<<(ostream&,Stack&); + + class StackException{ + private: + string desc; + public: + StackException(string exp){ desc="Exception : "+exp; } + string get_exp(){ return desc; } + }; + }; + + Stack::Stack(){ + top=-1; + length=0; + p=0; + } + + Stack::Stack(const int size){ + top=-1; + length=size; + try{ + p=new int[length]; + }catch(bad_alloc ba){ + cout<<"Memory can not be alllocated +"; + return; + } + } + + Stack::Stack(const Stack &o){ + top=o.top; + length=o.length; + try{ + p=new int[length]; + }catch(bad_alloc ba){ + cout<<"Memory allocation failed +"; + return; + } + for(int i=0;i +using namespace std; +class Power { + double b; + int e; + double val; +public: + Power(double base, int exp); + Power operator+(Power o) { + double base; + int exp; + base = b + o.b; + exp = e + o.e; + Power temp(base, exp); + return temp; + } + operator double() { return val; } // convert to double +}; +Power::Power(double base, int exp) +{ + b = base; + e = exp; + val = 1; + if(exp==0) + return; + for( ; exp>0; exp--) + val = val * b; +} +int main() +{ + Power x(4.0, 2); + double a; + a = x; // convert to double + cout << x + 100.2; // convert x to double and add 100.2 + cout << "\n"; + Power y(3.3, 3), z(0, 0); + z = x + y; // no conversion + a = z; // convert to double + cout << a; + return 0; +} diff --git a/c++/Others/Another example of read() and write() and illustrates the use of gcount( ).cpp b/c++/Others/Another example of read() and write() and illustrates the use of gcount( ).cpp new file mode 100644 index 0000000..a3a44a2 --- /dev/null +++ b/c++/Others/Another example of read() and write() and illustrates the use of gcount( ).cpp @@ -0,0 +1,27 @@ +Another example of read() and write() and illustrates the use of gcount( ) +#include +#include +using namespace std; +int main() +{ + double doubleNumberArray[4] = {99.75, -34.4, 1776.0, 200.1}; + int i; + ofstream out("numbers", ios::out | ios::binary); + if(!out) { + cout << "Cannot open file."; + return 1; + } + out.write((char *) &doubleNumberArray, sizeof doubleNumberArray); + out.close(); + for(i=0; i<4; i++) // clear array + doubleNumberArray[i] = 0.0; + + ifstream in("numbers", ios::in | ios::binary); + in.read((char *) &doubleNumberArray, sizeof doubleNumberArray); + + cout << in.gcount() << " bytes read\n"; // see how many bytes have been read + for(i=0; i<4; i++) // show values read from file + cout << doubleNumberArray[i] << " "; + in.close(); + return 0; +} diff --git a/c++/Others/Append two strings.cpp b/c++/Others/Append two strings.cpp new file mode 100644 index 0000000..9293f6a --- /dev/null +++ b/c++/Others/Append two strings.cpp @@ -0,0 +1,27 @@ +Append two strings +#include +using std::cout; +using std::endl; + +#include +using std::string; + +int main() +{ + string string1( "cat" ); + string string3; + + string3.assign( string1 ); + + cout << "string1: " << string1 + << "\nstring3: " << string3 << "\n\n"; + + + string3 += "pet"; + string3.append( string1, 1, string1.length() - 1 ); + + cout << "string1: " << string1 + << "\nstring3: " << string3 << "\n\n"; + + return 0; +} diff --git a/c++/Others/Appending to the End of a File.cpp b/c++/Others/Appending to the End of a File.cpp new file mode 100644 index 0000000..fce06f4 --- /dev/null +++ b/c++/Others/Appending to the End of a File.cpp @@ -0,0 +1,46 @@ +Appending to the End of a File +#include + +#include +using namespace std; +int main(){ + char fileName[80]; + char buffer[255]; + cout << "Please re-enter the file name: "; + cin >> fileName; + + ifstream fin(fileName); + if (fin){ + char ch; + while (fin.get(ch)) + cout << ch; + } + fin.close(); + + cout << "in append mode...\n"; + + ofstream fout(fileName,ios::app); + if (!fout) + { + cout << "Unable to open for appending.\n"; + return(1); + } + + cout << "\nEnter text for the file: "; + cin.ignore(1,'\n'); + cin.getline(buffer,255); + fout << buffer << "\n"; + fout.close(); + + fin.open(fileName); + if (!fin) + { + cout << "Unable to open for reading.\n"; + return(1); + } + char ch; + while (fin.get(ch)) + cout << ch; + fin.close(); + return 0; +} diff --git a/c++/Others/Appending values to Vector Containers after sorting.cpp b/c++/Others/Appending values to Vector Containers after sorting.cpp new file mode 100644 index 0000000..37d5802 --- /dev/null +++ b/c++/Others/Appending values to Vector Containers after sorting.cpp @@ -0,0 +1,33 @@ +Appending values to Vector Containers after sorting +#include +#include +#include + +using namespace std; + +template +void print(T& c){ + for( typename T::iterator i = c.begin(); i != c.end(); i++ ){ + std::cout << *i << endl; + } +} + +int main( ){ + const char* names1[] = { "A", "B", "C" }; + const char* names2[] = { "D", "E", "F", "G" }; + + vector squad1( names1,names1 + sizeof( names1 ) / sizeof( names1[0] ) ); + vector squad2( names2,names2 + sizeof( names2 ) / sizeof( names2[0] ) ); + + sort( squad1.begin(), squad1.end() ); + + print( squad1); + sort( squad2.begin(), squad2.end() ); + print( squad2); + + squad1.insert( squad1.end(), squad2.begin(), squad2.end() ); + print( squad1); + + sort( squad1.begin(), squad1.end() ); + print( squad1); +} diff --git a/c++/Others/Applying Generic Functions A Generic Bubble Sort.cpp b/c++/Others/Applying Generic Functions A Generic Bubble Sort.cpp new file mode 100644 index 0000000..3a09cb0 --- /dev/null +++ b/c++/Others/Applying Generic Functions A Generic Bubble Sort.cpp @@ -0,0 +1,43 @@ +Applying Generic Functions: A Generic Bubble Sort +#include +using namespace std; + +template void bubble( + X *items, // pointer to array to be sorted + int count) // number of items in array +{ + register int a, b; + X t; + + for(a=1; a=a; b--) + if(items[b-1] > items[b]) { + // exchange elements + t = items[b-1]; + items[b-1] = items[b]; + items[b] = t; + } +} + +int main() +{ + int iarray[7] = {7, 5, 4, 3, 9, 8, 6}; + double darray[5] = {4.3, 2.5, -0.9, 100.2, 3.0}; + + for(int i=0; i<7; i++) + cout << iarray[i] << endl; + + for(int i=0; i<5; i++) + cout << darray[i] << endl; + + bubble(iarray, 7); + bubble(darray, 5); + + for(int i=0; i<7; i++) + cout << iarray[i] << endl; + + for(int i=0; i<5; i++) + cout << darray[i] << endl; + + return 0; +} diff --git a/c++/Others/Applying Template Classes A Generic Array Class.cpp b/c++/Others/Applying Template Classes A Generic Array Class.cpp new file mode 100644 index 0000000..efdd9fa --- /dev/null +++ b/c++/Others/Applying Template Classes A Generic Array Class.cpp @@ -0,0 +1,40 @@ +Applying Template Classes: A Generic Array Class +#include +#include +using namespace std; + +const int SIZE = 10; + +template class MyClass { + T a[SIZE]; +public: + MyClass() { + register int i; + for(i=0; i T &MyClass::operator[](int i) +{ + if(i<0 || i> SIZE-1) { + cout << "\nIndex value of "; + cout << i << " is out-of-bounds.\n"; + exit(1); + } + return a[i]; +} + +int main() +{ + MyClass intob; // integer array + MyClass doubleob; // double array + + for(int i=0; i +using namespace std; + +const double pi = 3.14159; + +int main() +{ +float length, width, area; + +cout << "Enter The Length Of The Rectangle: "; +cin >> length; +cout << "Enter The Width Of Rectangle: "; +cin >> width; +area = length*width; + +cout <<"The area of the rectangle is : "<< area << endl; + +return 0; +} diff --git a/c++/Others/Area overloded.cpp b/c++/Others/Area overloded.cpp new file mode 100644 index 0000000..a29624b --- /dev/null +++ b/c++/Others/Area overloded.cpp @@ -0,0 +1,39 @@ +Area overloded + +#include +#include +#define phi 3.14 +int area(int,int); +float area(int); +void main() +{ + int a,b,c,cho; + clrscr(); + cout<<"\t What do you want to do?\n"; + cout<<"1. area of rectangle"<>cho; + switch(cho) + { + case 1: + cout<<"Enter lengt and breath (with white space):"; + cin>>a>>b; + cout<<"Area of RECTANGLE:"<>c; + cout<<"Area of CIRCLE:"< +using namespace std; + +int main() { + int ans = 27; + + ans += 10; //same as: ans = ans + 10; + cout << ans << ", "; + ans -= 7; //same as: ans = ans - 7; + cout << ans << ", "; + ans *= 2; //same as: ans = ans * 2; + cout << ans << ", "; + ans /= 3; //same as: ans = ans / 3; + cout << ans << ", "; + ans %= 3; //same as: ans = ans % 3; + cout << ans << endl; + return 0; +} diff --git a/c++/Others/Array Initialization.cpp b/c++/Others/Array Initialization.cpp new file mode 100644 index 0000000..a9f424d --- /dev/null +++ b/c++/Others/Array Initialization.cpp @@ -0,0 +1,13 @@ +Array Initialization +#include + +using namespace std; + +int main () +{ + char name[ ] = {'J', 'e', 'f', 'f', '/0' }; + + cout << name; + + return 0; +} diff --git a/c++/Others/Array based on int pointer.cpp b/c++/Others/Array based on int pointer.cpp new file mode 100644 index 0000000..168b053 --- /dev/null +++ b/c++/Others/Array based on int pointer.cpp @@ -0,0 +1,50 @@ +Array based on int pointer +#include +#include +using namespace std; +class array +{ + int *p; + int size; + public: + array(int sz) { + p = new int[sz]; + if(!p) exit(1); + size = sz; + } + ~array() {delete [] p;} + array(const array &object); + void put(int i, int j){ + if(i>=0 && i=0; lcl_i--) + cout << num.get(lcl_i); + cout << endl; + + // Create another array using the copy constructor + array x=num; + for (lcl_i=0; lcl_i<10; lcl_i++) + cout << x.get(lcl_i); +} diff --git a/c++/Others/Array class for 10 int value with overloaded functions +, -, ==.cpp b/c++/Others/Array class for 10 int value with overloaded functions +, -, ==.cpp new file mode 100644 index 0000000..e897745 --- /dev/null +++ b/c++/Others/Array class for 10 int value with overloaded functions +, -, ==.cpp @@ -0,0 +1,97 @@ +Array class for 10 int value with overloaded functions: +, -, == +#include +using namespace std; + +class array { + int nums[10]; +public: + array(); + void set(int n[10]); + void show(); + array operator+(array object2); + array operator-(array object2); + int operator==(array object2); +}; + +array::array() +{ + int i; + for(i = 0; i <10; i++) nums[ i ] = 0; +} + +void array::set(int *n) +{ + int i; + + for(i = 0; i <10; i++) nums[ i ] = n[ i ]; +} + +void array::show() +{ + int i; + + for(i = 0; i <10; i++) + cout << nums[ i ] << ' '; + + cout << endl; +} + +array array::operator+(array object2) +{ + int i; + array temp; + + for(i = 0; i <10; i++) + temp.nums[ i ] = nums[ i ] + object2.nums[ i ]; + + return temp; +} + +array array::operator-(array object2) +{ + int i; + array temp; + + for(i = 0; i <10; i++) + temp.nums[ i ] = nums[ i ] - object2.nums[ i ]; + + return temp; +} + +int array::operator==(array object2) +{ + int i; + + for(i = 0; i <10; i++) + if(nums[ i ]!=object2.nums[ i ]) return 0; + + return 1; +} + +int main() +{ + array object1, object2, object3; + + int i[10] = { 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 }; + + object1.set(i); + object2.set(i); + + object3 = object1 + object2; + object3.show(); + + object3 = object1 - object3; + object3.show(); + + if(object1==object2) + cout << "object1 equals object2\n"; + else + cout << "object1 does not equal object2\n"; + + if(object1==object3) + cout << "object1 equals object3\n"; + else + cout << "object1 does not equal object3\n"; + + return 0; +} diff --git a/c++/Others/Arrays of Objects.cpp b/c++/Others/Arrays of Objects.cpp new file mode 100644 index 0000000..41a3855 --- /dev/null +++ b/c++/Others/Arrays of Objects.cpp @@ -0,0 +1,23 @@ +Arrays of Objects +#include +using namespace std; +class MyClass { + int i; +public: + void setInt(int j) { + i=j; + } + int getInt() { + return i; + } +}; +int main() +{ + MyClass myObject[3]; + int i; + for(i=0; i<3; i++) + myObject[i].setInt(i+1); + for(i=0; i<3; i++) + cout << myObject[i].getInt() << "\n"; + return 0; +} diff --git a/c++/Others/Ask for a person's name, and generate a framed greeting.cpp b/c++/Others/Ask for a person's name, and generate a framed greeting.cpp new file mode 100644 index 0000000..ae1dc50 --- /dev/null +++ b/c++/Others/Ask for a person's name, and generate a framed greeting.cpp @@ -0,0 +1,25 @@ +Ask for a persons name, and generate a framed greeting +#include +#include + +int main() +{ + std::cout << "Please enter your first name: "; + std::string name; + std::cin >> name; + + const std::string greeting = "Hello, " + name + "!"; + const std::string spaces(greeting.size(), ' '); + const std::string second = "* " + spaces + " *"; + + const std::string first(second.size(), '*'); + + std::cout << std::endl; + std::cout << first << std::endl; + std::cout << second << std::endl; + std::cout << "* " << greeting << " *" << std::endl; + std::cout << second << std::endl; + std::cout << first << std::endl; + + return 0; +} diff --git a/c++/Others/Assign Items in int array to vector.cpp b/c++/Others/Assign Items in int array to vector.cpp new file mode 100644 index 0000000..930ae1a --- /dev/null +++ b/c++/Others/Assign Items in int array to vector.cpp @@ -0,0 +1,23 @@ +Assign Items in int array to vector +#include +#include +#include +#include // for accumulate +using namespace std; + +int main() +{ + int x[5] = {2, 3, 5, 7, 11}; + + vector vector1(&x[0], &x[5]); + + int sum = accumulate(vector1.begin(), vector1.end(), 0); + + cout << sum << endl; + return 0; +} + +/* +28 + + */ diff --git a/c++/Others/Assign elements in vector a value through an iterator.cpp b/c++/Others/Assign elements in vector a value through an iterator.cpp new file mode 100644 index 0000000..7d299ac --- /dev/null +++ b/c++/Others/Assign elements in vector a value through an iterator.cpp @@ -0,0 +1,24 @@ +Assign elements in vector a value through an iterator +#include +#include +#include +using namespace std; + +int main() +{ + vector v(10); // create a vector of length 10 + vector::iterator p; // create an iterator + int i; + + // assign elements in vector a value + p = v.begin(); + i = 0; + while(p != v.end()) { + *p = i + 'a'; + p++; + i++; + } + + + return 0; +} diff --git a/c++/Others/Assign object1 to object2.cpp b/c++/Others/Assign object1 to object2.cpp new file mode 100644 index 0000000..e281be5 --- /dev/null +++ b/c++/Others/Assign object1 to object2.cpp @@ -0,0 +1,44 @@ +Assign object1 to object2 +#include +using namespace std; + +class BaseClass { + int a; +public: + void load_a(int n) { + a = n; + } + int get_a() { + return a; + } +}; + +class DerivedClass : public BaseClass { + int b; +public: + void load_b(int n) { + b = n; + } + int get_b() { + return b; + } +}; + +int main() +{ + DerivedClass object1, object2; + + object1.load_a(5); + object1.load_b(10); + + + object2 = object1; + + cout << "Here is object1's a and b: "; + cout << object1.get_a() << ' ' << object1.get_b() << endl; + + cout << "Here is object2's a and b: "; + cout << object2.get_a() << ' ' << object2.get_b() << endl; + + return 0; +} diff --git a/c++/Others/Assign values using the member initialization syntax.cpp b/c++/Others/Assign values using the member initialization syntax.cpp new file mode 100644 index 0000000..bc88d55 --- /dev/null +++ b/c++/Others/Assign values using the member initialization syntax.cpp @@ -0,0 +1,25 @@ +Assign values using the member initialization syntax +#include + +using namespace std; + +class MyClass { + const int numA; // const member + const int numB; // const member +public: + // Initialize numA and numB using initialization syntax. + MyClass(int x, int y) : numA(x), numB(y) { } + int getNumA() { + return numA; + } + int getNumB() { + return numB; + } +}; +int main() +{ + MyClass object1(7, 9), object2(5, 2); + cout << "Values in object1 are " << object1.getNumB() << " and " << object1.getNumA() << endl; + cout << "Values in object2 are " << object2.getNumB() << " and " << object2.getNumA() << endl; + return 0; +} diff --git a/c++/Others/Assigning and Displaying Array Values.cpp b/c++/Others/Assigning and Displaying Array Values.cpp new file mode 100644 index 0000000..9057995 --- /dev/null +++ b/c++/Others/Assigning and Displaying Array Values.cpp @@ -0,0 +1,28 @@ +Assigning and Displaying Array Values +#include + +using namespace std; + +int main () +{ + int testScore[3]; + + cout << "Enter test score #1: "; + + cin >> testScore[0]; + + cout << "Enter test score #2: "; + + cin >> testScore[1]; + + cout << "Enter test score #3: "; + + cin >> testScore[2]; + + cout << "Test score #1: " << testScore[0] << endl; + + cout << "Test score #2: " << testScore[1] << endl; + + cout << "Test score #3: " << testScore[2] << endl; + return 0; +} diff --git a/c++/Others/Assigning deque objects..cpp b/c++/Others/Assigning deque objects..cpp new file mode 100644 index 0000000..3f989f3 --- /dev/null +++ b/c++/Others/Assigning deque objects..cpp @@ -0,0 +1,43 @@ +Assigning deque objects. +#include +#include +using namespace std; + +int main() +{ + deque dequeObject1(10), dequeObject2; + int i; + + for(i = 0; i <10; i++) + dequeObject1[i] = i + 'A'; + cout << "Contents of dequeObject1 are: "; + for(i = 0; i +#include +int Average(int i) +{ +static int sum = 0, count = 0; +sum = sum + i; +count++; +return sum / count; +} + +int main() +{ + +int num; +do{ + +cout<<"Enter numbers ( -1 to quit )"<>num; +/*if number is not -1 print the average*/ +if(num != -1) +cout<<"The average is "<-1); +return 0; +} diff --git a/c++/Others/Average.cpp b/c++/Others/Average.cpp new file mode 100644 index 0000000..3896680 --- /dev/null +++ b/c++/Others/Average.cpp @@ -0,0 +1,16 @@ +Average + +#include +#include +int main() +{ +int number1,number2,number3; +double average; + +cout<<"Enter three integers and I will display the average"<>number1>>number2>>number3; +average = (number1 + number2 + number3) / 3.0; +cout<<"The average is "< + + /** + * Implements an unbalanced Avl search tree. + * Note that all "matching" is based on the compares method. + */ + /** + * Construct the tree. + */ + template + AvlTree::AvlTree( const Comparable & notFound ) : + ITEM_NOT_FOUND( notFound ), root( NULL ) + { + } + + /** + * Copy constructor. + */ + template + AvlTree::AvlTree( const AvlTree & rhs ) : + ITEM_NOT_FOUND( rhs.ITEM_NOT_FOUND ), root( NULL ) + { + *this = rhs; + } + + /** + * Destructor for the tree. + */ + template + AvlTree::~AvlTree( ) + { + makeEmpty( ); + } + + /** + * Insert x into the tree; duplicates are ignored. + */ + template + void AvlTree::insert( const Comparable & x ) + { + insert( x, root ); + } + + /** + * Remove x from the tree. Nothing is done if x is not found. + */ + template + void AvlTree::remove( const Comparable & x ) + { + cout << "Sorry, remove unimplemented; " << x << + " still present" << endl; + } + + /** + * Find the smallest item in the tree. + * Return smallest item or ITEM_NOT_FOUND if empty. + */ + template + const Comparable & AvlTree::findMin( ) const + { + return elementAt( findMin( root ) ); + } + + /** + * Find the largest item in the tree. + * Return the largest item of ITEM_NOT_FOUND if empty. + */ + template + const Comparable & AvlTree::findMax( ) const + { + return elementAt( findMax( root ) ); + } + + /** + * Find item x in the tree. + * Return the matching item or ITEM_NOT_FOUND if not found. + */ + template + const Comparable & AvlTree:: + find( const Comparable & x ) const + { + return elementAt( find( x, root ) ); + } + + /** + * Make the tree logically empty. + */ + template + void AvlTree::makeEmpty( ) + { + makeEmpty( root ); + } + + /** + * Test if the tree is logically empty. + * Return true if empty, false otherwise. + */ + template + bool AvlTree::isEmpty( ) const + { + return root == NULL; + } + + /** + * Print the tree contents in sorted order. + */ + template + void AvlTree::printTree( ) const + { + if( isEmpty( ) ) + cout << "Empty tree" << endl; + else + printTree( root ); + } + + /** + * Deep copy. + */ + template + const AvlTree & + AvlTree:: + operator=( const AvlTree & rhs ) + { + if( this != &rhs ) + { + makeEmpty( ); + root = clone( rhs.root ); + } + return *this; + } + + /** + * Internal method to get element field in node t. + * Return the element field or ITEM_NOT_FOUND if t is NULL. + */ + template + const Comparable & AvlTree::elementAt( AvlNode *t ) const + { + if( t == NULL ) + return ITEM_NOT_FOUND; + else + return t->element; + } + + /** + * Internal method to insert into a subtree. + * x is the item to insert. + * t is the node that roots the tree. + */ + template + void AvlTree::insert( const Comparable & x, AvlNode * & t ) const + { + if( t == NULL ) + t = new AvlNode( x, NULL, NULL ); + else if( x < t->element ) + { + insert( x, t->left ); + if( height( t->left ) - height( t->right ) == 2 ) + if( x < t->left->element ) + rotateWithLeftChild( t ); + else + doubleWithLeftChild( t ); + } + else if( t->element < x ) + { + insert( x, t->right ); + if( height( t->right ) - height( t->left ) == 2 ) + if( t->right->element < x ) + rotateWithRightChild( t ); + else + doubleWithRightChild( t ); + } + else + ; // Duplicate; do nothing + t->height = max( height( t->left ), height( t->right ) ) + 1; + } + + /** + * Internal method to find the smallest item in a subtree t. + * Return node containing the smallest item. + */ + template + AvlNode * + AvlTree::findMin( AvlNode *t ) const + { + if( t == NULL) + return t; + + while( t->left != NULL ) + t = t->left; + return t; + } + + /** + * Internal method to find the largest item in a subtree t. + * Return node containing the largest item. + */ + template + AvlNode * + AvlTree::findMax( AvlNode *t ) const + { + if( t == NULL ) + return t; + + while( t->right != NULL ) + t = t->right; + return t; + } + + /** + * Internal method to find an item in a subtree. + * x is item to search for. + * t is the node that roots the tree. + * Return node containing the matched item. + */ + template + AvlNode * + AvlTree::find( const Comparable & x, AvlNode *t ) const + { + while( t != NULL ) + if( x < t->element ) + t = t->left; + else if( t->element < x ) + t = t->right; + else + return t; // Match + + return NULL; // No match + } + + /** + * Internal method to make subtree empty. + */ + template + void AvlTree::makeEmpty( AvlNode * & t ) const + { + if( t != NULL ) + { + makeEmpty( t->left ); + makeEmpty( t->right ); + delete t; + } + t = NULL; + } + + /** + * Internal method to clone subtree. + */ + template + AvlNode * + AvlTree::clone( AvlNode * t ) const + { + if( t == NULL ) + return NULL; + else + return new AvlNode( t->element, clone( t->left ), + clone( t->right ), t->height ); + } + + /** + * Return the height of node t or -1 if NULL. + */ + template + int AvlTree::height( AvlNode *t ) const + { + return t == NULL ? -1 : t->height; + } + + /** + * Return maximum of lhs and rhs. + */ + template + int AvlTree::max( int lhs, int rhs ) const + { + return lhs > rhs ? lhs : rhs; + } + + /** + * Rotate binary tree node with left child. + * For AVL trees, this is a single rotation for case 1. + * Update heights, then set new root. + */ + template + void AvlTree::rotateWithLeftChild( AvlNode * & k2 ) const + { + AvlNode *k1 = k2->left; + k2->left = k1->right; + k1->right = k2; + k2->height = max( height( k2->left ), height( k2->right ) ) + 1; + k1->height = max( height( k1->left ), k2->height ) + 1; + k2 = k1; + } + + /** + * Rotate binary tree node with right child. + * For AVL trees, this is a single rotation for case 4. + * Update heights, then set new root. + */ + template + void AvlTree::rotateWithRightChild( AvlNode * & k1 ) const + { + AvlNode *k2 = k1->right; + k1->right = k2->left; + k2->left = k1; + k1->height = max( height( k1->left ), height( k1->right ) ) + 1; + k2->height = max( height( k2->right ), k1->height ) + 1; + k1 = k2; + } + + /** + * Double rotate binary tree node: first left child. + * with its right child; then node k3 with new left child. + * For AVL trees, this is a double rotation for case 2. + * Update heights, then set new root. + */ + template + void AvlTree::doubleWithLeftChild( AvlNode * & k3 ) const + { + rotateWithRightChild( k3->left ); + rotateWithLeftChild( k3 ); + } + + /** + * Double rotate binary tree node: first right child. + * with its left child; then node k1 with new right child. + * For AVL trees, this is a double rotation for case 3. + * Update heights, then set new root. + */ + template + void AvlTree::doubleWithRightChild( AvlNode * & k1 ) const + { + rotateWithLeftChild( k1->right ); + rotateWithRightChild( k1 ); + } + + /** + * Internal method to print a subtree in sorted order. + * t points to the node that roots the tree. + */ + template + void AvlTree::printTree( AvlNode *t ) const + { + if( t != NULL ) + { + printTree( t->left ); + cout << t->element << endl; + printTree( t->right ); + } + } diff --git a/c++/Others/AvlTree.h - Header file for AVL tree.cpp b/c++/Others/AvlTree.h - Header file for AVL tree.cpp new file mode 100644 index 0000000..adf91fc --- /dev/null +++ b/c++/Others/AvlTree.h - Header file for AVL tree.cpp @@ -0,0 +1,86 @@ +AvlTree.h - Header file for AVL tree + + #ifndef AVL_TREE_H_ + #define AVL_TREE_H_ + + + // Node and forward declaration because g++ does + // not understand nested classes. + template + class AvlTree; + + template + class AvlNode + { + Comparable element; + AvlNode *left; + AvlNode *right; + int height; + + AvlNode( const Comparable & theElement, AvlNode *lt, AvlNode *rt, int h = 0 ) + : element( theElement ), left( lt ), right( rt ), height( h ) { } + friend class AvlTree; + }; + + #include "dsexceptions.h" + #include // For NULL + + // AvlTree class + // + // CONSTRUCTION: with ITEM_NOT_FOUND object used to signal failed finds + // + // ******************PUBLIC OPERATIONS********************* + // void insert( x ) --> Insert x + // void remove( x ) --> Remove x (unimplemented) + // Comparable find( x ) --> Return item that matches x + // Comparable findMin( ) --> Return smallest item + // Comparable findMax( ) --> Return largest item + // boolean isEmpty( ) --> Return true if empty; else false + // void makeEmpty( ) --> Remove all items + // void printTree( ) --> Print tree in sorted order + + template + class AvlTree + { + public: + explicit AvlTree( const Comparable & notFound ); + AvlTree( const AvlTree & rhs ); + ~AvlTree( ); + + const Comparable & findMin( ) const; + const Comparable & findMax( ) const; + const Comparable & find( const Comparable & x ) const; + bool isEmpty( ) const; + void printTree( ) const; + + void makeEmpty( ); + void insert( const Comparable & x ); + void remove( const Comparable & x ); + + const AvlTree & operator=( const AvlTree & rhs ); + + private: + AvlNode *root; + const Comparable ITEM_NOT_FOUND; + + const Comparable & elementAt( AvlNode *t ) const; + + void insert( const Comparable & x, AvlNode * & t ) const; + AvlNode * findMin( AvlNode *t ) const; + AvlNode * findMax( AvlNode *t ) const; + AvlNode * find( const Comparable & x, AvlNode *t ) const; + void makeEmpty( AvlNode * & t ) const; + void printTree( AvlNode *t ) const; + AvlNode * clone( AvlNode *t ) const; + + // Avl manipulations + int height( AvlNode *t ) const; + int max( int lhs, int rhs ) const; + void rotateWithLeftChild( AvlNode * & k2 ) const; + void rotateWithRightChild( AvlNode * & k1 ) const; + void doubleWithLeftChild( AvlNode * & k3 ) const; + void doubleWithRightChild( AvlNode * & k1 ) const; + }; + + #include "AvlTree.cpp" + #endif diff --git a/c++/Others/Banking Project.cpp b/c++/Others/Banking Project.cpp new file mode 100644 index 0000000..5596ecc --- /dev/null +++ b/c++/Others/Banking Project.cpp @@ -0,0 +1,518 @@ +Banking Project + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + void punit (void); + void deposit(void); + void addrecord(); + void delrecord(); + void modrecord(); + void disprecord(); + void dispall(); + void withdraw(); + float w,z; + class account + { + int accountno,cls; + char name[30],type; + float deposit,withdraw; + public: + account() + { + deposit=withdraw=0; + } + int giveaccountno() + { + return accountno; + } + void getdata(int mrno) + { + accountno=mrno+1; + cout<<"ACCOUNT NUMBER :: "; + cout<>type; + cout<<" +"; + cout<<"ENTER INITIAL AMOUNT ::Rs ";cin>>deposit; + cout<<" +"; + } + void withdrawal(int m) + { + cout<<"AMOUNT BEFORE WITHDRAWING::Rs "<>menuch; + + switch(menuch) + { + + case 1:addrecord();break; + case 2:delrecord();break; + case 3:modrecord();break; + case 4:disprecord();break; + case 5:dispall();break; + case 6:withdraw();break; + case 7:deposit();break; + } + } + while(menuch!=8); + } + void addrecord() + { + account obj_1,obj_2; + fstream fout; + fout.open("banking.txt",ios::in|ios::binary); + if(!fout) + { + cout<<"FILE OPEN ERROR ";getch();return;} + int recsize=sizeof(account); + fout.seekg(0,ios::end); + fout.seekg(-1*recsize,ios::cur); + fout.read((char*)&obj_1,recsize); + int mrno=obj_1.giveaccountno(); + fout.close(); + clrscr(); + cout<<"ADD MENU + +"; + obj_2.getdata(mrno); + fout.open("banking.txt",ios::app|ios::binary); + if(!fout) + { + cout<<"FILE OPEN ERROR ";getch();return;} + fout.write((char*)&obj_2,recsize); + cout<<" + +RECORD ADDED TO DATABASE"<<" + Press any key to +continue... "; + getch(); + fout.close(); + } + void dispall() + { + account obj_3; + fstream fout; + int recsize=sizeof(account); + int countrec=0; + clrscr(); + cout<<" +DISPLAY ALL MENU + "; + fout.open("banking.txt",ios::in); + if(!fout) + { + cout<<"FILE OPEN ERROR ";getch();return;} + while(fout.read((char*)&obj_3,recsize)) + { + obj_3.dispdata(); + countrec++; + cout<<" + PRESS ANY KEY FOR NEXT...."; + getch(); + } + clrscr(); + cout<<" + +END OF FILE.TOTALNUMBER OF RECORDS..."<>mrno; + while(fout.read((char*)&obj_4,recsize)) + { + if (obj_4.giveaccountno()==mrno) +{ + obj_4.dispdata(); + cout<<" + +Press any key....."; + flag=1;break; + } + } + if(flag==0) + { + cout<<" + +NO SUCH ACCOUNT EXIST "; + cout<<" + +Press any key......"; + } + getch(); + fout.close(); + } + void delrecord() + { + account obj_5; + fstream fout,temp; + int mrno,flag; + int recsize=sizeof(account); + clrscr(); + cout<<" + + CLOSE ACCOUNT MENU + "; + fout.open("banking.txt",ios::in); + if(!fout) + { + cout<<"FILE OPEN ERROR "; + getch(); + return; + } + temp.open("temp.txt",ios::app|ios::binary); + if(!temp) + { + cout<<"FILE OPEN ERROR "; + getch(); + return; + } + cout<<" + + ENTER THE ACCOUNT NUMBER "; + cin>>mrno; + while(fout.read((char*)&obj_5,recsize)) + { + if(obj_5.giveaccountno()==mrno) + { + obj_5.dispdata(); + char confirm; + cout<<" + +ARE YOU SURE TO DELETE IT(Y/N)..";cin>>confirm; + if(confirm=='Y'||confirm=='y') + { + fout.read((char*)&obj_5,recsize); + cout<<" + +RECORD DELETED FORM DATABASE +"; + cout<<"press any key...."; + flag=1; + if(!fout) + break; + } + flag=1; + } + temp.write((char*)&obj_5,recsize);} + fout.close(); + temp.close(); + remove("banking.txt"); + rename("temp.txt","banking.txt"); + if(flag==0) + { + cout<<" + +NO SUCH ACCOUNT EXIST"; + cout<<"Press any key....."; + } + getch(); + } + void modrecord() + { + account obj_6; + fstream fout; + int mrno,flag=0; + int recsize=sizeof(account); + clrscr(); + cout<<" +MODIFY RECORD MENU + "; + fout.open("banking.txt",ios::in|ios::out|ios::binary); + if(!fout) + { + cout<<"FILE OPEN ERROR "; + getch(); + return; + } + fout.seekg(ios::beg); + cout<<" +ENTER RECORD NUMBER "; + cin>>mrno; + while(fout.read((char*)&obj_6,recsize)) + { + if(obj_6.giveaccountno()==mrno) + { + clrscr(); + cout<<" + +MODIFY MENU + +"; + obj_6.dispdata(); + int tmprno=obj_6.giveaccountno()-1; + account obj_7; + cout<<" + + ENTER NEW DATA +"; + obj_7.getdata(tmprno); + char confirm; + cout<<" + + ARE YOU SURE(Y/N) +"; + cin>>confirm; + if(confirm=='Y'||confirm=='y') + { + fout.seekg(-1*recsize,ios::cur); + fout.write((char*)&obj_7,recsize); + cout<<" + + RECORD MODIFIED + "; + cout<<"Press any key....."; + flag=1; + } + } + if(flag==0) + { + cout<<"NO SUCH RECORD EXIST +"; + cout<<"Press any key....."; + } + } + fout.close(); + getch(); + } + void withdraw() + { + account obj_9; + fstream fout; + int mrno=0; + int recsize=sizeof(account); + clrscr(); + cout<<" + +WITHDRAWAL MENU +"; + fout.open("banking.txt",ios::in|ios::out|ios::binary); + if(!fout) + { + cout<<"FILE OPEN ERROR ";getch();return;} + fout.seekg(ios::beg); + cout<<" +ENTER ACCOUNT NUMBER "; + cin>>mrno; + while(fout.read((char*)&obj_9,recsize)) + { + if(obj_9.giveaccountno()==mrno) + { + clrscr(); + cout<<" + +ENTER THE AMOUNT TO BE WITHDRAWED::Rs "; + cin>>w; + obj_9.withdrawal(w); + fout.seekg(-1*recsize,ios::cur); + fout.write((char*)&obj_9,recsize); + } + } + fout.close(); + getch(); + } + void punit(void) + { + + int gd=5, gm, errorcode; + int col,i=0,j; + initgraph(&gd, &gm, "c:\tc\bgi"); + while(5*i<=700) + { + setbkcolor(1); + setcolor(3); + rectangle(0+5*i,0+5*i,getmaxx()-5*i,getmaxy()-5*i); + i++; + } + i=0; + setcolor(4); + settextstyle(1,0,6); + + sleep(5); + cleardevice(); + while(5*i<=700) + { + setbkcolor(1); + setcolor(3); + circle(getmaxx()/2,getmaxy()/2,i*5); + i++; + } + setcolor(4); + settextstyle(0,0,6); + outtextxy(190 ,getmaxy()/2-85,"PROJECT"); + outtextxy(300,getmaxy()/2-25,"ON"); + + outtextxy(190,getmaxy()/2+25,"BANKING"); + sleep(3); + i=0; + while(i<=130) + { + setbkcolor(1); + setcolor(3); + line(i*3,0,i*3,getmaxy()); + line(getmaxx()-i*3,0,getmaxx()-i*3,getmaxy()); + i++; + } + sleep(1); + i=getmaxy(); + while(i>0) + { + line(getmaxx()/2,getmaxy(),getmaxx(),i-=10); + delay(10); + } + i=getmaxx(); + while(i>0) + { + line(getmaxx()/2,getmaxy(),i-=10,0); + delay(10); + } + i=0; + while(i>mrno; + while(fout.read((char*)&obj_10,recsize)) + { + if(obj_10.giveaccountno()==mrno) + { + clrscr(); + cout<<" + +ENTER THE AMOUNT TO BE DEPOSITED ::Rs "; + cin>>w; + obj_10.deposital(w); + fout.seekg(-1*recsize,ios::cur); + fout.write((char*)&obj_10,recsize); + } + } + fout.close(); + getch(); + } diff --git a/c++/Others/Binary Search Tree Program.cpp b/c++/Others/Binary Search Tree Program.cpp new file mode 100644 index 0000000..b5be1d4 --- /dev/null +++ b/c++/Others/Binary Search Tree Program.cpp @@ -0,0 +1,288 @@ +Binary Search Tree Program + +#include +#include +using namespace std; + +class BinarySearchTree +{ + private: + struct tree_node + { + tree_node* left; + tree_node* right; + int data; + }; + tree_node* root; + public: + BinarySearchTree() + { + root = NULL; + } + bool isEmpty() const { return root==NULL; } + void print_inorder(); + void inorder(tree_node*); + void print_preorder(); + void preorder(tree_node*); + void print_postorder(); + void postorder(tree_node*); + void insert(int); + void remove(int); +}; + +// Smaller elements go left +// larger elements go right +void BinarySearchTree::insert(int d) +{ + tree_node* t = new tree_node; + tree_node* parent; + t->data = d; + t->left = NULL; + t->right = NULL; + parent = NULL; + // is this a new tree? + if(isE