I try to create a for looping for my Bubble Sort Algorithm and use break as a condition if there is no more number to be sorted anymore. But then the compiler said that BREAK not allowed. Here is my code
Procedure Sort(var data : arr; j : integer);
var
temp: integer;
begin
temp := data[j];
data[j] := data[j + 1];
data[j + 1] := temp;
end;
Procedure sortDescending(var data : arr; n : integer);
var
i, j : integer;
marker : boolean;
begin
for i := 1 to n do
marker := false;
begin
for j := 1 to n do
begin
if(data[j] < data[j + 1]) then
begin
Sort(data, j);
marker := true;
end;
end;
if(marker = false) then
begin
break;
end;
end;
end;
Here's your code.
for i := 1 to n do
marker := false;
begin
for j := 1 to n do
begin
if(data[j] < data[j + 1]) then
begin
Sort(data, j);
marker := true;
end;
end;
if(marker = false) then
begin
break;
end;
end;
Let's add some whitespace after loops and indentation to make the issue clearer.
for i := 1 to n do
marker := false;
begin
for j := 1 to n do
begin
if (data[j] < data[j + 1]) then
begin
Sort(data, j);
marker := true;
end;
end;
if (marker = false) then
begin
break;
end;
end;
Which is equivalent to:
for i := 1 to n do
marker := false;
for j := 1 to n do
begin
if (data[j] < data[j + 1]) then
begin
Sort(data, j);
marker := true;
end;
end;
if (marker = false) then
begin
break;
end;
The break is not within a loop.
You likely meant to put begin before marker := false;.
for i := 1 to n do
begin
marker := false;
for j := 1 to n do
begin
if (data[j] < data[j + 1]) then
begin
Sort(data, j);
marker := true;
end;
end;
if (marker = false) then
begin
break;
end;
end;
Related
I am studying Pascal and have a problem.
My code needs to make combinations of four numbers, from left to right but I want to prevent those combinations from repeating the same thing being the numbers in positions, but worth the same thing from right to left.
Does anyone have any idea how to do that?
program mistureba;
type
placa = array [1..4] of integer;
var
a4num : array [1..24] of placa; // a4num : array [1..24,1..4] of integer
linha : integer;
const
MAXDIG = 4;
procedure mistura(input : placa; index : integer);
// input tem a série de digitos da placa
// index indica a posição que inicia o arranjo
var
output : placa;
p, i : integer;
begin
if index = MAXDIG then
begin // mostra / insere a sequencia que está em input
//for i := 1 to MAXDIG do
//write(input);
//writeln;
a4num[linha] := input;
linha := linha + 1;
end
else
begin
output := input;
for p := index to MAXDIG do
begin
output[index] := input[p];
for i := index to p - 1 do
output[i + 1] := input;
for i := p + 1 to MAXDIG do
output := input;
mistura(output,index + 1);
end;
end;
end;
var
//a4num : placa;
p, i : integer;
begin
linha := 1;
for i := 1 to MAXDIG do
readln(a4num[linha, i]);
mistura(a4num[linha], 1);
// vou mostrar o conteúdo do meu conjunto de placas
for linha := 1 to 24 do
if [i, 1] = [i, 4] then
begin
for i := 1 to MAXDIG do
write(a4num[linha, i]);
writeln;
end
else
begin
writeln('0');
end;
if [i,2] = [i,3] then
begin
for i := 1 to MAXDIG do
write(a4num[linha, i]);
writeln;
end
else
begin
writeln('0');
end;
end.
It was still not very clear what you wanted, so here are four solutions. You can choose the one you like:
program license;
uses
classes;
type
tIntegers = array of integer;
procedure BuildPermutation(aInput : string; aUsedCharacters : tIntegers; aBuild : string; var aOutput : tStringList);
var
i, j : integer;
Used : boolean;
begin
for i := 1 to length(aInput) do
begin
Used := false;
for j := 0 to length(aBuild) -1 do
if aUsedCharacters[j] = i then
begin
Used := true;
break;
end;
if not Used then
begin
aUsedCharacters[length(aBuild)] := i;
aBuild := aBuild + aInput[i];
if length(aBuild) = length(aInput) then
aOutput.Add(aBuild)
else
BuildPermutation(aInput, aUsedCharacters, aBuild, aOutput);
SetLength(aBuild, length(aBuild) - 1);
end;
end;
end;
function AllPermutations(aInput : string) : tStringList;
var
UsedCharacters : tIntegers = nil;
i : integer;
begin
result := tStringList.Create;
SetLength(UsedCharacters, length(aInput));
for i := 0 to length(UsedCharacters) - 1 do
UsedCharacters[i] := 0;
BuildPermutation(aInput, UsedCharacters, '', result);
end;
function WithoutDuplicatesSorted(aInput : tStringList) : tStringList;
// very easy using a built in feature of tStringList
var
OnePlate : string;
begin
result := tStringList.Create;
result.Sorted := true;
result.Duplicates := dupIgnore;
for OnePlate in aInput do
result.Add(OnePlate);
end;
function WithoutDuplicatesUnsorted(aInput : tStringList) : tStringList;
var
OnePlate : string;
begin
result := tStringList.Create;
for OnePlate in aInput do
if result.IndexOf(OnePlate) = -1 then
result.Add(OnePlate);
end;
function WithoutMirrors(aInput : tStringList) : tStringList;
var
OnePlate : string;
Mirror : string;
i : integer;
begin
result := tStringList.Create;
for OnePlate in aInput do
begin
Mirror := '';
for i := 1 to length(OnePlate) do
Mirror := OnePlate[i] + Mirror;
if result.IndexOf(Mirror) = -1 then
result.Add(OnePlate);
end;
end;
function WithoutMirrorsAndDuplicates(aInput : tStringList) : tStringList;
var
OnePlate : string;
Mirror : string;
i : integer;
begin
result := tStringList.Create;
for OnePlate in aInput do
if result.IndexOf(OnePlate) = -1 then
begin
Mirror := '';
for i := 1 to length(OnePlate) do
Mirror := OnePlate[i] + Mirror;
if result.IndexOf(Mirror) = -1 then
result.Add(OnePlate);
end;
end;
procedure PrintResult(aTitle : string; aInput : tStringList);
var
OnePlate : string;
begin
writeln(aTitle);
for OnePlate in aInput do
writeln(OnePlate);
end;
procedure Solve;
var
Input : string = '';
Intermediate : tStringList = nil;
FinalResult : tStringList = nil;
begin
// get one version of the license plate
// please note that it allows non-numeric characters
// if you want, you can insert a filtering, or any other mechanism to ensure only numeric license plates
writeln('Input one version of the license plate:');
readln(Input);
// make all possible permutations and print them
Intermediate := AllPermutations(Input);
PrintResult('All permutations', Intermediate);
// option 1 - filter identical ones (and also sorting them to make it easy)
FinalResult := WithoutDuplicatesSorted(Intermediate);
PrintResult('Without duplicates sorted', FinalResult);
FinalResult.Free;
// option 2 - filter identical ones (without sorting them, i.e. more complicated)
FinalResult := WithoutDuplicatesUnsorted(Intermediate);
PrintResult('Without duplicates unsorted', FinalResult);
FinalResult.Free;
// option 3 - filter mirrors (be careful, it is not defined which one of 123 and 321 will be shown!!!)
FinalResult := WithoutMirrors(Intermediate);
PrintResult('Without mirrors', FinalResult);
FinalResult.Free;
// option 3 - filter mirrors and duplicates
FinalResult := WithoutMirrorsAndDuplicates(Intermediate);
PrintResult('Without mirrors and duplicates', FinalResult);
FinalResult.Free;
Intermediate.Free;
end;
begin
Solve;
end.
I don't know how to make sorting process visible on output.. (like you can see the step by step of each sorting phase on output).
Below is example of a similar program.
And here's my current progress:
program insertsort;
const
max = 100;
type
arr = array [1..max] of integer;
var
data : arr;
n, i, j : integer;
procedure InsertionSort(size : integer);
var
i, j, index : integer;
begin
for i := 2 to size do
begin
index := data[i];
j := i;
while ((j > 1) and (data[j-1] < index)) do
begin
data[j] := data[j-1];
j := j - 1;
end;
data[j] := index;
end;
end;
begin
write('Input Data : ');
readln(n);
for i := 1 to n do
begin
write ('Data-',i,' = '); readln(data[i]);
end;
writeln;
write ('Unsorted : ');
for i := 1 to n do
write(data[i],' ');
InsertionSort(max);
writeln;
writeln;
writeln;
write('Sorted : ');
for i := 1 to n do
write(data[i],' ');
readln;
end.
Following is a program in lazarus to perform RC4 encryption and decryption when given a string. When the compiler directive {$mode fpc} is used and the string 123 is entered it crashes with External: SIGSEGV. However there is no crash when inputting the same string in {$mode objfpc}. Another inconsistency is that in {$mode objfpc} the program raises the exception External: SIGSEGV again with the input of hellow.
//{$mode fpc}
{$mode objfpc}
program project1;
uses
sysutils, strutils;
type
myArray = array[0..255] of integer;
dynamicArray = array of integer;
dynamicArrayString = array of string;
const
key = 'qwertyui';
var
plaintext : string;
function KSA(const key: string): myArray;
var
i, j, key_length, temp: integer;
S : myArray;
begin
key_length := length(key);
j := 0;
for i := Low(S) to High(S) do
S[i] := i;
for i := Low(S) to High(S) do
begin
j := ((j + S[i] + ord(key[i mod key_length + 1])) mod 256);
temp := S[i];
S[i] := S[j];
S[j] := temp;
end;
KSA := S;
end;
function PRGA(S : myArray; n : integer) : dynamicArray;
var
i, j, K, temp, sizeOfArray : integer;
key : dynamicArray;
begin
i := 0;
j := 0;
K := 0;
temp := 0;
sizeOfArray := n - 1;
SetLength(key, sizeOfArray);
while n > 0 do
begin
n := n - 1;
i := (i + 1) mod 256;
j := (j + S[i]) mod 256;
temp := S[i];
S[i] := S[j];
S[j] := temp;
K := S[(S[i] + S[j]) mod 256];
key[i-1] := K;
end;
PRGA := key;
end;
procedure getPlaintext;
begin
readln(plaintext);
end;
function encrypt : string;
var
sizeOfArray, i : integer;
cipherString : string;
cipher, keystream: dynamicArray;
S : myArray;
begin
S := KSA(key);
keystream := PRGA(S, length(plaintext));
sizeOfArray := 0;
for i := 0 to (length(plaintext) - 1) do
begin
sizeOfArray := sizeOfArray + 1;
SetLength(cipher, sizeOfArray);
cipher[i] := (keystream[i]) xor (ord(plaintext[i + 1]));
end;
cipherString := '';
for i := 0 to High(cipher) do
cipherString := cipherString + IntToHex(cipher[I], 2);
encrypt := cipherString;
end;
function stringToHex(cipherString : string) : dynamicArrayString;
var
sizeOfArray, i: integer;
DecryptArrayString : dynamicArrayString;
begin
sizeOfArray := 0;
i := 0;
// Turn the string into an array of hex
while length(cipherString) > 0 do
begin
sizeOfArray := sizeOfArray + 1;
SetLength(DecryptArrayString, sizeOfArray);
DecryptArrayString[i] := cipherString[1] + cipherString[2];
i := i + 1;
cipherString := rightstr(cipherString, length(cipherString) - 2);
end;
stringToHex := DecryptArrayString;
end;
function hexToDecimal(DecryptArrayString : dynamicArrayString) : dynamicArray;
var
sizeOfDecryptArrayInt, i : integer;
DecryptArrayInt : dynamicArray;
begin
sizeOfDecryptArrayInt := 0;
// Hex to decimal
for i := 0 to high(DecryptArrayString) do
begin
sizeOfDecryptArrayInt := sizeOfDecryptArrayInt + 1;
SetLength(DecryptArrayInt, sizeOfDecryptArrayInt);
DecryptArrayInt[i] := Hex2Dec(DecryptArrayString[i]);
end;
hexToDecimal := DecryptArrayInt;
end;
function decrypt(DecryptArrayInt : dynamicArray) : string;
var
DecryptedString : string;
S : myArray;
keystream, Decrypted : dynamicArray;
sizeOfArray, i : integer;
begin
sizeOfArray := 0;
for i := 0 to high(DecryptArrayInt) do
begin
sizeOfArray := sizeOfArray + 1;
SetLength(Decrypted, sizeOfArray);
S := KSA(key);
keystream := PRGA(S, length(plaintext));
Decrypted[i] := (keystream[i] xor DecryptArrayInt[i]);
end;
decryptedString := '';
// Turn array to string
for i := 0 to high(Decrypted) do
decryptedString := decryptedString + chr(Decrypted[i]);
decrypt := decryptedString;
end;
procedure encryptDecrypt;
var
cipherString, DecryptedString : string;
DecryptArrayString : dynamicArrayString;
DecryptArrayInt : dynamicArray;
begin
cipherString := encrypt;
writeln(cipherString);
DecryptArrayString := stringToHex(cipherString);
DecryptArrayInt := hexToDecimal(DecryptArrayString);
DecryptedString := decrypt(DecryptArrayInt);
writeln(DecryptedString);
end;
begin
getPlaintext;
encryptDecrypt;
readln;
end.
I've not been able to find the many specific cases that makes the program crash apart from a string of any three characters will always crash in {$mode fpc} but not in {$mode objfpc}
You should debug (and watch) your code so any error can be traced more easily. Use the FP IDE, it helps a lot.
Meanwhile, watch this line:
keystream := PRGA(S, length(plaintext));
And inside the PRGA function watch these lines:
sizeOfArray := n - 1;
SetLength(key, sizeOfArray);
What's wrong here? Well, suppose "plaintext" has only 1 character. So, "Length(plaintext)"=1, right? In PRGA you do "sizeOfArray:= n-1;", so sizeOfArray = 0. When you do SetLength, "Key" will be NIL because you're indicating a zero indexes length. Later, on loop, you have:
key[i-1] := K;
the program will fail because you are accessing at index 0 and the Key variable is NIL.
Careful: On "SetLength(key, sizeOfArray);" valid indexes for key are in range [0..sizeOfArray-1], but sizeOfArray must be at least 1 to be valid (sizeOfArray >= 1).
So, you should check your PRGA function. It's up to you to find the definitive solution. Don't give up. Good luck!
I know Delphi for almost a month,
I have found a function code that change the color of the gray-scale by changing the color weights, I would like to ask, is there a faster way than this code for changing color or weighting the color?
function tform1.changecolorweighting(coloredbmp:tbitmap):tbitmap;
Var
X, Y: Integer;
P : TColor;
r,g,b: byte;
RP,GP,BP:single;
changegray:tbitmap;
changecolor:tbitmap;
begin
x:=RedWeight.value+GreenWeight.value+BlueWeight.value;
RP:=RedWeight.value/x;
GP:=Greenweight.value/x;
BP:=BlueWeight.value/x;
changegray := tbitmap.Create;
changegray.Width := coloredbmp.Width;
changegray.Height := coloredbmp.Height;
changecolor.Assign(coloredbmp);
For X := 0 to changecolor.Width do
begin
For y := 0 to changecolor.Height do
begin
P := changecolor.Canvas.Pixels[X, Y];
r := (P and $00000FF);
g := (P and $00FF00) shr 8;
b := (P and $FF0000) shr 16;
changegray.Canvas.Pixels[X, Y] := round(r * RP + g * GP + b*BP) * $010101;
end;
end;
result := changegray;
end;
if there is someone of you has a faster way of changing the color weights, please correct the code that I have found in the internet, or if you have something to offer faster than that code, please help.
The code above, it takes 1 second before the gray-scale applied with the color weighting.
thank you
This is the answer that I'm looking for, it's from Embarcadero:
https://community.embarcadero.com/blogs/entry/converting-to-grayscale-with-tbitmapscanline-property-39051
procedure ToGray(aBitmap: Graphics.TBitmap; redweightvalue,greenweightvalue,blueweightvalue:integer);
var w, h: integer; CurrRow, OffSet: integer;
x: byte; pRed, pGreen, pBlue: PByte;
function RGBToGray(R, G, B: byte): byte;
var x:integer;
RP,GP,BP:single;
begin
x:=redweightvalue+greenweightvalue+blueweightvalue;
RP:=redweightvalue/x;
GP:=greenweightvalue/x;
BP:=blueweightvalue/x;
//Result := round(0.2989*R + 0.5870*G + 0.1141*B); // coeffs from Matlab
Result := round(rp*R + gp*G + bp*B);
end;
begin
if aBitmap.PixelFormat <> pf24bit then exit;
CurrRow := Integer(aBitmap.ScanLine[0]);
OffSet := Integer(aBitmap.ScanLine[1]) - CurrRow;
for h := 0 to aBitmap.Height - 1 do
begin
for w := 0 to aBitmap.Width - 1 do
begin
pBlue := pByte(CurrRow + w*3);
pGreen := pByte(CurrRow + w*3 + 1);
pRed := pByte(CurrRow + w*3 + 2);
x := RGBToGray(pRed^, pGreen^, pBlue^);
pBlue^ := x;
pGreen^ := x;
pRed^ := x;
end;
inc(CurrRow, OffSet);
end;
end;
I am making a program of prime number in FreePascal.
How to output number divides with I1,I2 separated with commas instead of 2 lines?
var
P:Integer;
I:Integer;
J:Integer;
A:Integer;
begin
writeln('Prime number program');
writeln;
writeln('Insert number');
readln(P);
for I:=2 to P-1 do
begin
J:=P Mod I;
if (J=0) then
begin
writeln(P,' divides with ',I);
a:=a+1
end;
end;
if a=0 then
begin
writeln(P,' is prime number')
end;
end.
I know it's not a good way to teach you something, but here it is:
program Project1;
uses
SysUtils;
var
S: string;
I: Integer;
Count: Integer;
Input: Integer;
begin
Writeln('Prime number program');
Writeln;
Writeln('Insert a number:');
Readln(Input);
for I := 2 to Input-1 do
begin
if (Input mod I = 0) then
begin
Count := Count + 1;
if (S <> '') then
S := S + ', ';
S := S + IntToStr(I);
end;
end;
if (Count = 0) then
Writeln(Input, ' is a prime number.')
else
Writeln(Input, ' is not a prime number. It divides with ', S, '.');
Readln;
end.
prime := true;
for i := 2 to p - 1 do
if(p mod i = 0) then prime := false;
if prime then writeln("prime");
all program:
program Prime;
var
prime: boolean;
I, P: Integer;
begin
Writeln('Prime number program');
Writeln;
Writeln('Insert a number:');
Readln(P);
prime := true;
for i := 2 to p - 1 do
if(p mod i = 0) then prime := false;
if prime then writeln("prime");
else writeln("not prime");
Readln;
end.
No need to check all numbers below N, odd numbers below sqrt(N) are enough.
program PrimeTest;
var N, I, Divisor: LongInt;
Prime: Boolean;
begin
writeln('Prime number program');
writeln;
write('Insert number: ');
readln(N);
Divisor := 1;
Prime := True;
if N < 5 then
begin
Prime := (N = 2) or (N = 3);
if N = 4 then Divisor := 2;
end else if Odd(N) then
begin
I := 3;
while I*I <= N do
begin
if N mod I = 0 then
begin
Prime := False;
Divisor := I;
break;
end;
I := I + 2;
end;
end else begin
Prime := False;
Divisor := 2;
end;
if Prime then writeln(N, ' is a prime number')
else writeln(N, ' is divisible by ', Divisor);
end.
Of course, if you want to find all prime factors, or all divisors (not the same thing), you will need something a bit more complcated, but it's still better to do as few divisions as possible.
Here is a solution giving the whole prime factorization.
program PrimeTest;
var N, I, J, Index, M: LongInt;
Factor, Power: array[1 .. 32] of LongInt;
begin
writeln('Prime number program');
writeln;
write('Insert number: ');
readln(N);
M := N;
Index := 0;
if N mod 2 = 0 then
begin
J := 0;
while N mod 2 = 0 do
begin
Inc(J);
N := N div 2;
end;
Inc(Index);
Factor[Index] := 2;
Power[Index] := J;
end;
I := 3;
while I*I <= N do
begin
if N mod I = 0 then
begin
J := 0;
while N mod I = 0 do
begin
Inc(J);
N := N div I;
end;
Inc(Index);
Factor[Index] := I;
Power[Index] := J;
end;
I := I + 2;
end;
if (N > 1) or (Index = 0) then
begin
Inc(Index);
Factor[Index] := N;
Power[Index] := 1;
end;
if M = 1 then writeln('1 is not prime')
else if (Index > 1) or ((Index > 0) and (Power[1] > 1)) then
begin
if Power[1] = 1 then write(M, ' = ', Factor[1])
else write(M, ' = ', Factor[1], '^', Power[1]);
for I := 2 to Index do
begin
if Power[I] = 1 then write(' * ', Factor[I])
else write(' * ', Factor[I], '^', Power[I]);
end;
writeln;
end else writeln(M, ' is prime');
end.