I'm writing program that should solve matrix equasions using Cramer's rule and I have such function for this:
function solveKramers(AMatr: Matrix; BMatr: Vector): vector;
var
detA: real;
solvingMatrix: Matrix;
i, j: Integer;
begin
detA := getDet(AMatr);
if (not (detA = 0) or not (Length(AMatr) = Length(BMatr))) then begin
SetLength(Result, Length(BMatr));
for i := 0 to High(BMatr) do begin
solvingMatrix := system.copy(AMatr);
for j := 0 to High(solvingMatrix) do begin
solvingMatrix[j, i] := BMatr[j];
end;
Result[i] := getDet(solvingMatrix) / detA;
end;
Exit;
end;
end;
I created matrix = array of vector and vector = array of real
And when I try using it, solvingMatrix := system.copy(AMatr); creates reference to AMatr instead of creating copy of this matrix.
Well, I don't know how this thing works, but I solved it by copying each row separetly(the weird thing is that I did simillar in getDet function but it worked alright)
The code that I added looks like this:
for j := 0 to High(AMatr) do begin
solvingMatrix[j] := system.copy(AMatr[j]);
end;
I have tried to write a parallel threading example using AsyncCalls and the following is to parallel compute the number of prime numbers
program Project3;
{$APPTYPE CONSOLE}
uses
SysUtils,
Math,
Windows,
AsyncCalls in 'AsyncCalls.pas';
const
N = 1000000;
MAXT = 100;
var
threads : array of IAsyncCall;
ans: array of integer;
cnt: DWORD;
i, v, j, k, portion: integer;
function IsPrime(x: integer): boolean;
var
i: integer;
begin
if (x <= 1) then
begin
Result := False;
Exit;
end;
if (x = 2) then
begin
Result := True;
Exit;
end;
for i:= 2 to Ceil(Sqrt(x))do
begin
if (x mod i = 0) then
begin
Result := False;
Exit;
end;
end;
Result := True;
end;
procedure DoWork(left, right: integer; value: PInteger); cdecl;
var
i, cnt: integer;
begin
cnt := 0;
for i := left to right do
begin
if (IsPrime(i)) then
begin
Inc(cnt);
end;
end;
value^ := cnt;
end;
begin
// Paralell
cnt := GetTickCount;
SetLength(ans, MAXT);
SetLength(threads, MAXT);
portion := N div MAXT;
for i := 0 to MAXT - 2 do
begin
// left index
j := i * portion;
// right index
k := (i + 1) * portion - 1;
threads[i] := AsyncCall(#DoWork, [j, k, #ans[i]]);
end;
// last thread
j := (MAXT - 1) * portion;
threads[MAXT - 1] := AsyncCall(#DoWork, [j, N - 1, #ans[MAXT - 1]]);
// Join, doesn't seem to wait all
AsyncMultiSync(threads, True, INFINITE);
// ****Adding a delay to wait for all threads*****
// Sleep(1000);
// Sum the answer
v := 0;
for i := 0 to MAXT - 1 do
begin
Inc(v, ans[i]);
end;
Writeln('Parallel = ', GetTickCount - cnt);
Writeln('Answer = ', v);
// Serial
cnt := GetTickCount;
DoWork(0, N - 1, #v);
Writeln('Serial = ', GetTickCount - cnt);
Writeln('Answer = ', v);
Readln;
end.
Strange behaviour. The AsyncMultiSync does not seem waiting at all. If I do not add Sleep(1000), the output is
Parallel = 172
Answer = 0
Serial = 453
Answer = 78498
If I add Sleep(1000), the output is correct:
Parallel = 1188
Answer = 78498
Serial = 265
Answer = 78498
I tried using threads[i].Sync, and it produces similar results.
Did I miss something here?
The environment is D2007, Windows 10 64-bit Home
Documentation says not to exceed the maximum number of wait objects, 61.
So you will have to reduce the MaxT constant.
We are using below code to sort the lines in a file. I gave input linesas below:
6 5 1 12 10
But am getting out as below:
10 12 1 5 6
I need out as
1 5 6 10 12
Is there any way to sort the numeric lines in Inno Setup.
procedure SortList(const FileName: string);
var
I: Integer;
Files: TStringList;
begin
Files := TStringList.Create;
try
Files.LoadFromFile(FileName);
for I := Files.Count - 1 downto 0 do
begin
Files.sort;
end;
Files.SaveToFile(FileName);
finally
Files.Free;
end;
end;
Thanks in Advance.
The following Quicksort proc should do the job:
//Start is the index of the first item on the list - usually 0
//Stop is the index of the last item of the list e.g. Count - 1
procedure QuickSort(var List: TStringList; Start, Stop: Integer);
var
Left: Integer;
Right: Integer;
Mid: Integer;
Pivot: integer;
Temp: integer;
begin
Left := Start;
Right := Stop;
Mid := (Start + Stop) div 2;
Pivot := StrToInt(List[mid]);
repeat
while StrToInt(List[Left]) < Pivot do Inc(Left);
while Pivot < StrToInt(List[Right]) do Dec(Right);
if Left <= Right then
begin
Temp := StrToInt(List[Left]);
List[Left] := List[Right]; // Swops the two Strings
List[Right] := IntToStr(Temp);
Inc(Left);
Dec(Right);
end;
until Left > Right;
if Start < Right then QuickSort(List, Start, Right); // Uses
if Left < Stop then QuickSort(List, Left, Stop); // Recursion
end;
instead of calling:
Files.sort;
use the following:
QuickSort(Files, 0, Files.Count - 1);
One caveat is that the file contents always have to be valid integers because I have not added error handeling for other cases.
The Quicksort function I used is a modified version of the one found at Torry's Delpi: http://www.swissdelphicenter.ch/torry/showcode.php?id=1916
How can I calculate the square root of a number in Inno Setup?
After studying a bit the field of mathematics, could do the calculation.
//Sqtr calc
Function SqtrCalc(n : Single) : Single;
Var
I: Integer;
y: Single;
Begin
y := n;
for I := 0 to 9 do
begin
y := y / 2 + n / (2 * y);
end;
Result := y;
End;
I have to write program that counts how many different letters are in string.
For example "abc" will give 3; and "abcabc" will give 3 too, because there are only 3 different letters.
I need to use pascal, but if you can help with code in different languages it would be very nice too.
Here is my code that does not work:
var s:string;
i,j,x,count:integer;
c:char;
begin
clrscr;
Readln(s);
c:=s[1];
x:=1;
Repeat
For i:=1 to (length(s)) do
begin
If (c=s[i]) then
begin
delete(s,i,1);
writeln(s);
end;
end;
c:=s[1];
x:=x+1;
Until length(s)=1;
Writeln(x);
x is the different letter counter;
Maybe my algorythm is very bad.. any ideas? Thank you.
You've got answers on how to do it, here's why your way doesn't work.
First of all intuitively you had a good idea: Start with the first char in the string, count it (you forgot to include the counting code), remove all occurrences of the same char in the string. The idea is inefficient, but it would work. You ran into trouble with this bit of code:
For i:=1 to (length(s)) do
begin
If (c=s[i]) then
begin
delete(s,i,1);
end;
end;
The trouble is, Pascal will take the Length(s) value when it sets up the loop, but your code changes the length of the string by removing chars (using delete(s,i,1)). You'll end up looking at bad memory. The secondary issue is that i is going to advance, it doesn't matter if it matched and removed an char or not. Here's why that's bad.
Index: 12345
String: aabbb
You're going to test for i=1,2,3,4,5, looking for a. When i is 1 you'll find a match, remove the first char, and your string is going to look like this:
Index: 1234
String: abbb
You're now testing with i=2, and it's not a match, because s[2] =b. You just skiped one a, and that given a is going to stay in the array an other round and cause your algorithm to count it twice. The "fixed" algorithm would look like this:
i := 1;
while i <= Length(s) do
if (c=s[i]) then
Delete(s,i,1)
else
Inc(i);
This is different: In the given example, if I found a match at 1, the cursor doesn't advance, so it sees the second a. Also because I'm using a while loop, not a for loop, I can't get in trouble with possible implementation details of the for loop.
Your algorithm has an other problem. After the loop that removes all occurrences of the first char in string you're preparing the next loop using this code:
c:=s[1];
The trouble is, if you feed this algorithm an string of the form aa (length=2, two identical chars), it's going to enter the loop, delete or occurrences of a (those turning s into an EMPTY string) and then attempt to read the first char of the EMPTY string.
One final word: Your algorithm should handle the empty string on input, returning an count=0. Here's the fixed algorithm:
var s:string;
i,count:integer;
c:char;
begin
Readln(s);
count:=0;
while Length(s) > 0 do
begin
Inc(Count);
c := s[1];
i := 1;
while i <= Length(s) do
begin
If (c=s[i]) then
delete(s,i,1)
else
Inc(i);
end;
end;
Writeln(Count);
Readln;
end.
I am a Delphi expert, so I don't quite know how restrictive plain Pascal is. Nevertheless, this is Delphi:
// Returns the number of *distinct* "ANSI" characters in Str
function NumChrs(const Str: AnsiString): integer;
var
counts: array[0..255] of boolean;
i: Integer;
begin
ZeroMemory(#counts[0], sizeof(boolean) * length(counts));
for i := 1 to length(Str) do
counts[ord(Str[i])] := true;
result := 0;
for i := 0 to high(counts) do
if counts[i] then
inc(result);
end;
The first line can be written
for i := 0 to high(counts) do
counts[i] := false;
if you cannot use the Windows API (or the Delphi FillChar function).
If you wish to have Unicode support (as in Delphi 2009+), you can do
// Returns the number of *distinct* Unicode characters in Str
function NumChrs(const Str: string): integer;
const
AllocBy = 1024;
var
FoundCodepoints: array of integer;
i: Integer;
procedure Push(Codepoint: integer);
var
i: Integer;
begin
for i := 0 to result - 1 do
if FoundCodepoints[i] = Codepoint then
Exit;
if length(FoundCodepoints) = result then
SetLength(FoundCodepoints, length(FoundCodepoints) + AllocBy);
FoundCodepoints[result] := Codepoint;
inc(result);
end;
begin
result := 0;
for i := 1 to length(Str) do
Push(ord(Str[i]));
end;
Here's my version. I'm not saying you'll get a great mark in your assignment if you hand this in.
function NumberOfUniqueChars(s: string): Integer;
var
i, j: Integer;
c: char;
begin
for i := 1 to Length(s) do
for j := i+1 to Length(s) do
if s[i]<s[j] then
begin
c := s[i];
s[i] := s[j];
s[j] := c;
end;
Result := 0;
for i := 1 to Length(s) do begin
if (i=1) or (s[i]<>c) then
inc(Result);
c := s[i];
end;
end;
And using a Delphi construct (not efficient, but clean)
function returncount(basestring: String): Integer;
var charstrings: TStringList;
I:Integer;
begin
Result := 0;
charstrings := TStringlist.create;
try
charstrings.CaseSensitive := False;
charstrings.Duplicates := DupIgnore;
for I := 1 to length(basestring) do
charstrings.Add(basestring[i]);
Result := charstrings.Count;
finally
charstrings.free;
end;
end;
Different languages are ok?
RUBY:
s = "abcabc"
=> "abcabc"
m = s.split(//)
=> ["a", "b", "c", "a", "b", "c"]
p = m & m
=> ["a", "b", "c"]
p.count
=> 3
A Delphi version. Same idea as #The Communist Duck Python version.
function GetNumChars(Str: string): Integer;
var
s: string;
c: Char;
begin
s := '';
for c in Str do
begin
if Pos(c, s) = 0 then
begin
s := s + c;
end;
end;
Result := Length(s);
end;
Just tossing in a set-alternative...
program CountUniqueChars;
{$APPTYPE CONSOLE}
uses
SysUtils;
var
InputStr: String;
CountedChr: Set of Char;
TotalCount: Integer;
I: Integer;
begin
Write('Text: ');
ReadLn(InputStr);
CountedChr := [];
TotalCount := 0;
for I := 1 to Length(InputStr) do
begin
Write('Checking: ' + InputStr[i]);
if (InputStr[i] in CountedChr)
then WriteLn(' --')
else begin
Include(CountedChr, InputStr[i]);
Inc(TotalCount);
WriteLn(' +1')
end;
end;
WriteLn('Unique chars: ' + IntToStr(TotalCount));
ReadLn;
end.
In Python, with explanation if you want it for any other language: (Since you wanted different languages)
s = 'aahdhdfrhr' #s is the string
l = [] #l is an empty list of some kind.
for i in s: #Iterate through the string
if i not in l: #If the list does not contain the character
l.append(i) #Add the character to the list
print len(l) #Print the number of characters in the list
function CountChars(const S:AnsiString):Integer;
var C:AnsiChar; CS:Set of AnsiChar;
begin
Result := 0;
CS := [];
for C in S do
if not (C in CS) then
begin
CS := CS + [C];
Inc(Result);
end;
end;