Stats with random numbers - algorithm

I want to create 7 stats for a character, randomly generating a value from 3-21, with the stat's sum being no higher than 91. I've tried arranging the stats into an array, and just going through them like this:
1) add random(15) to each array member
2) computing the total, subtracting from the 91 maximum
3) dividing this difference by 7
4) do step 1 with random(difference) adding it to the stat
5) Until I hit the 91 total.
Doing this a few hundred times I seem to get a curve where the 5,6, and 7th stats tend to be higher. And sometimes I hit the 4 or 5th stat and there are no more numbers to be added, meaning then that the first few stats get the most points. I think I am approaching this the wrong way to begin with. Any ideas? I have tunnel vision at this point I think.

It sounds like you're overthinking this. I might do something like this :
const
STAT_QTY = 7;
STATSUM_MAX = 91;
STAT_MIN = 3;
STAT_MAX = 21;
type
TStatArray = Array [0..STAT_QTY-1] of integer;
Then in implementation :
function GenerateStats : TStatArray;
var statArr : TStatArray;
i, statSum, excess, debit : integer;
done : boolean;
begin
Randomize;
done := false;
while not done do begin
done := true;
statSum := 0;
for i := 0 to STAT_QTY - 1 do begin
statArr[i] := STAT_MIN + Random(STAT_MAX - STAT_MIN);
statSum := statSum + statArr[i];
end;
if statSum > STATSUM_MAX then begin
excess := statSum - STATSUM_MAX;
debit := excess div STAT_QTY + 1;
for i := 0 to STAT_QTY -1 do begin
statArr[i] := statArr[i] - debit;
end;
end;
for i := 0 to STAT_QTY -1 do begin
if statArr[i] < STAT_MIN then done := false;
end;
end;
result := statArr;
end;
This generates a list of random stats in the range 3-21. If the sum is more than 91 then divide the excess by the number of stats (use div then round up the answer) and subtract an equal number from each. In the rare case that you end up with stats less than three, just do it again. Job done.
Tested over 2000 iterations I get average stats of :
[1] : 11.13893053
[2] : 11.15692154
[3] : 11.16141929
[4] : 11.11444278
[5] : 11.10194903
[6] : 10.9800100
[7] : 10.86856572
That's a total average of 11.07 with a standard deviation of 0.11 - certainly about what one would expect from a generally random set with your construction parameters.

Here's C-ish pseudo code for a slightly different approach, assuming a suitable random(N) function that returns numbers in the range 0 - N-1.
int stats[7], deficit = 70;
for (int i = 0; i < 7; ++i)
stats[i] = 3; // initial assignments of the minimum to each stat
while (deficit)
{ int tmp = random(7); // pick a random stat to bump
if (stats[tmp] == 21) // but not if it's already at max
continue;
++stats[tmp];
--deficit;
}
Assuming your random() is uniformly distributed, that should give pretty good results.

Related

Draw n random integers whose sum is equal to 100 [closed]

Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 2 years ago.
Improve this question
Pseudocode example:
Random function: (1 to 5, values less than 100, sum must be equal to 100 when all random numbers are added).
Result example:
Number 1 = 35
Number 2 = 15
Number 3 = 10
Number 4 = 20
Number 5 = 20
Your problem isn't quite well-defined. There are many possible solutions, with different properties.
Here is the first one that sprung to my mind: create a subdivision of the interval [0, 1] into n parts by choosing n − 1 points in [0, 1] randomly. Then scale this to [0, A] and use the lengths of these subintervals as your n random numbers with sum A.
function GetRandomNumbers(ACount: Integer; const ASum: Double): TArray<Double>;
var
Itvs: TArray<Double>;
i: Integer;
begin
if ACount < 1 then
raise Exception.Create('GetRandomNumbers: Invalid parameters.');
// Create a subdivision of [0, 1]
SetLength(Itvs, ACount + 1);
Itvs[0] := 0;
for i := 1 to ACount - 1 do
Itvs[i] := Random;
Itvs[ACount] := 1;
TArray.Sort<Double>(Itvs);
SetLength(Result, ACount);
for i := 0 to ACount - 1 do
Result[i] := ASum * (Itvs[i + 1] - Itvs[i]);
end;
For example, this might give
16.7746451916173
7.29391833301634
22.1434036735445
3.25182809028775
50.5362047115341
for n = 5 and A = 100.
This uses modern Delphi techniques like generics, but the general idea should be clear enough, so you can implement it in Delphi 7 and use any sorting method you like. Also, I'll leave it as an exercise to make an integer version of GetRandomNumbers.
Using only integer numbers and Fisher-Yates shuffle:
program cont3;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils;
const
SummandsCount = 5;
WantedSum = 100;
var
i, j, t, Cnt, WhereToInsert: integer;
JustNaturalNumbers: array[1..WantedSum] of Integer;
DividingPoints: array[0..SummandsCount] of Integer;
begin
Randomize;
Cnt := 1;
DividingPoints[0] := 0;
DividingPoints[SummandsCount] := 100;
for i := 1 to WantedSum - 1 do
JustNaturalNumbers[i] := i;
for i := WantedSum - 1 downto WantedSum - SummandsCount + 1 do begin
j := 1 + Random(i);
WhereToInsert := Cnt;
while (WhereToInsert > 1) and (JustNaturalNumbers[j] < DividingPoints[WhereToInsert-1]) do begin
Dec(WhereToInsert);
DividingPoints[WhereToInsert + 1] := DividingPoints[WhereToInsert]
end;
DividingPoints[WhereToInsert] := JustNaturalNumbers[j];
JustNaturalNumbers[j] := JustNaturalNumbers[i];
Inc(Cnt);
end;
t := 0;
for i := 1 to SummandsCount do begin
Writeln(DividingPoints[i] - DividingPoints[i-1]);
t := t + (DividingPoints[i] - DividingPoints[i-1]);
end;
Writeln('Sum = ', t);
Readln;
end.
Output example:
22
4
7
18
49
Sum = 100

Pascal - Sum of odd numbers between 0 and X

I've beeng having some trouble with this code... I need to create an algorithm which makes the user input a number (X), and then the program calculates the sum of all the odd numbers below (x).
This what I've tried so far, but can't really wrap my head around the logic behind it:
Program odd_numbers;
Var
Num, Limite, Soma: integer;
Begin;
Soma := 0;
Writeln('Choose a limit:');
Readln(Limite);
While (Limite / 2 > 0) do
Begin;
Soma := ((Num < Limite) mod 2 > 0);
Writeln('The sum of odd numbers from 0 to ', Limite, ' é ', Soma);
End;
if (Limite mod 2 = 0) then
Begin;
Soma := ((Num < Limite) mod 2 = 0);
Writeln('The sum of odd numbers from 0 to ', Limite, ' é ', Soma);
End;
End.
*PS: Been writing the code with variables in Portuguese, so don't mind the variables appearing weird to understand. *
I see that everyone is happily looping, but this is not necessary. This is a simple arithmetic sequence, and the sum can be calculated without a loop.
Just think of the following:
1 + 3 = 2 * (1 + 3) / 2 = 2 * 2 = 4 ; limits 3 and 4
1 + 3 + 5 = 3 * (1 + 5) / 2 = 3 * 3 = 9 ; limits 5 and 6
1 + 3 + 5 + 7 = 4 * (1 + 7) / 2 = 4 * 4 = 16 ; limits 7 and 8
1 + 3 + 5 + 7 + 9 = 5 * (1 + 9) / 2 = 5 * 5 = 25 ; limits 9 and 10
1 + 3 + 5 + 7 + 9 + 11 = 6 * (1 + 11) / 2 = 6 * 6 = 36 ; limits 11 and 12
But not only that, you'll see that it is in fact always a perfect square: Sqr((n+1) div 2).
So just calculate:
program odd_numbers;
var
Num, Limite, Soma: Integer;
begin
Write('Choose a limit: ');
Readln(Limite);
Num := (Limite + 1) div 2;
Soma := Num * Num;
Writeln('The sum of odd numbers from 0 to ', Limite, ' is ', Soma);
end.
Looks a little simpler than what the others propose.
The loop While (Limite / 2 > 0) do ... uses real arithmetic and not integer arithmetic. I guess you mean While (Limite div 2 > 0) do ... And you should change Limite in the loop otherwise you get stuck because the exit condition can never be reached.
After you have asked the user to enter a number, Limite, you need to keep that unchanged, because you need it in the final message. You also need a loop where you go through all numbers from Limite towards 0.
You started with a while loop which is ok, you are just missing the loop control variable. That is a variable that eventually gets a terminating value which then stops the loop. Use for example the Num variable you already have declared. You can use the same variable to investigate the numbers between user input and 0, for being odd values.
num := limite-1; // give num a start value based on user input (-1 because of "... numbers below (x)")
while num > 0 do // stop the loop when 0 is reached
begin
// here you investigate if `num` is a odd number (e.g. using `mod` operator or
// possibly your pascal has a built in `function Odd(value: integer): boolean;`)
// and add it to `Soma` if it is
num := num - 1;// decrement num at every iteration
end;
Finally you need to consider changes to the above, to handle negative input from the user.
To test if an integer is an odd value, you could use following function:
function IsOdd( value : Integer) : Boolean;
begin
IsOdd := (value mod 2) <> 0;
end;
Many pascal compilers have a built-in function called Odd(), which you could use.
A while loop works well to solve this problem. If you start with lowest odd number above zero, i.e. one and continue upwards so long we do not exceed the limit value we have a simple start:
function GetOddSumBelowX( X : Integer) : Integer;
var
i,sum: Integer;
begin
i := 1; // Start with first odd number
sum := 0;
while (i < X) do begin // as long as i less than X, loop
if IsOdd(i) then begin
sum := sum + i; // add to sum
end;
i := i + 1; // Increment i
end;
GetOddSumBelowX := sum;
end;
Now, that was simple enough. Next step to simplify the loop is to increment the i variable by two instead, just to jump between all odd numbers:
function GetOddSumBelowX( X : Integer) : Integer;
var
i,sum: Integer;
begin
i := 1; // Start with first odd number
sum := 0;
while (i < X) do begin // as long as i less than X, loop
sum := sum + i; // add to sum
i := i + 2; // Increment to next odd number
end;
GetOddSumBelowX := sum;
end;

Optimize a perfect number check to O(sqrt(n))

Part of the program I have checks if an input number is a perfect number. We're supposed to find a solution that runs in O(sqrt(n)). The rest of my program runs in constant time, but this function is holding me back.
function Perfect(x: integer): boolean;
var
i: integer;
sum: integer=0;
begin
for i := 1 to x-1 do
if (x mod i = 0) then
sum := sum + i;
if sum = x then
exit(true)
else
exit(false);
end;
This runs in O(n) time, and I need to cut it down to O(sqrt(n)) time.
These are the options I've come up with:
(1) Find a way to make the for loop go from 1 to sqrt(x)...
(2) Find a way to check for a perfect number that doesn't use a for loop...
Any suggestions? I appreciate any hints, tips, instruction, etc. :)
You need to iterate the cycle not for i := 1 to x-1 but for i := 2 to trunc(sqrt(x)).
The highest integer divisor is x but we do not take it in into account when looking for perfect numbers. We increment sum by 1 instead (or initialize it with 1 - not 0).
The code if (x mod i = 0) then sum := sum + i; for this purpose can be converted to:
if (x mod i = 0) then
begin
sum := sum + i;
sum := sum + (x div i);
end;
And so we get the following code:
function Perfect(x: integer): boolean;
var
i: integer;
sum: integer = 1;
sqrtx: integer;
begin
sqrtx := trunc(sqrt(x));
i := 2;
while i <= sqrtx do
begin
if (x mod i = 0) then
begin
sum := sum + i;
sum := sum + (x div i) // you can also compare i and x div i
//to avoid adding the same number twice
//for example when x = 4 both 2 and 4 div 2 will be added
end;
inc(i);
end;
if sum = x then
exit(true)
else
exit(false);
end;

A game with 100 oponnents, win as much money as possible

You play a game with 100 opponents. The game has k rounds. Every round you can eliminate some opponents (always atleast 1). You are rewarded for eliminating them.
The reward is: 100.000 * '# of eliminated opponents' / '# of opponents' <= in integers (rounded down)
I want to eliminate the opponents in a way, that gets me the largest amount of money possible.
Example game:
number of rounds = 3
first round we eliminate 50 opponents, so we get 100.000 * 50 / 100 = +50.000
second round we eliminate 30, so we get 100.000 * 30 / 50 = +60.000
last round we eliminate last 20 opponents, so we get 100.000 * 20 / 20 = +100.000
so the total winnings are: 210.000
I tried to write up something, but I don't think it's the most effective way to do it?
Program EliminationGame;
var
selectedHistory : array [1..10] of integer;
opponentCount,roundCount : integer;
maxOpponents,numberSelected : integer;
totalMoney : integer;
i : integer;
begin
totalMoney := 0;
maxOpponents := 100;
opponentCount := maxOpponents;
roundCount := 3; {test value}
for i:=1 to roundCount do begin
if (i = roundCount) then begin
numberSelected := opponentCount;
end else begin
numberSelected := floor(opponentCount / roundCount);
end;
selectedHistory[i] := numberSelected;
totalMoney := floor(totalMoney + (numberSelected / opponentCount * 100000));
opponentCount := opponentCount - numberSelected;
end;
writeln('Total money won:');
writeln(totalMoney);
writeln('Amount selected in rounds:');
for i:= 0 to Length(selectedHistory) do
write(selectedHistory[i],' ');
end.
Also it seems that floor function does not exist in pascal?
It seems the question has a maths answer that can be calculated in advance. As #Anton said it was obvious that the number of points given during the third round did not depend upon the number of eliminated enemies. So the third round should eliminate 1 enemy.
So We get the following function for a thre-round game.
f(x)=100000x/100+100000(99-x)/(100-x)+100000*1/1, where x- the number
of enemies eleminated at first round.
if we find the extrema (local maximum of the function) it appears equal to 90. That means the decision is the following: the first round eliminates 90 the second - 9, the third - 1 enemy.
Of course, for consideration: 90=100-sqrt(100).
In other words: the Pascal decision of the task is to loop a variable from 1 to 99 and see the maximum of this function. X-will be the answer.
program Project1;
var
x, xmax: byte;
MaxRes, tmp: real;
begin
xmax := 0;
MaxRes := 0;
for x := 1 to 99 do
begin
tmp := 100000 * x / 100 + 100000*(99 - x) / (100 - x) + 100000 * 1 / 1;
if tmp > MaxRes then
begin
MaxRes := tmp;
xmax := x;
end;
end;
writeln(xmax);
readln;
end.
The general decision for other number of enemies and rounds (using recursion) is the following (Delphi dialect):
program Project1;
{$APPTYPE CONSOLE}
{$R *.res}
Uses System.SysUtils;
var
s: string;
function Part(RemainingEnemies: byte; Depth: byte;
var OutputString: string): real;
var
i: byte;
tmp, MaxRes: real;
imax: byte;
DaughterString: string;
begin
OutputString := '';
if Depth = 0 then
exit(0);
imax := 0;
MaxRes := 0;
for i := 1 to RemainingEnemies - Depth + 1 do
begin
tmp := i / RemainingEnemies * 100000 + Part(RemainingEnemies - i, Depth - 1,
DaughterString);
if tmp > MaxRes then
begin
MaxRes := tmp;
imax := i;
OutputString := inttostr(imax) + ' ' + DaughterString;
end;
end;
result := MaxRes;
end;
begin
writeln(Part(100, 3, s):10:1);//first parameter-Enemies count,
//2-Number of rounds,
//3-output for eliminated enemies counter
writeln(s);
readln;
end.
This problem can be solved with a dynamic approach.
F(round,number_of_opponents_remained):
res = 0
opp // number_of_opponents_remained
for i in [1 opp]
res = max(res, opp/100 + F(round-1,opp - i) )
return res
I should say this not the complete solution and you add some details about it, and I am just giving you an idea. You should add some details such as base case and checking if opp>0 and some other details. The complexity of this algorithm is O(100*k).

0-1 Knapsack on infinite integer array?

Given an infinite positive integer array or say a stream of positive integers, find out the first five numbers whose sum is twenty.
By reading the problem statement, it first seems to be 0-1 Knapsack problem, but I am confused that can 0-1 Knapsack algo be used on a stream of integers. Let suppose I write a recursive program for the above problem.
int knapsack(int sum, int count, int idx)
{
if (sum == 0 && count == 0)
return 1;
if ((sum == 0 && count != 0) || (sum != 0 && count == 0))
return 0;
if (arr[idx] > 20) //element cann't be included.
return knapsack(sum, count idx + 1);
return max(knapsack(sum, count, idx +1), knapsack(sum - arr[idx], count -1, idx + 1));
}
Now when the above function will call on an infinite array, the first call in max function i.e. knapsack(sum, count, idx +1) will never return as it will keep on ignoring the current element. Even if we change the order of the call in max function, there is still possibility that the first call will never return. Is there any way to apply knapsack algo in such scenarios?
This works if you are working with only positive integers.
Basically keep a list of ways you can reach any of the first 20 numbers and whenever you process a new number process this list accordingly.
def update(dictlist, num):
dk = dictlist.keys()
for i in dk:
if i+num <=20:
for j in dictlist[i]:
listlen = len(dictlist[i][j]) + 1
if listlen >5:
continue
if i+num not in dictlist or listlen not in dictlist[i+num]:
dictlist[i+num][listlen] = dictlist[i][j]+[num]
if num not in dictlist:
dictlist[num]= {}
dictlist[num][1] = [num]
return dictlist
dictlist = {}
for x in infinite_integer_stream:
dictlist = update(dictlist,x)
if 20 in dictlist and 5 in dictlist[20]:
print dictlist[20][5]
break
This code might have some minor bugs and I do not have time now to debug it. But basically dictlist[i][j] stores a j length list that sums to i.
Delphi code:
var
PossibleSums: array[1..4, 0..20] of Integer;
Value, i, j: Integer;
s: string;
begin
s := '';
for j := 1 to 4 do
for i := 0 to 20 do
PossibleSums[j, i] := -1;
while True do begin
Value := 1 + Random(20); // stream emulation
Memo1.Lines.Add(IntToStr(Value));
if PossibleSums[4, 20 - Value] <> -1 then begin
//we just have found 5th number to make the full sum
s := IntToStr(Value);
i := 20 - Value;
for j := 4 downto 1 do begin
//unwind storage chain
s := IntToStr(PossibleSums[j, i]) + ' ' + s;
i := i - PossibleSums[j, i];
end;
Memo1.Lines.Add(s);
Break;
end;
for j := 3 downto 1 do
for i := 0 to 20 - Value do
if (PossibleSums[j, i] <> -1) and (PossibleSums[j + 1, i + Value] = -1) then
PossibleSums[j + 1, i + Value] := Value;
if PossibleSums[1, Value] = -1 then
PossibleSums[1, Value] := Value;
end;
end;
output:
4
8
9
2
10
2
17
2
4 2 10 2 2

Resources