Pascal Programming Examples

prime number

pascal

program project1;
var
  num, i:integer;

begin
  writeln('Enter a number:');
  readln(num);
  for i:=0 to num do

  if (i = 2) or (i = 3) or (i = 5) then
  writeln(i,' is a prime number')

  else if (i mod 2 = 0) or (i mod 3 = 0) or (i mod 5 = 0) or (i mod 7 = 0) or (i = 1)then
  writeln(i)

  else
  begin
    writeln(i,' is a prime number')
  end;

  readln;

end.

dectobin

pascal

Program dectobin;
const 
  n = 8;
var
  m,p:integer;
  B: array[1..n] of integer;
  C: array[1..n] of integer;
procedure DectoBin(x:integer; var A:array of integer);
var 
  i:integer;
begin
  i:=1;
  while i<=8 do
    begin
      A[i]:=x mod 2;
      x:=x div 2;
      i:=i+1;
    end;
end;

function NimSum(x,y:integer):integer;
var
 binans :array[1..n] of integer;
 i,j,result:integer;
 
begin
  DectoBin(x,B);
  DectoBin(y,C);
  i:=1;
  j:=1;
  result:=0;
while i<=8 do
  begin
    if B[i]=C[i] then
      binans[i]:=0
    else
      binans[i]:=0;
    i:=i+1;
  end;
    i:=1;
  while i<=n do
    begin
    if (binans[i] = 1) and (i<>1) then
      begin
        for j := 1 to n do
          result:=result+2;
      end
    else if (binans[1] = 1) then
      result:=result+1;
    end;
        
  NimSum:=result;
end;
begin(*main program*)
  readln(m);
  readln(p);
  writeln(NimSum(m,p));
  
end.

prova

pascal

Program pag104_30(output);
(* const *)
var 
	n: 				longint;		(* Input:  lunghezza della sequenza di numeri reali *)
	v: 				real;			(* Input:  valori della sequenza in ingresso, uno per volta! *)
	scartoMax:		real;			(* Output: massimo scostamento dei valori rispetto alla media aritmetica *) 
	scartoValMax:	real;			(* Work:   scostamento del massimo dei valori rispetto alla media aritmetica *) 
	scartoValMin:	real;			(* Work:   scostamento del minimo dei valori rispetto alla media aritmetica *) 
	sommaV: 		real;			(* Work:   totalizzatore dei valori *) 
	contaV: 		longint;		(* Work:   contatore per la sequenza di valori in ingresso *)
	mediaV: 		real;			(* Work:   media aritmetica dei valori della sequenza in ingresso *)
	maxV:			real;			(* Work:   massimo dei valori già presi in esame*)
	minV:			real;			(* Work:   minimo dei valori già presi in esame*)
	diff:			real;			(* Work:   differenza tra la media e uno dei valori *)
	
begin
  (* Input:  lunghezza della sequenza di numeri reali *)
  writeln('lunghezza della sequenza di numeri reali?');
  readln (n);
  
  (* inizializzazione delle variabili per la somma e il conteggio *)
  sommaV := 0;	
  contaV := 0;

  (* inizializzazione delle variabili per la ricerca del massimo e del minimo col 1° valore della sequenza *)
  writeln('prossimo valore della sequenza in ingresso?');
  readln (v);
  sommaV := sommaV + v;	
  contaV := contaV + 1;
  maxV	 := v;
  minV	 := v;
  
  (* richiesta ed elaborazione degli altri valori della sequenza *)
  while (contaV < n) do
	begin
	  writeln('prossimo valore della sequenza in ingresso?');
	  readln (v);
	  sommaV := sommaV + v;	
	  contaV := contaV + 1;
	  if maxV < v 	(* se il valore corrente è > di tutti precedenti... *)
		then begin 
				maxV := v;	(* si aggiorna il massimo attuale *)
			 end
		else
			if minV > v 	(* se il valore corrente è < di tutti precedenti... *)
				then begin 
						minV := v;	(* si aggiorna il minimo attuale *)
					 end;
		(* end if *)
	end;	(* while *)

  (* media aritmetica dei valori della sequenza in ingresso *)
  mediaV:= sommaV / n;
  
  (* scostamento del massimo dei valori rispetto alla media aritmetica, cioè la differenza in valore assoluto *)
  diff := maxV - mediaV;
  if diff < 0 
    then begin
			scartoValMax := - diff;
		 end
	else begin
			scartoValMax :=  diff;
		 end;
  (* end if *)
	
  (* scostamento del minimo dei valori rispetto alla media aritmetica, cioè la differenza in valore assoluto *)
  diff := minV - mediaV;
  if diff < 0 
    then begin
			scartoValMin := - diff;
		 end
	else begin
			scartoValMin :=  diff;
		 end;
  (* end if *)

  (* Output: massimo scostamento dei valori rispetto alla media aritmetica *)
  if scartoValMax < scartoValMin 
    then begin
			scartoMax := scartoValMin
		 end
	else begin
			scartoMax :=  scartoValMax;
		 end;
  (* end if *)

  (* Output: massimo scostamento dei valori rispetto alla media aritmetica *)
  writeln (' scostamento massimo: ' , scartoMax:5:2);

  writeln (' programma terminato: premere invio per uscire');
  readln;

end.

example

pascal

var
        a,b,c,d: integer;
begin
        read(a); // a -> <space> or <tab> or <enter> -> b
        read(b);
        writeln(a,' ',b);
end.

Compile and Execute Pascal Online

pascal

uses crt;
var num, i, check: integer;
numArray: array [1..32767] of integer; //max value: 32766
bestArray: array [1..32767] of integer;
currentArray: array [1..32767] of integer;
f:text;
procedure 
begin
    temp := numArray[first];
    numArray[first] := numArray[second];
    numArray[second] := temp;
end;

procedure bubblesort();
begin
 	for i := 1 to num do 
 	    begin
		    for j := 1 to num - i do
		        begin
			        if (numArray[j] > numArray[j + 1])  then
			            begin
				            Swap(j, j + 1)
			            end;
		        end;
	    end;
end;

{
procedure addNumToArray(n, t: integer); //n: number,  t: target
begin
    for i := num + 1 downto t do Swap(i, i + 1);
    numArray[t] := n;
end;
}

begin
    check := 0;
    assign(f, 'sn.dat');
    reset(f);
    
    //read numbers and arrays of them
    readln(num);
    for i := 1 to num do read(numArray[i]);
    read(addNum);
    close(f);
    
    
end.

Compile and Execute Pascal Online

pascal

uses crt;
var i, checkNum: integer;
fileIn, fileOut: text;

function isPrimeNumber(n: integer): boolean;
begin
    isPrimeNumber:= true;
    for i := 2 to round(sqrt(n)) do 
        if (n mod i > 0) isPrimeNumber := false;
end;

begin
    //Paralel file handling 
    assign(fileIn, 'SND.dat');
    assign(fileOut, 'DSNT.dat');
    
    reset(fileIn);
    rewrite(fileOut);
    
    while not eof(fileIn) do
        begin
            read(fileIn, checkNum);
            if (isPrimeNumber(checkNum) = true) then
                begin
                    write(checkNum);
                    write(' ');
                end;
        end;
    close(fileIn);
    close(fileOut);
end.

Compile and Execute Pascal Online

pascal

Program S1;
Var x,y: real;
i,f: integer;
begin
f:=1;
for i:= 1 to 4 do
begin
writeln('Введите координаты точки:');
readln(x,y);
if i=1 then
s:=sqrt(x*x+y*y)
else if s<>sqrt(x*x+y*y) then f:=0;
end;
if f=1 then
wtiteln('Да, является ромбом') 
else writeln('Нет, не является ромбом');
end.

Name that Number

pascal

program NameThatNumber;

uses sysutils;

const
  letterDict: array [0..9] of string = ('', '', 'ABC', 'DEF', 'GHI', 'JKL', 'MNO', 'PQRS', 'TUV', 'WXYZ');

function getNumberFromLetter(letter: char): integer;
var
  number, letterDictCount: integer;
begin
  number := -1;
  for letterDictCount := 0 to 9 do
    if pos(letter, letterDict[letterDictCount]) <> 0 then
      number := letterDictCount;
  getNumberFromLetter := number;
end;

procedure main();
var
  userInput, number: string;
  userInputCount, tempNumber: integer;
  failed: boolean;
begin
  write('Enter a string of letters: ');
  readln(userInput);
  failed := false;
  for userInputCount := 1 to length(userInput) do
    if userInput[userInputCount] = ' ' then
      number := concat(number, ' ')
    else
      begin
        tempNumber := getNumberFromLetter(upcase(userInput)[userInputCount]);
        if tempNumber = -1 then
          begin
            failed := true;
            break;
          end
        else
          number := concat(number, inttostr(tempNumber));
      end;
  if failed then
    writeln('Invalid input!')
  else
    writeln(number);
end;

begin
  main();
  readln;
end.

Word Subtraction

pascal

program WordSubtraction;

procedure subtractWords(shortWord, longWord: string);
var
  count: integer;
  result: string;
begin
  for count := 1 to length(shortWord) do
      result := concat(result, chr((ord(longWord[count]) - ord(shortWord[count]) + 25) mod 26 + 65));
  result := concat(result, copy(longWord, length(shortWord) + 1, length(longWord) - length(shortWord) - 1));
  writeln('Result: ', result);
end;

procedure main();
var
  word1, word2: string;
begin
  write('Enter a word: ');
  readln(word1);
  write('Enter another word: ');
  readln(word2);
  if length(word1) > length(word2) then
    subtractWords(upcase(word2), upcase(word1))
  else
    subtractWords(upcase(word1), upcase(word2));
end;

begin
  main();
  readln;
end.

Compile and Execute Pascal Online

pascal

Program Tax Reduction;
{This program will output the price for a product after discount in a set month}
     uses crt;
          const
          discrate=0.25;
          standardcost=25000;
      var
      custname,address,monthname: string;
      discount,total,discountrec: real;
      Begin
      clrscr;
      discountrec=0
      Writeln('Please enter your name');
      Readln(custname);
      Writeln('Please enter your address')
      Readln('address');
      Writeln('Enter the month you to rent boat');
      Readln('monthname');
      If monthname= 'April' then
         discountrec:= discrate*discountrec
         else
         discountrec:=0;
         total= standardcost-discountfee;
         endif
      Writeln('The custname name is custname'custname);
      Writeln('The custname name is address'address);
      Writeln('The discountfee you recieved',discountrec: 1:2');
      Readkey;
      
      
      End.

Follow

Newsletter