View Full Version : Project Sigma!
Daniel
03022012, 12:19 PM
Projσct Σ
by Daniel
Notice for those who can't/refuse to read: Do NOT post your solutions, PM Me!
Introduction:
Welcome to Project Sigma! This is along the lines of Project Euler (for those that know of it), but is more oriented to this community of beginner scripters utilising Simba. Don’t be fooled though, as it is designed for every one of all levels! Problems to solve will be released on a weekly basis, with user submissions submitted to me (via the PM system here at SRL/Villavu ONLY). Points are awarded to those whose code executes the fastest on my machine.
Rules:
1. Problems are to be solved using Simba.
i. This includes, but is not limited to, compiled code in the form of external libraries.
ii. Code must be able to compile using the Lape interpreter.
iii. Code cannot be submitted precompiled.
2. Problems must be solved independently.
i. This excludes using the assistance of the Internet to find the pseudo code of a required algorithm.
ii. This applies to You, the coder, directly or indirectly asking for assistance for a given problem (i.e. using IRC, another medium such as StackOverflow or programmingoriented forums).
3. The main, “problemsolving” part of the solution must be your code/creation.
i. e.g., if the problem asks to find the sum of an integer array, you cannot utilise Simba’s included method SumIntegerArray.
4. Solutions must be submitted before or on the due date. Late submissions will forfeit your chance to increment your position on the leader board.
i. If a person submits two or more solutions, then the earliest submitted will only be used – so test and ensure before submitting!
ii. If a person submits two or more solutions to multiple levels, then their highest level submission will only be used for grading.
iii. SRL Members (both past and present) and higher ranked (also, both past and present) are not allowed to compete in the beginner level.
5. Solutions are submitted under a public domain license.
i. This includes the later publication of your solutions for others to learn off of.
ii. By submitting, you agree to allow unrestricted use of your code in other peoples projects, utilising Simba/SRL or otherwise.
6. Use common sense, keep this competition/learning experience clean and fun :)
Marking Criteria (How you are judged):
If your submission does not meet the required outcomes of the problem, then it will not be graded as per below.
What determines your resultant score is [mainly] based solely on the speed of your submission. Textual outputs (i.e. WriteLn) will not be counted when determining the speed of your submission if they are independent of your problem. A maximum of five (if not otherwise stated) tests will be conducted and run through multiple iterations to determine your speed. The maximum speed attained, will be the speed that is used to determine your score.
If two or more solutions achieve the same result, then all of these solutions will be stress tested for a maximum of 10× iterations with a much wider variety of parameters used. The winner of this stage will be awarded an additional 5, 3, or 1 point (with respect to their level – Advanced, Intermediate or Beginner).
If two or more solutions once again receive the same speed result, then their solutions performance will be tested using more accurate timing methods using the same test parameters as the previous paragraph. The winner of this stage will be awarded with an additional 7, 5, or 3 points (also, with respect to their level).
If once again, two or more solutions receive the same result, then the amount of raw code that is theirs used to complete the problem will be used to grade the result, with efficiency (CPU usage and memory usage) taken into account. The winner of this stage will be awarded 12, 9 or 6 points with respect to their level. If the solutions examined tie once again, then all entrants will be awarded with 10, 7 or 4 extra points with respect to their level.
Leaderboard:
Overall:
mixster  20
Dgby714  10
Methrend  10
beginner5  5
slushpuppy  5
Sex  2
Zyt3x  2
putonajonny  2
masterBB  2

Advanced:
mixster  20
beginner5  5








Intermediate:
Dgby714  10
Methrend  10
Sex  2
Zyt3x  2
putonajonny  2
masterBB  2




Beginner:
slushpuppy  5









Problem #3:
Beginner:
Binary What?
You are to construct a program which converts X (of type unsigned Integer [that means no negative values will be given]) into its binary equivalent. You are not allowed to use any inbuilt Simba methods to assist with this conversion. Make sure X is a defined constant that is placed at the beginning of your script and is more suitably named given its purpose.
NOTE: You are not required to pad your output.
Example:
X = 2
Output = 10
Example:
X = 10
Output = 1010
Example:
X = 15
Output = 1111
Points Awarded: 5 Intermediate:
Fun With Factorials #2!
Write a program that finds the amount of trailing zeroes of the factorial X. You are not allowed to use the inbuilt Simba method Factorial to calculate the factorial of a number (you must make your own!). Make sure X is a defined constant that is placed at the beginning of your script and is more suitably named given their purpose.
Example #1:
X = 5
Factorial = 120
Output = 1
Example #2:
X = 3
Factorial = 6
Output = 0
Points Awarded: 10
Advanced:
BigSuperLarge Numbers!
You are to write a library for Simba in the form of an include file which enables support for integers larger than length 20 ( Length ). You must support the four basic mathematical operations (addition, subtraction, multiplication and division), aswell as [I]y√ (i.e. Sqrt[y](x) ) in separate functions with the result type as your big number type, aswell as including a method to convert a big number to and from a standard integer with overflow checking, and to and from a string.
NOTE #1: You are not expected to have support for floating point numbers in your solution.
Example:
BigNumAdd(100, 100) = 200 // Addition
BigNumSub(50, 100) = 50 // Subtraction
BigNumMultiply(2, 50) = 100 // Multiplication
BigNumDiv(50, 2) = 25 // Division
BigNumSqrt(25, 2) [==Sqrt(25)] = 5 // Square root
BigNumSqrt(1000, 3) [== yroot(1000, 3)] = 10 // Cube root
BigNumToStr(24) = ‘24’
BigNumToInt(1) = 1
Points Awarded: 20
Submission Date:
To be submitted by:
Sunday 25th of March, 2012, 12:00 PM (AEDT / GMT + 11)
OR, Sunday 25th of March, 2012, 01:00 AM (GMT)
OR, Saturday 24th of March, 2012, 5:00 PM (PST / GMT  8)
Good Luck, and don't rush!
Daniel
03022012, 12:20 PM
Past Questions:
Week #2:
Please see this post (http://villavu.com/forum/showthread.php?p=962669#post962669) for user submissions.
Beginner:
Fun With Factorials!
Write a program that programmatically finds the Highest Common Factor of the factorial X and the factorial of Y, otherwise return 0 (zero). Make sure X and Y are defined constants that are placed at the beginning of your script and are more suitably named given their purpose.
Example:
X = 5, Y = 6
HCF = 120
There were no valid submissions for this entry. Quite disappointing :(
Intermediate:
ReadInts:
Write a program that clones the IntToStr function within Simba. In your solution, you may NOT use Simba’s *ToStr in any way (including Format or any other variant), shape or form, and you must check the validity of the argument given. You must also support integers that are both positive AND negative, and output accordingly.
Example #1:
Input = 1000
Output = "1000"
Example #2:
Input = 500
Output = "500"
Example #3:
Input = "abc"
Output = ""
There were three entries for this. Dgby714's submission, however, was the fastest out of all three. [Nathan]'s I couldn't really accept because it didn't work for most of the values tested (48% success rate).
Advanced:
PolyCom
Write a program that takes a standard array of points of nlength, which constructs a 2dimensional polygon shape (arr1 connects to arr2 , arr2 > arr3 , … , arrn1 > arrn , arrn > arr1)note1. Create separate appropriatelynamed methods which:
returns TRUE if the argument point (of type TPoint) is inside the polygon,
returns TRUE if the polygon is complex,
returns the amount of closed regions of the polygon,
returns the maximum angle in DEGREES (minimum precision of 3 floating point numbers) of ALL intersections IF the polygon is complex. You are to sort this array so that it is ordered in a topdown, leftright order.note2
NOTE #1: You must connect the provided points to each other via straight lines, these will not be given.
NOTE #2: An intersection is defined if TWO lines intersect and continue past that point.
Example #1:
array = [(0, 0), (5,5), (5, 0)]
Result_PointInside(2, 1) = True
Result_IsComplex = False
Result_RegionCount = 1
Result_Angles = [ [] ]
Example #2:
array = [(0, 0), (5, 0), (0, 5), (5, 5)]
Result_PointInside(6, 1) = False
Result_IsComplex = True
Result_RegionCount = 2
Result_Angles = [ x.xxx ]
No submissions for this which was quite saddening :( Dgby714, however, allowed me to show to the public his unfinished submission (which only works for simple polygon's). Quite impressive :)
No points were awarded.
Week #1:
Please see this post (http://villavu.com/forum/showthread.php?p=954273#post954273) for user submissions.
Beginner:
FindANumber! 
Write a program that finds the position of the first occurrence of X in a sorted array of whole numbers. Make sure that X is a defined constant at the beginning of your script and is more appropriately named for its purpose.
Example:
X = 3, Array = [1, 2, 3, 4, 5]
Result = 3
Since there was only one entry (disappointing!), there was only one winner: slushpuppy.
Intermediate:
Brute Force Madness 
Write a program that returns all possible combinations of the characters in string, in order of the sequence of characters with no overlaps. Make sure that string is a constant and is placed at the beginning of the script.
Example:
string = ‘abc’
Result = ‘aaa’, ‘aab’, ‘aac’ … ‘ccc’
[I]There were several entries, which was quite impressive :) Methrend's was the fastest out of the quad entrants.
Advanced:
Sort n’ Search 
You will be given an nlength array of random integer values with a signed 24bit range. You are required to sort this array first following a pattern/sequence (i.e. ascendingdescending, descendingascending, oddeven, evenodd, etc  no "intelligent design sort"), not using the internal sorting methods already included Simba, or implementing a Quick Sort or Bubble Sort algorithm. You are then required to return the positions of all occurrences of X and Y in that sorted array. You should return an integer array of these positions in two separate appropriately named arrays. Make sure that X, Y and array are defined constants at the beginning of your script, and are more appropriately named given their purpose.
Example:
X = 6, Y = 9, Array = [4, 9, 4, 3, 9]
ResultX = [], ResultY = [4, 5]
Only two entries: mixster and beginner5 :( Unfortunately beginner5 used BubbleSort, but I still allowed it anyway because of the limited number of entrants. mixster had won this week in terms of speed.
Daniel
03022012, 12:22 PM
Reserved in case the first two threads fill up.
Dgby714
03022012, 12:22 PM
lol... Apparently I can't read...
masterBB
03022012, 12:26 PM
You might want to specify that submitting is done through PM? At least that is what I believe is the correct way.
ii. Code must be able to compile using the Lape interpreter.
Why Lape not PS?
Daniel
03022012, 01:21 PM
Why Lape not PS?
Wider platform support, faster compilation time, pointer support, etc :)
The code is exactly the same as what you would write in PascalScript, so it shouldn't be a problem at all :)
Plus, it will also get the community to start adopting Lape in favour of PascalScript, aswell as a great testing ground for Niels :)
nielsie95
03022012, 01:22 PM
Sounds great! :)
Plus, it will also get the community to start adopting Lape in favour of PascalScript, aswell as a great testing ground for Niels
But with Lape in Simba ...hmm I can't even compile this:
program new;
{$i SRL/SRL.simba}
begin
end.
So it's really hard to adopt Lape:P
Kyle Undefined
03022012, 02:09 PM
Awesome, been lazy about using Lape, this will get me to finally play with it! :)
Dgby714
03022012, 02:24 PM
But with Lape in Simba ...hmm I can't even compile this:
program new;
{$i SRL/SRL.simba}
begin
end.
So it's really hard to adopt Lape:P
You should prob check out the Lape branch for SRL >..>
Anyways yes Lape is missing a few things to make it "Public".
Tho people should still start to learn the extra things it has.
BenLand100
03032012, 06:17 AM
Submitted my solution to the advanced problem. +1 internets to anyone that beats me.
mixster
03032012, 04:07 PM
I've sent in my script and it shall be great wins!
BenLand100
03032012, 05:53 PM
I still think my solution is valid under the rewrite, but that is up to herr judge.
Daniel
03042012, 07:20 AM
I only have submissions for the advanced thus far. Nobody wanting to do the other levels? :(
sm321
03042012, 01:48 PM
I only have submissions for the advanced thus far. Nobody wanting to do the other levels? :(
I might have a go at the beginner, what program do you want the answer to appear in?
@Daniel
I am trying to do BruteForceMadness at the moment.
masterBB
03042012, 09:40 PM
@Daniel
I am trying to do BruteForceMadness at the moment.
Then from now on we are rivals. I submitted my solution.
Then from now on we are rivals. I submitted my solution.
I am still struggling with my script, I will try to finish it tomorrow. :frusty:
Daniel
03052012, 04:55 AM
I might have a go at the beginner, what program do you want the answer to appear in?
You are to program in Simba, and display your findings in the debug/output box below. :)
sm321
03052012, 08:30 AM
Beginner:
FindANumber! 
Write a program that finds the position of the first occurrence of X in a sorted array of whole numbers. Make sure that X is a defined constant at the beginning of your script and is more appropriately named for its purpose.
Example:
X = 3, Array = [1, 2, 3, 4, 5]
Result = 3
I don't get what you mean by "position of the first occurrence of X". It's written clearly but I'm new to this :)
masterBB
03052012, 08:48 AM
A few extra examples:
X = 6, Array = [1, 3, 6, 8]
Result = 3
X = 2, Array = [2, 2, 7, 11, 14]
Result = 1
X = 11, Array = [2, 7, 7, 11, 11]
Result = 4
sm321
03052012, 08:52 AM
A few extra examples:
X = 6, Array = [1, 3, 6, 8]
Result = 3
X = 2, Array = [2, 2, 7, 11, 14]
Result = 1
X = 11, Array = [2, 7, 7, 11, 11]
Result = 4
Sorry, still no idea. Once you have X, then what. I know things like:
x+4=6
x=2
Kyle Undefined
03052012, 09:12 AM
Are you basing the index number from 1 or 0? Technically, your examples should read 1 less, since arrays start with 0.
Sytherix
03052012, 09:16 AM
Sorry, still no idea. Once you have X, then what. I know things like:
x+4=6
x=2
A few extra examples:
X = 6, Array = [1, 3, 6, 8]
Result = 3
X = 2, Array = [2, 2, 7, 11, 14]
Result = 1
X = 11, Array = [2, 7, 7, 11, 11]
Result = 4
What he is trying to tell you is that you must find the first occurrence of "x". A.K.A "At which point you first notice x".
In example 1, x=6. Therefore you look at the numbers and note which point the value for x first occurs.
[1 (first number), 3 (second number), 6(third number), 8(fifth number)]
As you can see, the result is 3. You are not trying to solve what x itself equals, rather what position x has in a list of numbers.
P.S I may be wrong, but that's how I see it.
sm321
03052012, 09:18 AM
What he is trying to tell you is that you must find the first occurrence of "x". A.K.A "At which point you first notice x".
In example 1, x=6. Therefore you look at the numbers and notice that x is the third number in, henceforth the result is 3.
[1 (first number), 3 (second number), 6(third number), 8(fifth number).
As you can see, the result is 3. You are not trying to solve what x itself equals, rather what position x has in a list of numbers.
Oh I get it now, thankyou :) Say x is 4, and the sequence is 2, 4 ,6, the answer is 2? But you need to make a script that does that. Can anyone point me to any tutorials?
Daniel
03052012, 09:23 AM
Are you basing the index number from 1 or 0? Technically, your examples should read 1 less, since arrays start with 0.
The conventional position ;) Not the index.
masterBB
03052012, 06:26 PM
Oh I get it now, thankyou :) Say x is 4, and the sequence is 2, 4 ,6, the answer is 2? But you need to make a script that does that. Can anyone point me to any tutorials?
There is not really a tutorial for that. This (http://villavu.com/forum/showthread.php?t=18777)is a basic tutorial on arrays. If you ignore the color finding part this might help you. I will not give more help as this is an competition. Good luck!
putonajonny
03052012, 11:17 PM
I have sent you my submission for the intermediate competition, not really sure what a signed integer is, actually I might look it up and then have a go...
edit:
ok got that sorted, not quite sure what is ment by the sorting, do we choose one method of sorting (eg ascending or descending) or do we make out script able to do all of them?
edit2:
I now have a script working for the advanced one but I am not sure if I have understood it correctly since I seemed to find it easier than the intermediate one :/
Daniel
03062012, 02:03 AM
I have sent you my submission for the intermediate competition, not really sure what a signed integer is, actually I might look it up and then have a go...
edit:
ok got that sorted, not quite sure what is ment by the sorting, do we choose one method of sorting (eg ascending or descending) or do we make out script able to do all of them?
edit2:
I now have a script working for the advanced one but I am not sure if I have understood it correctly since I seemed to find it easier than the intermediate one :/
Hi put!
You noticed that I was rather ambiguous on the type of sorting that I want :) This means that you can use any sorting method (not including intelligent design sort), as long as it is sorted in one way, shape or form. :) You only need to sort the array once, with one method.
Methrend
03062012, 10:47 AM
Submitted my intermediate :D
I'm sure I made it more complex than it should be, butmeh.
putonajonny
03062012, 05:41 PM
Hi put!
You noticed that I was rather ambiguous on the type of sorting that I want :) This means that you can use any sorting method (not including intelligent design sort), as long as it is sorted in one way, shape or form. :) You only need to sort the array once, with one method.
Thanks very much for that, I have:
//Input
3;
5;
[0, 3, 5, 9, 3, 9, 5, 1];
//Output
[0, 1, 3, 3, 5, 5, 9, 9]
[3, 4]
[5, 6]
? Thats what I have working atm, based on the fact I already submitted my intermediate is it worth posting that too? / Have I got the right end of the stick? :P
Submitted my intermediate :D
I'm sure I made it more complex than it should be, butmeh.
it's on! ;)
Could you confirm you received my submission? Maybe a list of people on the OP would be good?
Make sure that X, Y and array are defined constants at the beginning of your script
Can you make arrays constants? if so how? :P (I know you could make each integer in it a constant, but then the array length would be limited)
masterBB
03062012, 05:56 PM
const
constantArray = [3,5,6,8,3];
putonajonny
03062012, 11:42 PM
const
constantArray = [3,5,6,8,3];
[Error] (5:19): Syntax error at line 4
Daniel
03082012, 03:04 AM
Week #1:
Beginner:
FindANumber! 
Write a program that finds the position of the first occurrence of X in a sorted array of whole numbers. Make sure that X is a defined constant at the beginning of your script and is more appropriately named for its purpose.
Example:
X = 3, Array = [1, 2, 3, 4, 5]
Result = 3
Since there was only one entry (disappointing!), there was only one winner: slushpuppy.
Their code:
program FindANumber;
const
X = 6;
arr = [1, 2, 3, 4, 5,6];
size = sizeof(arr);
var
//arr : array of LongInt;
I : LongInt;
begin
for I := 0 to size do
begin
if arr = X then
begin
writeln(inttostr(I + 1));
break;
end
if arr[size  I  1] = X then
begin
writeln(inttostr(I + 1));
break;
end
end;
end.
Intermediate:
Brute Force Madness 
Write a program that returns all possible combinations of the characters in [I]string, in order of the sequence of characters with no overlaps. Make sure that string is a constant and is placed at the beginning of the script.
Example:
string = ‘abc’
Result = ‘aaa’, ‘aab’, ‘aac’ … ‘ccc’
There were several entries, which was quite impressive :) Methrend's was the fastest out of the quad entrants.
Methrend's code:
program MethrendBruteForceMadness;
var
i : Integer;
finalString : String;
charArray, finalArray : TStringArray;
const
theString = 'abc'; //String of letters to use
function getCharArray(whatString : String) : TStringArray;
var
tempArray : TStringArray;
tempString : String;
count, i : Integer;
begin
tempString := whatString;
repeat
Delete(tempString, 1, 1);
inc(count);
until(tempString = '');
Setlength(tempArray, count);
for i := 0 to (count  1) do
tempArray[i] := Copy(whatString, i+1, 1);
Result := tempArray;
end;
function getAllCombos(letters : TStringArray) : TStringArray;
var
tempArray : TStringArray;
tempString : String;
indiceArray : TIntegerArray;
i, j, totalCombos : Integer;
begin
totalCombos := 1
for i := 0 to high(letters) do
totalCombos := totalCombos * (high(letters) + 1);
setLength(tempArray, totalCombos);
setLength(indiceArray, (high(letters) + 1));
for i := 0 to high(tempArray) do
begin
tempString := '';
for j := 0 to high(indiceArray) do
begin
tempString := tempString + letters[indiceArray[j]];
end;
tempArray[i] := tempString;
inc(indiceArray[high(indiceArray)]);
for j := high(indiceArray) downto 0 do
begin
if (indiceArray[j] > high(indiceArray)) then
begin
indiceArray[j] := 0;
if (j > 0) then
inc(indiceArray[j1]);
end;
end;
end;
Result := tempArray;
end;
begin
charArray := getCharArray(theString);
finalArray := getAllCombos(charArray);
for i := 0 to high(finalArray) do
begin
finalString := finalString + finalArray[i];
if (i < high(finalArray)) then
finalString := finalString + ', ';
end;
writeln(finalString);
end.
Zyt3x's code:
const
Chars = 'abc';
function GetCombinations(CharacterSet : String): TStringArray;
var
Numeral : TIntegerArray;
C, I, J, H, L : Integer;
begin
H := Length(CharacterSet)1;
L := H+1;
C := Round(Pow(L, H)) * L;
SetLength(Numeral, H+1);
SetLength(Result, C);
for I := 0 to C1 do
begin
for J := 0 to H do
Result[I] := Result[I] + CharacterSet[Numeral[J]+1];
for J := H downto 1 do
if (J = H) and (Numeral[J] = H) then
begin
Inc(Numeral[J1]);
Numeral[J] := 1;
end else
if Numeral[J] > H then
begin
Inc(Numeral[J1]);
Numeral[J] := 0;
end;
Inc(Numeral[H]);
end;
end;
putonajonny's code:
program ProjectSigma; //entry by putonajonny
Const
S = 'abc';
function StringToArray(S : String) : array of String;
Var
i : integer;
begin
SetArrayLength(Result, Length(S));
for i := 1 to length(S) do
Result[i  1] := Copy(S, i, 1);
end;
function InStringArray(A : array of String; S : string) : Boolean;
Var
i : integer;
begin
for i := 0 to high(A) do
if(A[i] = S) then
begin
Result := True;
exit;
end;
end;
function RemoveDuplicates(A : array of string) : array of string;
Var
i : integer;
begin
for i := 0 to high(A) do
if(not InStringArray(Result, A[i]))then
begin
SetArrayLength(Result, GetArrayLength(Result) + 1);
Result[high(Result)] := A[i];
end;
end;
function GreaterThanN(Var AI : array of integer; Const n : integer) : Boolean;
Var
i : integer;
Rep : Boolean;
begin
Repeat
Rep := False;
for i := 0 to high(AI) do
if(AI[i] >= n)then
if(i = 0) then
begin
Result := True;
exit;
end
else
begin
AI[i] := 0;
inc(AI[i  1]);
Rep := True;
end;
Until(not Rep);
end;
function Permutations(A : array of string) : array of string;
Var
integers : array of integer;
i, j, n, k : integer;
begin
n := High(A);
SetArrayLength(integers, n + 1);
Repeat
SetArrayLength(Result, GetArrayLength(Result) + 1)
for i := 0 to n do
begin
k := integers[i];
Result[j] := Result[j] + A[k];
end;
inc(j);
inc(integers[high(integers)]);
Until(GreaterThanN(integers, n + 1));
end;
Var
a, b, c : array of string;
begin
a := StringToArray(S);
b := RemoveDuplicates(a);
c := Permutations(b);
WriteLn(GetTimeRunning);
WriteLn(c);
end.
masterBB's code:
program O1;
const
TheString = 'Master';
function CharInArray(c:Char;a:Array of Char):Boolean;
var
i,h:Integer;
begin
Result := True;
h := High(a);
for i := 0 to h do
if c = a[i] then
Exit;
Result := False;
end;
function solveProblem1:Array of String;
var
i,j,k,l,highResults,amountOfChars,le,hi:Integer;
powers:Array of Integer;
chars:Array of Char;
begin
le := Length(TheString);
hi := le1;
//Checks how many different chars are in the string, so aab only has 8 results
for i := 1 to le do
if not(CharInArray(TheString[i],chars)) then
begin
setLength(chars,Length(chars)+1);
chars[High(chars)] := TheString[i];
end;
amountOfChars := Length(chars);
//Setting powers to reduce function calls
setLength(powers,le);
powers[0] := 1;
powers[1] := le;
for i := 1 to hi do
powers[i] := powers[i1] * amountOfChars;
//Sets the length of the results
setLength(Result,powers[hi]* amountOfChars);
highResults := High(Result);
for i := 0 to highResults do
begin
l := i;
for j := hi downto 0 do
begin
k := floor(l * 1.00 / powers[j]);
Result[i] := Result[i] + chars[k];
l := l  (k*powers[j]);
end;
end;
writeln(Result);
end;
begin
solveProblem1;
end.
Advanced:Sort n’ Search 
You will be given an nlength array of random integer values with a signed 24bit range. You are required to sort this array first following a pattern/sequence (i.e. ascendingdescending, descendingascending, oddeven, evenodd, etc  no "intelligent design sort"), not using the internal sorting methods already included Simba, or implementing a Quick Sort or Bubble Sort algorithm. You are then required to return the positions of all occurrences of X and Y in that sorted array. You should return an integer array of these positions in two separate appropriately named arrays. Make sure that X, Y and array are defined constants at the beginning of your script, and are more appropriately named given their purpose.
Example:
X = 6, Y = 9, Array = [4, 9, 4, 3, 9]
ResultX = [], ResultY = [4, 5]
[I]Only two entries: mixster and beginner5 :( Unfortunately beginner5 used BubbleSort, but I still allowed it anyway because of the limited number of entrants. mixster had won this week in terms of speed.
mixster's code:
const
X = 42;
Y = 69;
procedure Merger(var output: array of Integer; input: array of Integer;
ar1, ar2, arEnd: Integer);
var
ar1I, ar2I: ^Integer;
ar1P, ar2P, arEP: ^Integer;
oI, oE: ^Integer;
begin
ar1I := @input[ar1];
ar2I := @input[ar2];
ar1P := ar1I;
ar2P := ar2I;
arEP := @input[arEnd];
oI := @output[ar1];
oE := @output[arEnd  1];
while (oI <= oE) do
begin
if ((ar1I < ar2P) and ((ar2I >= arEP) or (ar1I^ <= ar2I^))) then
begin
oI^ := ar1I^;
Inc(ar1I);
end
else
begin
oI^ := ar2I^;
Inc(ar2I);
end;
Inc(oI);
end;
end;
procedure SwapArray(var output: array of Integer; var input: array of Integer);
var
t: array of Integer;
begin
t := output;
output := input;
input := t;
end;
procedure MergeSort(var data: array of Integer);
var
output: array of Integer;
size: Integer;
nextSize: Integer;
len, hi: Integer;
st: Integer;
begin
size := 1;
nextSize := 2;
len := Length(data);
SetLength(output, len);
hi := len  1;
while (size < hi) do
begin
st := 0;
while (st < hi) do
begin
Merger(output, data, st, Min(st + size, len), Min(st + nextSize, len));
st := st + nextSize;
end;
size := nextSize;
nextSize := nextSize shl 1;
SwapArray(data, output);
end;
end;
procedure DualBinarySearch(var xfound, yfound: array of Integer; data: array of Integer; x, y: Integer);
var
hi, mi, lo: Integer;
xl, xh, yl, yh: Integer;
begin
SetLength(xfound, 0);
SetLength(yfound, 0);
hi := High(data);
lo := 0;
xl := lo;
xh := hi;
while (xl <= xh) do
begin
mi := (xl + xh) div 2;
if (data[mi] < x) then
begin
xl := mi + 1;
mi := (xh + xl) div 2;
end
else if (data[mi] <> x) then
begin
xh := mi  1;
mi := (xh + xl) div 2;
end
else
begin
xl := mi  1;
xh := mi + 1;
while ((xl >= 0) and (data[xl] = x)) do
xl := xl  1;
xl := xl + 1;
while ((xh <= hi) and (data[xh] = x)) do
xh := xh + 1;
SetLength(xfound, xh  xl);
xh := (xh  xl)  1;
for mi := 0 to xh do
xfound[mi] := xl + mi;
break;
end;
end;
if (x = y) then
begin
yfound = xfound;
exit;
end;
yl := lo;
yh := hi;
while (yl <= yh) do
begin
mi := (yl + yh) div 2;
if (data[mi] < y) then
begin
yl := mi + 1;
mi := (yh + yl) div 2;
end
else if (data[mi] <> y) then
begin
yh := mi  1;
mi := (yh + yl) div 2;
end
else
begin
yl := mi  1;
yh := mi + 1;
while ((yl >= 0) and (data[yl] = y)) do
yl := yl  1;
yl := yl + 1;
while ((yh <= hi) and (data[yh] = y)) do
yh := yh + 1;
SetLength(yfound, yh  yl);
yh := (yh  yl)  1;
for mi := 0 to yh do
yfound[mi] := yl + mi;
exit;
end;
end;
end;
var
test, xF, yF: array of Integer;
i, ts, tf, n: Integer;
begin
n := 16;
SetLength(test, n);
for i := 0 to n  1 do
test[i] := Random(n div 2);
if (n < 50) then
Writeln(test);
ts := GetTickCount();
MergeSort(test);
ts := GetTickCount()  ts;
tf := GetTickCount();
DualBinarySearch(xF, yF, test, X, Y);
tf := GetTickCount()  tf;
Writeln('Sort: ' + IntToStr(ts) + 'ms');
if (n < 50) then
Writeln(test);
end.
beginner5's code:
program new;
const
X = 3;
Y = 9;
procedure PrintResults ( arr : TintegerArray;X,Y :integer);
var
ResX ,ResY ,tempArr: TintegerArray;
a,l ,temp ,Xcount ,Ycount: integer;
bool :boolean;
begin
l := high(arr);
repeat
bool := FALSE;
for a:=0 to l do
begin
if (a<>l)and( arr[a] > arr[a+1]) then
begin
temp := arr[a];
arr[a] := arr[a+1];
arr[a+1] := temp;
bool := TRUE;
end;
end;
until not bool;
writeln('sorted array:')
writeln(arr);
for a:= 0 to l do
begin
if (arr[a] = x) then
begin
Inc(xCount);
end;
if (arr[a] = Y) then
begin
Inc(YCount);
end;
end;
setlength(Resx,XCount);
setlength(ResY,YCount);
XCount :=0;
Ycount :=0;
for a:= 0 to l do
begin
if (arr[a] = x) then
begin
Resx[XCount] := a+1;
Inc(xCount);
end;
if (arr[a] = Y) then
begin
ResY[YCount] := a+1;
Inc(YCount);
end;
end;
writeln('Results X array:');
writeln(Resx);
writeln('Results y array:');
writeln(ResY);
end;
var
Arr : TintegerArray;
begin
Arr := [4,9,4,3,9];
Printresults ( Arr ,X,Y);
end.
Methrend
03082012, 08:20 AM
Woo :D
Not as complicated as I thought I'd made it then. Well done to those who won the other difficulties ^_^
nielsie95
03082012, 08:28 AM
Not a lot entries, unfortunately. What happened to Wizzup and Benland?
Here are a few comments:
slushpuppy:
SizeOf(Arr) gives you the size of the array in bytes.
Length(Arr) gives you the number of indices and High(Arr) gives you the last index. It would have been better to use High in this case :)
Methrend:
You can use ToStr(finalArray) or even WriteLn(finalArray)
You can get the length of a string using Length(str)
You can get a character of a string using string  the first letter is index 1
Zyt3x:
Nice and clean :)
putonajonny:
You can get a character from a string using str[index]  the first letter is index 1
Gradually increasing the array length can take up a lot of time. You can preset the length of the array if you know it.
masterBB:
A string is basically an array of char, why not use the string type so you can use functions like Pos instead of CharInArray?
Nice and clean.. and comments! =D
mixster:
Nice use of pointers in merger
You can use the builtin swap function for SwapArray
The nextSize loop could you also write as [I]for st to hi  1 with nextSize do
beginner5:
You can use the builtin swap function
A few overall comments:
Lape should not be faster if you cache the length of an array before a forloop. It does this for you
With Brute Force Madness, why not also preset the length of the strings? Appending strings takes time
Use comments and meaningful variable names in your code!
nielsie95
03082012, 08:31 AM
And here was my solution for Brute Force Madness:
{
Write a program that returns all possible combinations of the characters in string,
in order of the sequence of characters with no overlaps. Make sure that string is
a constant and is placed at the beginning of the script.
Example:
string = ‘abc’
Result = ‘aaa’, ‘aab’, ‘aac’ … ‘ccc’
Author: nielsie95
}
program BruteForceMadness;
const
MadString = 'abc';
var
MadLen := Length(MadString);
//Overload Pow() to create an integer variant
function Pow(Base, Exp: UInt32): Integer; overload;
begin
Result := 1;
for Exp downto 1 do
Result := Result * Base;
end;
//Returns an array filled with combinations
function MadFill: array of string;
//Recursive function that fills a certain part of the array
//It does this by spreading all the characters over len positions.
//For example: ab is spread like aabb if Len is 4.
//After that, it recursively fills the next string index;
//this will give aa,ab,ba,bb.
procedure FillArr(var a: array of string; StartInd, Len, CharInd: Integer);
var
i, Ind, PartLen: Integer;
begin
if (CharInd > MadLen) then
Exit;
Ind := StartInd;
PartLen := Len div MadLen;
for i := 0 to Len  1 do
begin
a[Ind, CharInd] := MadString[i div PartLen + 1];
Inc(Ind);
end;
Ind := StartInd;
Inc(CharInd);
for i := 0 to MadLen  1 do
begin
FillArr(a, StartInd, PartLen, CharInd);
Inc(StartInd, PartLen);
end;
end;
var
Len: Integer;
begin
Len := Pow(MadLen, MadLen); //Calculate array length
SetLength(Result, Len, MadLen); //Allocate array
FillArr(Result, 0, Len, 1); //Fill the array
end;
begin
WriteLn(MadFill());
end.
I didn't want to submit, because it was the intermediate problem. Perhaps next time I should? ;)
You can have a procedure/function inside of another, Nielsie?
nielsie95
03082012, 08:40 AM
Yes, although the above script will most likely currently only work in the nightly build of Simba. You cannot access parent variables, though.
Daniel
03082012, 08:50 AM
And here was my solution for Brute Force Madness:
Aha :P
Here was mine :P Nice and simple:
const
Characters = 'abc';
var
Results: array of String;
procedure GenString(S: String);
var
I: Integer;
begin
if(Length(S) = Length(Characters)) then
Writeln(S)
else
for I := 1 to Length(Characters) do
GenString(S + Characters[I]);
end;
begin
GenString('');
end.
:)
Also, thank you for going through every submission offering suggestions and showing room for improvement :)
masterBB
03082012, 09:12 AM
I believe the reason my code was slower is that methernds code gives multiple of the same combos when a char is in the string more than once. So 'aab' gives multiple 'aaa' result while mine would only return one 'aaa'. Oh well, congratulations meth! You won't win that easy next time ;)
Daniel
03082012, 09:23 AM
I believe the reason my code was slower is that methernds code gives multiple of the same combos when a char is in the string more than once. So 'aab' gives multiple 'aaa' result while mine would only return one 'aaa'. Oh well, congratulations meth! You won't win that easy next time ;)
It ran fine for me? :S
[Nathan]
03082012, 10:01 AM
Should be studying for biology final, instead I'm tying to solve your challenge... Good news is I'm learning right?? I really like these challenges, they definitely bend the mind! Back to intracellular vesical transport for me...
masterBB
03082012, 10:22 AM
I do not want to attack methrends submission as it wasn't part of the problem. But I did more work then he did, solving a second unasked question:
input:
S := 'aabc';
output meth:
aaaa, aaaa, aaab, aaac, aaaa, aaaa, aaab, aaac, aaba, aaba, aabb, aabc, aaca, aaca, aacb, aacc, aaaa, aaaa, aaab, aaac, aaaa, aaaa, aaab, aaac, aaba, aaba, aabb, aabc, aaca, aaca, aacb, aacc, abaa, abaa, abab, abac, abaa, abaa, abab, abac, abba, abba, abbb, abbc, abca, abca, abcb, abcc, acaa, acaa, acab, acac, acaa, acaa, acab, acac, acba, acba, acbb, acbc, acca, acca, accb, accc, aaaa, aaaa, aaab, aaac, aaaa, aaaa, aaab, aaac, aaba, aaba, aabb, aabc, aaca, aaca, aacb, aacc, aaaa, aaaa, aaab, aaac, aaaa, aaaa, aaab, aaac, aaba, aaba, aabb, aabc, aaca, aaca, aacb, aacc, abaa, abaa, abab, abac, abaa, abaa, abab, abac, abba, abba, abbb, abbc, abca, abca, abcb, abcc, acaa, acaa, acab, acac, acaa, acaa, acab, acac, acba, acba, acbb, acbc, acca, acca, accb, accc, baaa, baaa, baab, baac, baaa, baaa, baab, baac, baba, baba, babb, babc, baca, baca, bacb, bacc, baaa, baaa, baab, baac, baaa, baaa, baab, baac, baba, baba, babb, babc, baca, baca, bacb, bacc, bbaa, bbaa, bbab, bbac, bbaa, bbaa, bbab, bbac, bbba, bbba, bbbb, bbbc, bbca, bbca, bbcb, bbcc, bcaa, bcaa, bcab, bcac, bcaa, bcaa, bcab, bcac, bcba, bcba, bcbb, bcbc, bcca, bcca, bccb, bccc, caaa, caaa, caab, caac, caaa, caaa, caab, caac, caba, caba, cabb, cabc, caca, caca, cacb, cacc, caaa, caaa, caab, caac, caaa, caaa, caab, caac, caba, caba, cabb, cabc, caca, caca, cacb, cacc, cbaa, cbaa, cbab, cbac, cbaa, cbaa, cbab, cbac, cbba, cbba, cbbb, cbbc, cbca, cbca, cbcb, cbcc, ccaa, ccaa, ccab, ccac, ccaa, ccaa, ccab, ccac, ccba, ccba, ccbb, ccbc, ccca, ccca, cccb, cccc
output masterBB:
'aaaa', 'aaab', 'aaac', 'aaba', 'aabb', 'aabc', 'aaca', 'aacb', 'aacc', 'abaa', 'abab', 'abac', 'abba', 'abbb', 'abbc', 'abca', 'abcb', 'abcc', 'acaa', 'acab', 'acac', 'acba', 'acbb', 'acbc', 'acca', 'accb', 'accc', 'baaa', 'baab', 'baac', 'baba', 'babb', 'babc', 'baca', 'bacb', 'bacc', 'bbaa', 'bbab', 'bbac', 'bbba', 'bbbb', 'bbbc', 'bbca', 'bbcb', 'bbcc', 'bcaa', 'bcab', 'bcac', 'bcba', 'bcbb', 'bcbc', 'bcca', 'bccb', 'bccc', 'caaa', 'caab', 'caac', 'caba', 'cabb', 'cabc', 'caca', 'cacb', 'cacc', 'cbaa', 'cbab', 'cbac', 'cbba', 'cbbb', 'cbbc', 'cbca', 'cbcb', 'cbcc', 'ccaa', 'ccab', 'ccac', 'ccba', 'ccbb', 'ccbc', 'ccca', 'cccb', 'cccc'
or
input:
S := 'aac';
output methrend:
'aaa', 'aaa', 'aac', 'aaa', 'aaa', 'aac', 'aca', 'aca', 'acc', 'aaa', 'aaa', 'aac', 'aaa', 'aaa', 'aac', 'aca', 'aca', 'acc', 'caa', 'caa', 'cac', 'caa', 'caa', 'cac', 'cca', 'cca', 'ccc'
output masterBB:
'aaa', 'aac', 'aca', 'acc', 'caa', 'cac', 'cca', 'ccc'
edit:
putonajonny also solved this problem.
Methrend
03082012, 10:50 AM
I have to say, the wording of the question was a bit weird.
If Dan rules that mine no longer counts as a proper solution, I don't mind relinquishing it :P
The way I saw it, if a letter was repeated in the given string, it was seen as a different "instance" of that letter, and as such there could be repeats. (e.g. the 'aaa's were arrange using the different instances of the a), but there couldn't be repeats using the same letter if there was only one. (so for 'abc', you couldn't output 'aaa' more than once)
As an aside to this, It may have been a better problem had it been specified as 'no repitition' (so an input of 'abc' would output 'abc, acb, bac, bca, cab, cba'), rather than every single possible combination of the letters inclusive of repetition.
Still, I don't mind giving up the win and the points if that's the case :)
Edit: In addition, Dan will vouch that I even asked for some small amount of clarification on what he meant by "no overlaps", which I then applied to mean in the way explained above. It may be that I just didn't understand correctly ;P
masterBB
03082012, 11:10 AM
I've no means to change the order of who won. But, my script is faster as yours when you remove the "overlap thingie". I think you're the winner anyway.
slushpuppy
03082012, 11:23 AM
>nielsie95
However I believe High/Length wouldn't work at compile time?
masterBB
03082012, 11:24 AM
>nielsie95
However I believe High/Length wouldn't work at compile time?
They do ;). Just use High(yourArray).
slushpuppy
03082012, 11:29 AM
They do ;). Just use High(yourArray).
Habits carried over from C:p
masterBB
03082012, 11:34 AM
Habits carried over from C:p
Most other languages support c.length on runtime(C# and java for example).
Kyle Undefined
03082012, 03:58 PM
For the intermediate, what if the argument is "100a"? Should we return an empty string?
mixster
03082012, 06:22 PM
mixster:
Nice use of pointers in merger
You can use the builtin swap function for SwapArray
The nextSize loop could you also write as for st to hi  1 with nextSize do
It's all lies!
I dev'd it natively on Linux first and it gave me a lot of problems, one of which was that it didn't want to let me use Swap on the arrays (not to mention would compile when it shouldn't and generally lie to me.) Afraid I didn't think to switch it out when I switched to wine :redface:
Also, what kind of Wizardry is that? for st to hi  1 with nextSize do? I swear, that's just crazy enough that it might work! Though the syntax is a little odd  why should one need to declare nextSize when, I'm assuming, the for loop doesn't affect it or does it create a looplocal variable or am I missing something else?
As an aside, I hate Wizzup? and co for making me optimise my code like mad. They're very naughty boys and I would smack their bottoms if I could reach!
nielsie95
03082012, 07:06 PM
I dev'd it natively on Linux first and it gave me a lot of problems, one of which was that it didn't want to let me use Swap on the arrays (not to mention would compile when it shouldn't and generally lie to me.) Afraid I didn't think to switch it out when I switched to wine :redface:
Please let me know about the problems you're experiencing! :)
Also, what kind of Wizardry is that? for st to hi  1 with nextSize do? I swear, that's just crazy enough that it might work! Though the syntax is a little odd  why should one need to declare nextSize when, I'm assuming, the for loop doesn't affect it or does it create a looplocal variable or am I missing something else?
Not sure what your question is, but these are all valid loops:
var
i: Integer;
begin
for i := 0 to 4 do
WriteLn('Hai: ', i);
i := 3;
for i to 4 do
WriteLn('Hey: ', i);
for i := 0 to 4 with 2 do
WriteLn('Hoi: ', i);
end;
This means that the following can be rewritten
while (st < hi) do
begin
Merger(output, data, st, Min(st + size, len), Min(st + nextSize, len));
st := st + nextSize;
end;
to
for st to hi  1 with nextSize do
Merger(output, data, st, Min(st + size, len), Min(st + nextSize, len));
Zyt3x
03082012, 08:22 PM
Nice code, Methrend! :) Good job.
E:
They're very naughty boys and I would smack their bottoms if I could reach!
Who wouldn't?
For the intermediate, what if the argument is "100a"? Should we return an empty string?
The existing IntToStr function accepts an integer therefore our function must accept an integer so if we passed 100a as an argument it wouldn't compile :D.
Kyle Undefined
03092012, 01:04 AM
But based off of Daniels examples, it can accept strings too ;)
But based off of Daniels examples, it can accept strings too ;)
Yeah but when I asked him he said it can't.
Kyle Undefined
03092012, 01:20 AM
He needs to update his examples then! :p
Daniel
03092012, 04:21 AM
He needs to update his examples then! :p
It was a mere trick <_> Notice in the problem I said to "clone" :)
Kyle Undefined
03092012, 04:35 AM
I know, but your third example would technically error out at compile time :p
Daniel
03152012, 11:16 AM
Not long before the deadline! I still have no submissions for the Advanced or Beginner problems :(
Daniel
03172012, 02:27 AM
Week #2:
Beginner:
Fun With Factorials!
Write a program that programmatically finds the Highest Common Factor of the factorial X and the factorial of Y, otherwise return 0 (zero). Make sure X and Y are defined constants that are placed at the beginning of your script and are more suitably named given their purpose.
Example:
X = 5, Y = 6
HCF = 120
There were no valid submissions for this entry. Quite disappointing :(
Intermediate:
ReadInts:
Write a program that clones the IntToStr function within Simba. In your solution, you may NOT use Simba’s *ToStr in any way (including Format or any other variant), shape or form, and you must check the validity of the argument given. You must also support integers that are both positive AND negative, and output accordingly.
Example #1:
Input = 1000
Output = "1000"
Example #2:
Input = 500
Output = "500"
Example #3:
Input = "abc"
Output = ""
There were three entries for this. Dgby714's submission, however, was the fastest out of all three. [Nathan]'s I couldn't really accept because it didn't work for most of the values tested (48% success rate).
Dgby714's code:
program new;
function IntToStr_FirstAttempt(I: Int32): string;
var
Neg: boolean = False;
begin
Result := '';
if (I = 0) then Exit('0');
if (I < 0) then
begin
Neg := True;
I := Abs(I);
end;
while (I > 0) do
begin
Result := Chr((I mod 10) + 48) + Result;
I := I div 10;
end;
if (Neg) then
Result := '' + Result;
end;
begin
WriteLn('1000 = ', IntToStr_FirstAttempt(1000));
WriteLn('500 = ', IntToStr_FirstAttempt(500));
end.
Sex's code:
function IntToStr2(i : integer) : string;
const
pows : array of integer = [1, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000, 1000000000];
var
n, x : integer;
begin
if i = 0 then begin result := '0'; exit; end;
if 0 > i then begin result := ''; i := abs(i); end;
n := Ceil(Log10(i + 1));
for x := n downto 1 do
result := result + chr(Floor(i / pows[x  1]) mod 10 + 48);
end;
[Nathan]'s code:
program Nathan;
Function IsInteger(ext:extended):Boolean;
begin
result:=false;
if(ext = floor(ext)) then
result:=true;
end;
Function IntToCharArray(ints:Array of Integer):Array of Char;
var len,i:integer;
begin
len:= Length(ints);
SetArrayLength(result, len);
for i:=1 to len1 do
begin
if(ints = 0) then
result:= '0';
if(ints[i] = 1) then
result[i]:= '1';
if(ints[i] = 2) then
result[i]:= '2';
if(ints[i] = 3) then
result[i]:= '3';
if(ints[i] = 4) then
result[i]:= '4';
if(ints[i] = 5) then
result[i]:= '5';
if(ints[i] = 6) then
result[i]:= '6';
if(ints[i] = 7) then
result[i]:= '7';
if(ints[i] = 8) then
result[i]:= '8';
if(ints[i] = 9) then
result[i]:= '9';
end;
end;
Function NathanIntToStr(input:extended):String;
var temp,current:extended;
var i,len:integer;
var arr:Array of Integer;
var chars:Array of char;
var negative:boolean;
begin
negative:=false;
if(input < 0) then
begin
negative:=true;
input:=input*1;
end;
if(input > 2147483647) then
begin
writeln('Number is not a valid int');
TerminateScript;
end;
if not(IsInteger(input)) then
begin
writeln('Number is not a valid int');
TerminateScript;
end;
len:= floor(log10(input)) + 1;
SetArrayLength(arr,len+1);
current:= input/Exp((len1)*Ln(10));
for i := 1 to len do
begin
if(currentfloor(current) > 0.9) then
begin
temp:= floor(current)+1;
end else
temp:= floor(current);
arr[i]:= floor(temp);
current:= (currenttemp) * 10;
end;
chars:= IntToCharArray(arr);
if(negative) then
begin
result:='';
end else
result:='';
for i:=1 to Length(chars)1 do
result:=result+chars[i];
end;
begin
writeln(NathanIntToStr(900708004));
end.
Advanced:
PolyCom
Write a program that takes a standard array of points of [I]nlength, which constructs a 2dimensional polygon shape (arr1 connects to arr2 , arr2 > arr3 , … , arrn1 > arrn , arrn > arr1)note1. Create separate appropriatelynamed methods which:
returns TRUE if the argument [I]point (of type TPoint) is inside the polygon,
returns TRUE if the polygon is complex,
returns the amount of closed regions of the polygon,
returns the maximum angle in DEGREES (minimum precision of 3 floating point numbers) of ALL intersections IF the polygon is complex. You are to sort this array so that it is ordered in a topdown, leftright order.note2
NOTE #1: You must connect the provided points to each other via straight lines, these will not be given.
NOTE #2: An intersection is defined if TWO lines intersect and continue past that point.
Example #1:
array = [(0, 0), (5,5), (5, 0)]
Result_PointInside(2, 1) = True
Result_IsComplex = False
Result_RegionCount = 1
Result_Angles = [ [] ]
Example #2:
array = [(0, 0), (5, 0), (0, 5), (5, 5)]
Result_PointInside(6, 1) = False
Result_IsComplex = True
Result_RegionCount = 2
Result_Angles = [ x.xxx ]
No submissions for this which was quite saddening :( Dgby714, however, allowed me to show to the public his unfinished submission (which only works for simple polygon's). Quite impressive :)
No points were awarded.
Dgby's unfinished submission:
program PolyCom;
type
TInt32Arr = array of Int32;
TDPoint = record
x, y: Double;
end;
TDPointArr = array of TDPoint;
TPolygon = record
_: TDPointArr;
end;
TPolygonArr = array of TPolygon;
TPolyCom = record
Regions: TPolygonArr;
end;
TLine = record
S, E: TDPoint;
end;
function DPoint(x, y: double): TDPoint;
begin
Result.x := x;
Result.y := y;
end;
function Line(const x1, y1, x2, y2: Double): TLine;
begin
Result.S := DPoint(x1, y1);
Result.E := DPoint(x2, y2);
end;
procedure TPolygon.Init(const Arr: TDPointArr);
var
I, H: Int32;
begin
H := High(Arr);
SetLength(_, H + 1);
for I := 0 to H do
_[I] := DPoint(Arr[I].x, Arr[I].y);
end;
function TPolygon.isInside(const Point: TDPoint): boolean;
var
H, I, J: Int32;
begin
Result := False;
H := High(_);
I := 0; J := H;
while (I < H) do
begin
if (((_[I].y > Point.y) <> (_[J].y > Point.y)) and
(Point.x < (_[J].x  _[I].x) * (Point.y  _[I].y) / (_[J].y  _[I].y) + _[I].x)) then
Result := (not (Result));
J := I;
Inc(I);
end;
end;
function doIntersect(const L1, L2: TLine; out O: TDPoint): boolean;
var
I1, I2: Double;
begin
I1 := (((L2.E.y  L2.S.y) * (L1.E.x  L1.S.x)) 
((L2.E.x  L2.S.x) * (L1.E.y  L1.S.y)));
I2 := (((L2.E.y  L2.S.y) * (L1.E.x  L1.S.x)) 
((L2.E.x  L2.S.x) * (L1.E.y  L1.S.y)));
if ((I1 = 0) and (I2 = 0)) then
begin
Result := False;
Exit;
end;
I1 := (((L2.E.x  L2.S.x) * (L1.S.y  L2.S.y)) 
((L2.E.y  L2.S.y) * (L1.S.x  L2.S.x))) / I1;
I2 := (((L1.E.x  L1.S.x) * (L1.S.y  L2.S.y)) 
((L1.E.y  L1.S.y) * (L1.S.x  L2.S.x))) / I2;
Result := ((I1 >= 0) and (I1 <= 1) and
(I2 >= 0) and (I2 <= 1));
if (Result) then
begin
O.x := L1.S.x + I1 * (L1.E.x  L1.S.x);
O.y := L1.S.y + I1 * (L1.E.y  L1.S.y);
end;
end;
procedure TPolyCom.Init(Arr: TDPointArr);
var
H, I: Int32;
begin
SetLength(Regions, 1);
H := High(Arr) + 1;
SetLength(Regions[0]._, H + 1);
for I := 0 to H  1 do
Regions[0]._[I] := Arr[I];
Regions[0]._[H] := Arr[0];
//TODO...
end;
function TPolyCom.isInside(const Point: TDPoint): boolean;
var
I: Int32;
begin
Result := False;
for I := 0 to High(Regions) do
if (Result := Regions[I].isInside(Point)) then
Exit;
end;
function TPolyCom.isComplex(): boolean;
begin
Result := (Length(Regions) <> 1);
end;
function TPolyCom.RegionCount(): Int32;
begin
Result := Length(Regions);
end;
function TPolyCom.Angles(): TInt32Arr;
begin
end;
var
PolyCom: TPolyCom;
begin
with PolyCom do
begin
Init([DPoint(0, 0), DPoint(5, 5), DPoint(5, 0)]);
WriteLn('Inside: ', isInside(DPoint(2, 1)));
WriteLn('Complex: ', isComplex());
WriteLn('RegionCount: ', RegionCount());
WriteLn('Regions: ', Regions);
WriteLn('Angles: ', Angles());
WriteLn('');
Init([DPoint(0, 0), DPoint(5, 0), DPoint(0, 5), DPoint(5, 5)]);
WriteLn('Inside: ', isInside(DPoint(6, 1)));
WriteLn('Complex: ', isComplex());
WriteLn('RegionCount: ', RegionCount());
WriteLn('Regions: ', Regions);
WriteLn('Angles: ', Angles());
WriteLn('');
Init([DPoint(5, 0), DPoint(5, 5), DPoint(0, 5), DPoint(2.5, 10), DPoint(0, 0)]);
WriteLn('Inside: ', isInside(DPoint(0, 0)));
WriteLn('Complex: ', isComplex());
WriteLn('RegionCount: ', RegionCount());
WriteLn('Regions: ', Regions);
WriteLn('Angles: ', Angles());
end;
end.
Daniel
03172012, 03:03 AM
Week #3 problems are up! :)
[Nathan]
03172012, 04:37 AM
Just curious, what numbers didn't work, I didn't have anything I tried not work. What didn't I think of?
;962749']just curious, what numbers didn't work, i didn't have anything i tried not work. What didn't i think of?
80968.
nielsie95
03172012, 03:43 PM
A few comments:
Dgby714:
Nice, clean and clear code!
Methods on types for the advanced submission. Sweet! :D
Sex:
You can use a static array for pows.
You can pass an argument to exit: Exit('0').
[Nathan]:
Use a case statement to group the if's.
Why take an extended argument for an integer to string function? ;)
You can get the maximum int value using High(Integer), instead of hardcoding it.
I'll be honest, the advanced problem looked a bit too advanced for me to quickly whip up a script. Let's hope this week there will be more submissions! :)
A few comments:
Dgby714:
Nice, clean and clear code!
Methods on types for the advanced submission. Sweet! :D
Sex:
You can use a static array for pows.
You can pass an argument to exit: Exit('0').
[Nathan]:
Use a case statement to group the if's.
Why take an extended argument for an integer to string function? ;)
You can get the maximum int value using High(Integer), instead of hardcoding it.
I'll be honest, the advanced problem looked a bit too advanced for me to quickly whip up a script. Let's hope this week there will be more submissions! :)
I thought I did use a static array :/. Did you mean without array of integer? And yes, I just learned about exit taking a parameter a little while ago :). Thank you for the comments.
nielsie95
03172012, 03:58 PM
const
a = [1..3];
b: array of Integer = [1..3];
c: array[1..3] of Integer = [1..3];
begin
WriteLn(SizeOf(a), '  ', SizeOf(b), '  ', SizeOf(c));
end;
In this case, variables a and c are static arrays and b is a dynamic array. The only difference is the way they are stored (as you can seen by their sizes).
You could use the static variant, because you know the size of your array. :)
Ah, yes. Didn't realize I hadn't set a size.
My word the beginner problem looks difficult...
My word the beginner problem looks difficult...
Honestly, it can be done in 4 lines :p.
Honestly, it can be done in 4 lines :p.
Yeh but I'm crap with binaries :(
If I don't understand them properly, how I can I right it?
Yeh but I'm crap with binaries :(
If I don't understand them properly, how I can I right it?
You should research it (hint: google "Decimal to Binary") :p.
nielsie95
03242012, 09:54 AM
How are the submissions coming along? I'm interested in seeing the advanced solutions ^^
Daniel
03242012, 10:01 AM
How are the submissions coming along? I'm interested in seeing the advanced solutions ^^
No advanced solutions thus far :( But mixster is working on one, and has said even if he doesn't complete it by the date, he will still share with us :)
I only have solutions for the intermediate challenge (several).
Imanoobbot
03242012, 12:15 PM
Only thing I can say to this is +1 Daniel ;)
mixster
03242012, 12:56 PM
No advanced solutions thus far :( But mixster is working on one, and has said even if he doesn't complete it by the date, he will still share with us :)
I only have solutions for the intermediate challenge (several).
Easy is <4 lines, Intermediate is <10 lines, Advanced is some several hundred lines. Really, you need to tone it down a bit or tone it up a bit.
Daniel
03252012, 06:13 AM
Hey guys,
Really sorry! This has to be postponed for about a day due to excessive schoolwork I have to complete. So, unfortunately, you all get an extra day to submit your things :(
mixster
03272012, 12:34 PM
Pfft, he's taking forever like a little female dog.
program BigNumLibrary;
type
BigNumBase = LongWord;
const
HIGHBIT = High(BigNumBase) xor (High(BigNumBase) shr 1);
HIGHBITS = High(BigNumBase);
function IntToBinary(value: Integer): string;
function BoolToInt(value: Boolean): Integer;
begin
if (value) then
Result := 1
else
Result := 0;
end;
begin
if (value = 0) then
Result := ''
else
Result := IntToBinary(value shr 1) + IntToStr(BoolToInt(value and 1 = 1));
end;
type
PBigNumPart = ^BigNumPart;
BigNumPart = record
data: BigNumBase;
next: PBigNumPart;
end;
BigNum = record
root: PBigNumPart;
sign: Boolean; // false = neg; true = pos
end;
function BigNumNew(value: Integer): BigNum;
begin
New(Result.root);
Result.root^.next := nil;
Result.sign := value >= 0;
Result.root^.data := value;
end;
function BigNumCopyPart(part: BigNumPart): PBigNumPart;
begin
New(Result);
Result^.data := part.data;
Result^.next := nil;
end;
function BigNumCopy(value: BigNum): BigNum;
var
part, position: PBigNumPart;
begin
Result.root := nil;
Result.sign := value.sign;
if (value.root = nil) then Exit;
part := value.root;
Result.root := BigNumCopyPart(part^);
position := Result.root;
while (part^.next <> nil) do
begin
position^.next := BigNumCopyPart(part^);
position := position^.next;
part := part^.next;
end;
end;
procedure BigNumDispose(var value: BigNum);
var
partN, partC: PBigNumPart;
begin
partC := value.root;
while (partC <> nil) do
begin
partN := partC^.next;
Dispose(partC);
partC := partN;
end;
value.root := nil;
value.sign := True;
end;
function BigNumAdd(a, b: BigNum): BigNum; forward;
function BigNumInvert(value: BigNum): BigNum;
var
partN, partR: PBigNumPart;
bigTemp, bigOne: BigNum;
begin
bigTemp.sign := not value.sign;
partN := value.root;
if (partN = nil) then
partR := nil
else
partR := BigNumCopyPart(partN^);
bigTemp.root := partR;
while (partN <> nil) do
begin
partR^.data := partR^.data xor HIGHBITS;
partR^.next := BigNumCopyPart(partN^);
partR := partR^.next;
partN := partN^.next;
end;
partR^.data := partR^.data xor HIGHBITS;
Writeln(IntToBinary(value.root^.data));
Writeln(IntToBinary(partR^.data));
bigOne := BigNumNew(1);
Result := BigNumAdd(bigTemp, bigOne);
BigNumDispose(bigTemp);
BigNumDispose(bigOne);
end;
function BigNumGreaterThan(a, b: BigNum): Integer;
function BigNumPartGreaterThan(a, b: PBigNumPart): Integer;
var
ta, tb: BigNumBase;
begin
if (a = nil) xor (b = nil) then
begin
if (a = nil) then
Exit(1)
else
Exit(1);
end;
if (a = nil) then
Exit(0);
Result := BigNumPartGreaterThan(a^.next, b^.next);
if (Result = 0) then
begin
ta := a^.data;
tb := b^.data;
repeat
if ((ta xor tb) and HIGHBIT) = HIGHBIT then
begin
if (ta and HIGHBIT) = HIGHBIT then
Exit(1)
else
Exit(1);
end;
ta := ta shl 1;
tb := tb shl 1;
until((ta = 0) and (tb = 0));
Exit(0);
end;
end;
var
ta, tb: BigNum;
begin
if (a.sign) then
ta := BigNumCopy(a)
else
ta := BigNumInvert(a);
if (b.sign) then
tb := BigNumCopy(b)
else
tb := BigNumInvert(b);
Result := BigNumPartGreaterThan(ta.root, tb.root);
BigNumDispose(ta);
BigNumDispose(tb);
end;
function BigNumAdd(a, b: BigNum): BigNum;
function AddPart(a, b: BigNumPart; out c: Boolean): PBigNumPart;
begin
New(Result);
Result^.data := a.data + b.data;
c := Result^.data < a.data;
Result^.next := nil;
end;
var
carry, carryNext: Boolean;
partA, partB, partR, temp, partOne: PBigNumPart;
begin
partA := a.root;
partB := b.root;
New(partOne);
partOne^.data := 1;
if (partA = nil) then
Exit(BigNumCopy(b))
else if (partB = nil) then
Exit(BigNumCopy(a));
partR := AddPart(partA^, partB^, carryNext);
Result.root := partR;
partA := partA^.next;
partB := partB^.next;
while ((partA <> nil) and (partB <> nil)) do
begin
carry := carry or carryNext;
temp := AddPart(partA^, partB^, carry);
if (carry) then
temp := AddPart(partA^, partOne^, carry)
else
temp := BigNumCopyPart(partA^);
partR^.next := AddPart(temp^, partB^, carryNext);
Dispose(temp);
partR := partR^.next;
partA := partA^.next;
partB := partB^.next;
end;
if (partA = nil) then
partA := partB;
carryNext := carry or carryNext;
while (partA <> nil) do
begin
if (carryNext) then
partR^.next := AddPart(partA^, partOne^, carryNext)
else
partR^.next := BigNumCopyPart(partA^);
partR := partR^.next;
partA := partA^.next;
end;
if (a.sign = b.sign) then
Result.sign := a.sign
else
begin
if (BigNumGreaterThan(a, b) <> 1) then
Result.sign := a.sign
else
Result.sign := b.sign;
end;
if (carryNext and (a.sign = b.sign)) then
begin
partR^.next := partOne;
if (not Result.sign) then
begin
if ((partR^.data and HIGHBIT) <> HIGHBIT) then
partOne^.data := (partOne^.data xor HIGHBITS)
else
begin
Dispose(partOne);
partR^.next := nil;
end;
end;
end
else
Dispose(partOne);
end;
function BigNumToBinary(value: BigNum): string;
var
partC: PBigNumPart;
begin
partC := value.root;
Result := '';
while (partC <> nil) do
begin
Result := PadL(IntToBinary(partC^.data), 32, '0') + Result;
partC := partC^.next;
end;
end;
I can't even remember how well addition works, but I'm pretty sure it nearly works perfectly (I think negative + negative is the failing point that I was working on.) It's also so awesome that it's 32/64bit independent and you can alter its base type to Byte or stuff to make it more finegrained in its memory usage (though, really, if you care about 3 bytes of memory, you suck.)
Anyone doing this using arrays of booleans should just admit how awesome I am as well, since this method uses integer addition to speed up its processing like a boss. It also has little overhead when expanding or contracting how many longwords it uses since it's linked list based rather than array based, so it's really just all round awesome for a BigNum intense program rather than a silly one that just wants to store some number that's slightly too big for an Int64.
Before I forget, I showed this to a female and she bedded me so quickly I barely had time to get my Promise bracelet off. Just saying, chicks dig epic code.
Daniel
03292012, 05:33 AM
Sorry, school work has really picked up this week due to the upcoming holidays. :( And also when you try out a different OS setup :(
Might as well further postpone it to this Saturday again, so the timings don't all get screwed up.
putonajonny
03302012, 03:24 PM
Sorry, school work has really picked up this week due to the upcoming holidays. :( And also when you try out a different OS setup :(
Might as well further postpone it to this Saturday again, so the timings don't all get screwed up.
If you would like a hand judging the results (obvs I can't judge the intermediate one this time) but I am happy to help out.. PM me if you want :)
m34tcode
03302012, 05:14 PM
In too late >.>
mixster
03302012, 07:11 PM
In too late >.>
Except he said he's delaying it 'til tomorrow/Sunday (depending on your timezone.)
m34tcode
03302012, 07:37 PM
Wasnt sure if he meant the start of the next one, or the end of this one. My function works perfect lol
putonajonny
04062012, 02:13 PM
I'm just wondering what is happening with this...
mixster
04062012, 04:55 PM
Dan was complaining about real life or something.
m34tcode
04072012, 05:36 AM
Has school
Imagine
04092012, 02:33 AM
Ugh, I can't figure out the syntax for loops in Lape, I had scripts 1 & 2 done otherwise :/
Ugh, I can't figure out the syntax for loops in Lape, I had scripts 1 & 2 done otherwise :/
Lol dude, the syntax for loops is exactly the same as PascalScript, however there is also support for the with keyword..
var
i : integer;
begin
for i := 0 to 10 with 2 do
writeln(i);
end.
=> 0, 2, 4, 6, 8, 10
Imagine
04092012, 09:27 PM
Lol dude, the syntax for loops is exactly the same as PascalScript, however there is also support for the with keyword..
var
i : integer;
begin
for i := 0 to 10 with 2 do
writeln(i);
end.
=> 0, 2, 4, 6, 8, 10
I had
for i := 0 to 10 do
and for some reason it was giving me an error, I'll try that then I guess
for i := 0 to 10 do
writeln(i);
Will work just fine :).
Powered by vBulletin® Version 4.2.1 Copyright © 2020 vBulletin Solutions, Inc. All rights reserved.