Does Free Pascal have a way to concatenate arrays? - arrays

Pascal apparently has string concatenation, but does it have general concatenation for any type of array?

It does not but you can make your own function i coded this in 5 minutes...i am shure there is a better method but i don't have any idea right now.
type
TBArray = array of byte;
function ConcArray(arr1,arr2:TBArray):TBArray;
begin
SetLength(Result,Length(arr1) + Length(arr2));
ZeroMemory(#Result[0],Length(arr1) + Length(arr2));
CopyMemory(#Result[0],#arr1[0],Length(arr1));
CopyMemory(#Result[Length(arr1)],#arr2[0],Length(arr2));
end;

How about this? If you need to concatenate in many places, the + operator looks pretty nice IMHO.
program ConCatTest;
type
SomeRec = record
s: AnsiString;
i: Longint;
end;
SomeArr = array of SomeRec;
operator + (a, b: SomeArr) c: SomeArr;
var
i: Longint;
begin
SetLength(c, Length(a) + Length(b));
for i := 0 to High(a) do
c[i] := a[i];
for i := 0 to High(b) do
c[i + Length(a)] := b[i];
end;
var
a1, a2, a3: SomeArr;
i: Longint;
begin
SetLength(a1, 3);
SetLength(a2, 2);
a1[0].s := 'a';
a1[0].i := 0;
a1[1].s := 'a';
a1[1].i := 1;
a1[2].s := 'a';
a1[2].i := 2;
a2[0].s := 'b';
a2[0].i := 0;
a2[1].s := 'b';
a2[1].i := 1;
a3 := a1 + a2;
for i := 0 to High(a3) do
WriteLn(a3[i].s, a3[i].i);
ReadLn;
end.

Related

Invaild value of min and max using repeat until loop in pascal

I need use loop from title,but I get incorrect value of result, under my code,please for suggestion, when i use a for everything is ok
const
licz_l = 5;
var
x, suma, min, max: longint;
tab: array [1..5] of longint;
begin
randomize();
suma := 0;
x := 0;
repeat
tab[x] := random(100);
suma := suma + tab[x];
write({'wylosowane liczby : ',}tab[x],';');
min := tab[1];
max := tab[1];
if (tab[x] < min) then
min := tab[x];
// max:=tab[1];
if (max < tab[x]) then
max := tab[x];
x := x + 1;
until x = licz_l;
writeln('');
writeln('srednia : ', suma / licz_l : 4 : 4);
writeln('min : ', min, #9, 'max : ', max);
end.
New code with second loop [for], but like I write, is a posibility to use only one loop[repeat until] to getvthe same effect?
const
licz_l = 5;
var
x, suma, min, max: longint;
tab: array [0..4] of longint;
begin
randomize();
suma := 0;
x := 0;
repeat
tab[x] := random(100);
suma := suma + tab[x];
write({'wylosowane liczby : ',}tab[x],';');
x := x + 1;
until x = licz_l;
min := tab[0];
max := tab[0];
for x := 0 to licz_l-1 do
begin
if (tab[x] < min) then
min := tab[x];
if (max < tab[x]) then
max := tab[x];
end;
writeln('');
writeln('srednia : ',suma/licz_l:4:4);
writeln('min : ',min,#9,'max : ',max);
end.
There are two possible ways to correct your first code (with a single loop).
Remove the lines within the loop: min := tab[1]; and max := tab[1];
Initialize min and max before the loop, with values that are,
on one hand > maximum value that random(100) may return, and
on other hand < minimum value that random(100) may return.
or
Assign min and max unconditionally with the first value, but only the first time your loop runs (if x = 0).
const
licz_l=5;
var
x,suma,min,max: longint;
tab: array [0..4] of longint;
begin
randomize();
suma:=0;
x:=0;
repeat
tab[x]:=random(100);
suma:=suma+tab[x];
write((*'wylosowane liczby : ',*)tab[x],';');
x:=x+1;
until x=licz_l;
min:=tab[0];
max:=tab[0];
for x:=0 to licz_l-1 do
begin
if (tab[x]<min) then
min:=tab[x];
if (max<tab[x]) then
max:=tab[x];
end;
writeln('');
writeln('srednia : ',suma/licz_l:4:4);
writeln('min : ',min,#9,'max : ',max);
end.
Or
const
licz_l = 5;
var
x, suma, min, max: longint;
tab: array [0..4] of longint;
begin
randomize();
suma := 0;
x := 0;
min := 99;
max := 0;
repeat
tab[x] := random(100);
suma := suma + tab[x];
write((*'wylosowane liczby : ',*)tab[x],';');
//min := tab[0];
//max := tab[0];
if (tab[x] < min) then
min := tab[x];
if (max < tab[x]) then
max := tab[x];
x := x + 1;
until x = licz_l;
writeln('');
writeln('srednia : ', suma / licz_l : 4 : 4);
writeln('min : ', min, #9, 'max : ', max);
end.

Array multiplication in codesys

I wanted to multiply 2 matrices in codesys. I have implemented the code in the structured text language. However I am not able to generate the results correctly. Below is the logic which i am trying to implement.
Initialisation in codesys:
PROGRAM POU
VAR
a: ARRAY [1..5,1..2] OF INT:= [1,2,3,4,5,6,7,8,9,1];
b: ARRAY [1..2,1..5] OF INT := [1,2,3,4,5,6,7,8,9,1];
r1: INT:= 5; // no. of rows in a;
c1: INT:=2; // no. of columns in a;
r2: INT:= 2; //no. Of rows in b;
c2: INT:= 5; //no. of columns in b;
i: INT;
j: INT ;
k: INT;
z: INT:=2;
result: ARRAY [1..5,1..5] OF INT:= 0;
END_VAR
Program logic:
FOR i:=1 TO r1 DO
FOR j:=1 TO c2 DO
FOR k:=1 TO z DO
result[i,j]:= result[i,j]+(a[i,k]*b[k,j]);
END_FOR
END_FOR
END_FOR
What may be the reason for not getting the desired output?
The only obvious problem I see is, if you want to initialize an array with a specific value, don't do result: ARRAY [1..5, 1..5] OF INT := 0 as you would should get an error C0032: Cannot convert type 'BIT' to type 'ARRAY [1..5, 1..5] OF INT', instead do this: result: ARRAY [1..5, 1..5] OF INT := [ 25(0) ], although in codesys arrays Elements to which no initialization value is assigned explicitly are initialized internally with the default value of the basic data type, which in case of an INT is 0.
Also, to avoid errors, instad of hardcoding the boundaries I'd recomment to instad use the built in LOWER_BOUND an UPPER_BOUND functions.
Here's an example generic function for Matrix multiplication based on the code in your question:
METHOD IntMatrixProduct : BOOL
VAR_IN_OUT
A: ARRAY [*, *] OF INT;
B: ARRAY [*, *] OF INT;
C: ARRAY [*, *] OF INT;
END_VAR
VAR_INPUT
zero_C: BOOL := TRUE;
END_VAR
VAR
al1: DINT := LOWER_BOUND(A, 1);
au1: DINT := UPPER_BOUND(A, 1);
al2: DINT := LOWER_BOUND(A, 2);
au2: DINT := UPPER_BOUND(A, 2);
bl1: DINT := LOWER_BOUND(B, 1);
bu1: DINT := UPPER_BOUND(B, 1);
bl2: DINT := LOWER_BOUND(B, 2);
bu2: DINT := UPPER_BOUND(B, 2);
cl1: DINT := LOWER_BOUND(C, 1);
cu1: DINT := UPPER_BOUND(C, 1);
cl2: DINT := LOWER_BOUND(C, 2);
cu2: DINT := UPPER_BOUND(C, 2);
height: DINT := au1 - al1;
width: DINT := bu2 - bl2;
common: DINT := au2 - al2;
i, j, k: DINT;
END_VAR
IF (common <> bu1 - bl1 // Width of A != Height of B
OR_ELSE cu1 - cl1 <> height // Height of C != Height of A
OR_ELSE cu2 - cl2 <> width) THEN // Width of C != Width of B
IntMatrixProduct := FALSE; // Error!
RETURN;
END_IF
// Zero C
IF (zero_C) THEN
FOR i := 0 TO height DO
FOR j := 0 TO width DO
result[cl1 + i, cl2 + j] := 0;
END_FOR
END_FOR
END_IF
// Calcutale A*B
FOR i := 0 TO height DO
FOR j := 0 TO width DO
FOR k := 0 TO common DO
result[cl1 + i, cl2 + j] := result[cl1 + i, cl2 + j] + (a[al1 + i, al2 + k] * b[bl1 + k, bl2 + j]);
END_FOR
END_FOR
END_FOR
IntMatrixProduct := TRUE; // Success
You can also try importing the code using PLCOpen from here.
PS. Here's the result I get after running the above function:

How to derive an list of structs from any struct type - getting from interface{} to a variable length slice []interface{}

I try to implement a function taking (any) structure, returning an array of those structures. ReturnArrayOfStory show the idea with a fixed type struct type.
trying to do the same for any type with function ReturnArrayOfX and reflection fails at compile time.
package main
import (
"fmt"
"reflect"
)
type story_t struct {
LANGUAGE string
SPECIES string
}
func ReturnArrayOfStory(x story_t) []story_t {
x1 := x
var a1 []story_t
a1 = append(a1, x1)
a1 = append(a1, x1)
a1 = append(a1, x1)
return a1
}
func ReturnArrayOfX(x interface{}) []interface{} {
x1 := x
v1 := reflect.ValueOf(&x1).Elem()
a1 := []reflect.TypeOf(&x1)
// var a1 []x
a1 = append(a1, x1)
a1 = append(a1, x1)
a1 = append(a1, x1)
//return a1
return a1
}
func main() {
var as1 []story_t
s1 := story_t{"EN", "Prince of Persia"}
as1 = ReturnArrayOfStory(s1)
//as1 := ReturnArrayOfX(s1)
for i := 0; i < len(as1); i++ {
fmt.Printf("%02d %+v\n", i, as1[i])
}
as2 := ReturnArrayOfX(s1)
//as1 := ReturnArrayOfX(s1)
for i := 0; i < len(as2); i++ {
fmt.Printf("%02d %+v\n", i, as2[i])
}
}
a1 := []reflect.TypeOf(&x1)
main.go:25:8: reflect.TypeOf is not a type
This is a simplified scenario. In reality, I like to read a multitude of struct types from an external data source like a database.
How can I came to my goal with ReturnArrayOfX?
List item Is this possible? If not,why?
There are two solutions to your problem:
First: if you want to return a slice of a type using reflection:
// You cannot return []interface{}, because this function will return [](type of x), and that is not []interface{}
func ReturnArrayOfX(x interface{}) interface{} {
x1 := x
a1 :=
// this creates *[](typeOf x)
reflect.New(reflect.SliceOf(reflect.TypeOf(x)))
// Append the first element to *[](typeof x)
// after this, a1 now points to a slice, not to a slice *
a1 = reflect.Append(a1.Elem(), reflect.ValueOf(x1))
a1 = reflect.Append(a1, reflect.ValueOf(x1))
a1 = reflect.Append(a1, reflect.ValueOf(x1))
//return [](typeof x)
return a1.Interface()
}
You can use this as:
as2 := ReturnArrayOfX(s1)
arr:=as2.([]story_t)
for i := 0; i < len(arr); i++ {
fmt.Printf("%02d %+v\n", i, arr[i])
}
Second: you can return []interface{} without reflection:
func ReturnArrayOfX(x interface{}) []interface{} {
ret:=make([]interface{},0)
ret=append(ret,x)
ret=append(ret,x)
ret=append(ret,x)
}
Then you need to deal with each element of the array:
as2 := ReturnArrayOfX(s1)
for i := 0; i < len(as2); i++ {
fmt.Printf("%02d %+v\n", i, as2[i])
data:=as2[i].(story_t)
}
Here's a generic slice conversion function:
// convertSlice copies the slice in src to the slice pointed to by pdst.
// The concrete values in src must be assignable to the dst elements.
func convertSlice(pdst interface{}, src interface{}) {
dstv := reflect.ValueOf(pdst).Elem()
srcv := reflect.ValueOf(src)
dstv.Set(reflect.MakeSlice(dstv.Type(), srcv.Len(), srcv.Len()))
for i := 0; i < srcv.Len(); i++ {
dstv.Index(i).Set(reflect.ValueOf(srcv.Index(i).Interface()))
}
}
Use it like this:
// Convert []story_t to []interface{}
s0 := []story_t{{"EN", "Prince of Persia"}, {"EN", "Karateka"}}
var s1 []interface{}
convertSlice(&s1, s0)
// Convert []interface{} containing story_t to []story_t
var s2 []story_t
convertSlice(&s2, s1)
Run it on the playground.

Optimizing work with an array of records

I have the following object with an array of a record type:
type
TTimeMark = record
// many fields here
end;
TTimeMarks = array of TTimeMark;
TUserProfile = class(TObject)
TimeLine: TTimeMarks;
....
end;
In this list TUserProfile.TimeLine will be inserted items at run time. I don't know a method of inserting items other than increasing the lenghth of the array with one and then moving all the items a place down until I reach the desired possition. But in this array, the items are records with many fields, so, if I do TimeLine[I]:= TimeLine[I-1], all the data in the memory will be copied from one place to another (am I right ?), and this will take some time. Do you think should I use an array of pointers of that record, instead ? Or is there other fast method to do this ?
This is how I've done.. I used an array of pointers and I make some procedures to easy add, delete and move items:
TPointerArray = array of Pointer;
procedure PArrayInsert(var AArray: TPointerArray; Position: Integer; Count: Integer = 1);
var L, CTail: Integer;
begin
L:= Length(AArray);
if (Count = 0) or (Position > L) then Exit;
SetLength(AArray, L + Count);
CTail:= L - Position;
if CTail > 0 then
Move(AArray[Position], AArray[Position+Count], CTail * SizeOf(Pointer));
end;
procedure PArrayDelete(var AArray: TPointerArray; Position: Integer; Count: Integer = 1);
var L, CTail: Integer;
begin
L:= Length(AArray);
if (L = 0) or (Count = 0) or (Position >= L) or ((Position+Count) > L) then Exit;
CTail:= L - (Position + Count);
if CTail > 0 then
Move(AArray[Position+Count], AArray[Position], CTail * SizeOf(Pointer));
SetLength(AArray, L - Count);
end;
function PArrayMove(var AArray: TPointerArray; FromIndex, ToIndex: Integer; Count: Integer = 1): Boolean;
var L, Size, CT: Integer;
Buff: Pointer;
begin
Result:= False;
L:= High(AArray);
if (FromIndex > L) or (ToIndex > L+1) or
((ToIndex >= FromIndex) and (ToIndex <= (FromIndex+Count))) then Exit;
Size:= Count * SizeOf(Pointer);
GetMem(Buff, Size);
Move(AArray[FromIndex], Buff^, Size);
if FromIndex > ToIndex then begin
CT:= FromIndex - ToIndex;
Move(AArray[ToIndex], AArray[FromIndex+Count-CT], CT * SizeOf(Pointer));
Move(Buff^, AArray[ToIndex], Size);
end
else begin
CT:= ToIndex - FromIndex - Count;
Move(AArray[FromIndex+Count], AArray[FromIndex], CT * SizeOf(Pointer));
Move(Buff^, AArray[FromIndex+CT], Size);
end;
FreeMem(Buff);
Result:= True;
end;

How to sort array of integers with zeros at the end?

I need to sort arrays by integer field, with 1-n sorted at the beginning and zeros last:
0,0,3,1,2 -> 1,2,3,0,0
I don't know how to sort it in one go, so I tried in 2 sorts, but it doesn't produce correct results:
It does put zeros at the end, but it messes up 1-n ordered items:
0,0,3,1,2 -> (first sort) 0,0,1,2,3 -> (second sort) 2,3,1,0,0
procedure TForm2.Button1Click(Sender: TObject);
var
Arr: TArray<integer>;
begin
SetLength(Arr, 5);
Arr[0] := 0;
Arr[1] := 0;
Arr[2] := 3;
Arr[3] := 1;
Arr[4] := 2;
// First sort: Sort 1-n
TArray.Sort<integer>(Arr, TComparer<integer>.Construct(function(const Left, Right: integer): Integer
begin
if Left < Right then
Result := -1
else if Left > Right then
Result := 1
else
Result := 0;
end
));
// Second sort: Put zeros at the end
TArray.Sort<integer>(Arr, TComparer<integer>.Construct(function(const Left, Right: integer): Integer
begin
if (Left = 0) and (right>0) then
Result := 1
else
Result := 0;
end
));
end;
Is there a way to do this kind of sort in one, single Sort operation?
Try this, the point being to deal with the special 0 cases first in the if-then-else ladder, before the ordinary cases.
TArray.Sort<integer>(Arr, TComparer<integer>.Construct(function(const Left, Right: integer): Integer
begin
if (Left = 0) and (Right = 0) then
Result := 0
else if (Left = 0) then
Result := 1
else if (Right = 0) then
Result := -1
else if (Left < Right) then
Result := -1
else if (Left > Right) then
Result := 1
else
Result := 0;
end
));
A brief testing shows it works OK.
Just fix your compare function so that it will treat 0 as being larger than anything.
Untested:
TArray.Sort<integer>(Arr, TComparer<integer>.Construct(function(const Left, Right: integer): Integer
begin
if Left = Right then
Result := 0
else if ((Left <> 0) and (Left < Right)) or (Right = 0) then
Result := -1
else
Result := 1;
end
));

Resources