Tutorialspoint

Morse Coding

program MorseCoding;

function checkUserInput(userString: string): boolean;
var
  valid: boolean;
  count: integer;
begin
  valid := true;
  for count := 1 to length(userString) do
    if ((ord(userString[count]) < 65) or (ord(userString[count]) > 90)) and (userString[count] <> ' ') then
      valid := false;
  checkUserInput := valid;
end;

function getCharacterCode(character: char): string;
const
  translationArray: array [0..25] of string = ('.-', '-...', '-.-.', '-..', '.', '..-.', '--.', '....', '..', '.---', '-.-', '.-..', '--', '-.', '---', '.--.', '--.-', '.-.', '...', '-', '..-', '...-', '.--', '-..-', '-.--', '--..');
begin
  if character = ' ' then
    getCharacterCode := '| '
  else
    begin
      getCharacterCode := translationArray[ord(character) - 65] + ' ';
    end;
end;

procedure main();
var
  userString, codedString: string;
  count: integer;
begin
  write('Enter a string: ');
  readln(userString);
  if checkUserInput(upcase(userString)) then
    begin
      for count := 1 to length(userString) do
        begin
          codedString := concat(codedString, getCharacterCode(upcase(userString[count])));
        end;
      writeln(codedString);
    end
  else
    writeln('Invalid input!');
end;

begin
  main();
  readln;
end.

6666

program task2;
var n: integer;
begin
writeln('Введите номер месяца:');
readln(n);
if (n=12) or (n=1) or (n=2) then writeln('Зима.')
else
if (n=3) or (n=4) or (n=5) then writeln('Весна.')
else
if (n=6) or (n=7) or (n=8) then writeln('Лето.')
else
if (n=9) or (n=10) or (n=11) then writeln('Осень.')
else
if (n<=0) or (n>12) then writeln('Ошибка! В году только 12 месяцев.')
end.

задание3

Program #3;
uses crt;
Var mesyac:integer;
begin
writeln('введите номер месяца');
readln(mesyac);
if mesyac = 12 or 1 or 2 then
writeln ('зима');
if mesyac = 3 or 4 or 5 then
writeln ('весна');
if mesyac = 6 or 7 or 8 then
writeln ('лето');
if mesyac = 9 or 10 or 11 then
writeln ('осень')
else writeln('ошибка, не правильно введен месяц');
end.

задание 2

Program prog;
uses crt;
var a,b,v:integer;

begin
clrscr;

write('Возраст Антона = ');
readln(a);
write('Возраст Бориса = ');
readln(b);
write('Возраст Виктора = ');
readln(v);
writeln;

if (a>b)and(a>v) then writeln('Антон старше всех.');
if (b>a)and(b>v) then writeln('Борис старше всех.');
if (v>a)and(v>b) then writeln('Виктор старше всех.');

if (a=b)and(a>v) then writeln('Антон и Борис старше Виктора');
if (a=v)and(a>b) then writeln('Антон и Виктор старше Бориса');
if (b=v)and(b>a) then writeln('Борис и Виктор старше Антона');

if (a=b)and(a=v) then writeln('Антон,Борис и Виктор одного возраста');
end.

ictsba_main

// focus on the input stage, by implementing all methods for validating and verifying the data. (1st ammend)
//seed division algorithm 31/3//[completed]9/4
//school seperation algo 31/3//originalporgram lost10/4//[mod needed]10/4//notes:position not constant
//one school distribution tendency 31/3//  "
//improve validation,verification//[in process]10/4//booleanvalidation added10/4
program ictsba_mki;
    type
        stud=record
        school: string;
        studname: string;
        //seed: boolean;)(cant read in bollean?)
        seed: string;//require check if input is t/f/true/false
    end;
var
    i,j,k,l,m,n,o,p,q,r,schoolcount:integer;
    studfile:text;//var for file
    studfileinput:char;//var for receiving file name
    temp:stud;
    studinfo:array[1..1000]of stud;
    schooltemp:array[1..1000]of character;
    procedure reading;
        begin
            write('input file name');//change to read in data later
            readln(studfileinput);
            assign(studfile,studfileinput);//input desired file name
            reset(studfile);
            while not eof(studfile) do
            begin
                i:=i+1;
                readln(studfile,studinfo[i].school);
                readln(studfile,studinfo[i].studname);
                readln(studfile,studinfo[i].seed);
            end;
            close (studfile);
            readln();
        end;
    procedure sorting;//change to merge sort later//later10/4//is this useful?
        begin
            for j:= 1 to i-1 do
            begin
                for k:= 1 to n-1 do 
                begin
                    if studinfo[j]>studinfo[j+1]then 
                    begin  
                        temp:=studinfo[k];
                        studinfo[k]:=studinfo[k+1];
                        studinfo[k+1]:=studinfo[k];
                    end;
                end;
            end;
            readln()
        end;
    procedure namevalidationblank;//showing position and name of blank names of students//
        begin
            for s:= 1 to i do
                begin  
                    if studinfo[s].studname = ''
                        begin
                            writeln(s);
                        end;
                end;
            if s>0 then
            begin
                writeln('invalid input(blank data in the following lines),please amend file for the following data:');
            end;
            readln()   
        end;
    procedure namevalidationrepeat;//showing position and name of duplicating names of students//possibility of repeating names?//tell them add num after name to avoid confusion in all process
        begin
            for l:= 2 to i do
                begin  
                    if studinfo[l-1].studname <> studinfo[l].studname then
                        begin
                            studinfo[l-1].studname:= ' ';
                            else;
                                begin
                                    m:=m+1;
                                    writeln(studinfo[l].studname,'input'l);
                                end;
                        end;
                end;
            if m>0 then
            begin
                writeln('invalid input(repeating names,in case of non-accidental case,please amend by addind numbers to avoid confusion),please amend file for the following data:');
            end;
            readln()   
        end;
    procedure schoolnamevalidation;//o:counter,p:invalid counter//concept error
        begin
            for o:= 2 to i do
                begin  
                    if studinfo[o-1].school <> studinfo[o].school then
                        begin
                            studinfo[o-1].school:= ' '
                        end;
                    else;
                        begin
                            p:=p+1;
                            writeln(studinfo[o].school,'input'o);
                        end;
                end;
            if p>0 then
            begin
                writeln('invalid input,please amend file for the following data:');
            end;
            readln()   
        end;
    procedure schoollimit;//assume n as total data
        begin
            for a = 1 to n do
                begin
                    for b = a+1 to n-1 do
                        begin
                            if studinfo[a].school = studinfo[b-1],school then
                            begin
                                write(studinfo[a].school);
                            end;
                        end;
                    writeln('the schools shown are having more than 2 competitors, please do neccesary adjustment')
                end;
    procedure seedvalidation;//p:counter,q:invalid counter
        begin
            for p:= 1 to i do
                begin 
                    if studinfo[p].seed = true then
                        begin
                            q:=q+1;
                        end;
                end;
        if q>4 then
            begin
                writeln('invalid input,please amend file for the following data:');
            end;
            readln()
        end;
    procedure booleanvalidation;//assume that the text file followed a format of standard for boolean input eg.true/false as of in seed validation//do before seed validation//r:counter
        begin
            for r:= 1 to i do 
            begin
                if studinfo[r].seed <>  true or false
                begin
                    writeln ('invalid input for student'r'please follow the following format: true, false');
                end;
            end;
        end;
begin
    i,j,k,l,m,n,o:=0;
    repeat
    reading;
    sorting;
    namevalidation;
    schoolnamevalidation;
    booleanvalidation;
    seedvalidation;
    until m=0 and p=0 and q<4 or q>=0;
    readln()
end.
//other mock programmes will be added after succesful unit test(lower is the program for seed division[mock])
program sd_algo_mki;//testing only,not official program,assume graph as paper mockup, n as total data
var
    seed,a,b,c:integer;
        begin
            for a := 1 to n do
            begin
                if studinfo.seed[a] = true then//count seed
                begin
                    seed := seed +1;
                end;
            end;
            while b <> seed and c <>n do
            begin
                c:=c+1;
                if studinfo[c].seed = true and b:=0 then//first seed
                    begin
                        mockgraph[n] := studinfo[c];
                        b:=b+1;
                    end;
                if studinfo[c].seed = true and b:=1 then//second seed
                    begin
                        mockgraph[1] := studinfo[c];
                        b:=b+1;
                    end;  
                if studinfo[c].seed = true and b:=2 then//third seed
                    begin
                        mockgraph[n/2] := studinfo[c];
                        b:=b+1;
                        temp:=c;
                    end;  
                
                 if studinfo[c].seed = true and b:=3 then//forth seed
                    begin
                        mockgraph[(2+n)/2] := studinfo[temp];
                        mockgraph[3n/2] := studinfo[c];
                        b:=b+1;
                    end; 
            end;
            readln()
        end.
        //mockgraph as mock array for storing data of tree//setted location proved to be effective on dryrun, assume position of the program as correct

Arithmetic test

program ArithmeticTest;

uses sysutils;

var
  i, score, _random: integer;
  FirstN, SecondN, answer, input: integer;

procedure Generate();
begin
    randomize;
    FirstN := Random(10);
    SecondN := Random(10);
end;

begin
  score:=0;
  writeln('For division questions answer how many times the number divides fully');
  for i:=0 to 9 do
  begin
    _random:=Random(4);
    if _random = 0 then
       begin
         Generate();
         Answer := FirstN+SecondN;
         writeln(inttostr(FirstN)+' + '+inttostr(SecondN));
       end
    else if _random = 1 then
       begin
        Generate();
         Answer := FirstN-SecondN;
         writeln(inttostr(FirstN)+' - '+inttostr(SecondN));
       end
    else if _random = 2 then
       begin
         Generate();
         Answer := FirstN*SecondN;
         writeln(inttostr(FirstN)+' x '+inttostr(SecondN));
       end
    else if _random = 3 then
       begin
         Generate();
         Answer := FirstN mod SecondN;
         writeln(inttostr(FirstN)+' / '+inttostr(SecondN));
       end;
    readln(Input);
    if (Input = Answer) then
       begin
       writeln('Correct');
       score+=1;
       end
    else
        writeln('Incorrect');
  end;
  writeln('Score: '+inttostr(score)+'/10');
  readln;
end.
                                                          

vsfs

Program vkcoin;
const: c=3600, a=33
var:a,b,c: integer;
begin
  writeln('Введите число');
  read (b);
  b:=a*c;
  writeln('В час=',b)
end.

Compile and Execute Pascal Online

Program vkcoin;
const: c=3600, a=33
var:a,b,c: integer;
begin
  writeln('Введите число');
  read (b);
  b:=a*c;
  writeln('В час=',b)
end.

Compile and Execute Pascal Online

Program P1;
begin
writeln('hello');
end.

Pangrams

program Pangram;

var
  i: integer;
  BoolArray: array [1..26] of boolean;
  IsPangram: boolean;
  Input:string;

begin
  writeln('Enter a string');
  readln(Input);
  Input:=lowercase(Input);

  for i:=1 to 26 do
    BoolArray[i]:=false;

  for i:=0 to length(Input) do
    if (((ord(Input[i])-96)<27) and ((ord(Input[i])-96)>0)) then
      BoolArray[ord(Input[i])-96] := true;

  IsPangram:=true;
  for i:=1 to 26 do
    if BoolArray[i]=false then
      IsPangram:=false;

  if IsPangram then
    writeln('Pangram')
  else
    writeln('Not Pangram');

  readln;
end.                      

1 2 3 4 5 6 7 ... 86 Next
Advertisements
Loading...

We use cookies to provide and improve our services. By using our site, you consent to our Cookies Policy.