I am trying to pick one number from multiple arraylists and find all possible ways to pick the numbers such that the sum of those numbers is greater than a given number. I can only think of brute force implementation.
For example, I have five arraylists such as
A = [2, 6, 7]
B = [6, 9]
C = [4]
D = [4, 7]
E = [8, 10, 15]
and a given number is 40.
Then after picking one number from each list, all possible ways could be
[7, 9, 4, 7, 15]
[6, 9, 4, 7, 15]
So, these are the two possible ways to pick numbers greater than or equal to 40. In case the given number is small then there could be many solutions. So how can I count them without brute force? Even with brute force how do I devise the solution in Java.
Below is my implementation. It works fine for small numbers but if the numbers are large then it gives me runtime error since the program runs for too long.
public static void numberOfWays(List<Integer> A, List<Integer> B, List<Integer> C, List<Integer> D,
List<Integer> E, int k){
long ways = 0;
for(Integer a:A){
for(Integer b:B){
for(Integer c:C){
for(Integer d:D){
for(Integer e:E){
int sum = a+b+c+d+e;
//System.out.println(a+" "+b+" "+c+" "+d+" "+e+" "+sum);
if(sum > k)
ways++;
}
}
}
}
}
System.out.println(ways);
}
The list can contain up to 1000 elements and the elements can range from 1 to 1000. The threshold value k can range from 1 to 10^9.
I am not a java programmer.But I think its a logical problem.So,I have solved it for you in python.I am pretty sure you can convert it into java.
Here is the code:
x = input('Enter the number:')
a = [2, 6, 7]
b = [6, 9]
c = [4]
d = [4, 7]
e = [8, 10, 15]
i = 0
z = 0
final_list = []
while i <= int(x):
try:
i += a[z]
final_list.append(a[z])
except BaseException:
pass
try:
i += b[z]
final_list.append(b[z])
except BaseException:
pass
try:
i += c[z]
final_list.append(c[z])
except BaseException:
pass
try:
i += d[z]
final_list.append(d[z])
except BaseException:
pass
try:
i += e[z]
final_list.append(e[z])
except BaseException:
pass
z += 1
print(final_list)
One way is this. There has to be at least one solution where you pick one number from each array and add them up to be greater than or equal to another.
Considering the fact that arrays might have random numbers in any order, first use this sort function to have them in decreasing order (largest number first, smallest number last) :
Arrays.sort(<array name>, Collections.reverseOrder());
Then pick the 1st element in the array :
v = A[0]
w = B[0]
x = C[0]
y = D[0]
z = E[0]
Then you can print them like this : v,w,x,y,z
Now your output will be :
7,9,4,7,15
Since it took the largest number of each array, it has to be equal to or greater than the given number, unless the number is greater than all of these combined in which case it is impossible.
Edit : I think I got the question wrong. If you want to know how many of the possible solutions there are, that is much easier.
First create a variable to store the possibilities
var total = 0
Use the rand function to get a random number. In your array say something like :
v=A[Math.random(0,A[].length)]
Do the same thing for all arrays, then add them up
var sum = v+w+x+y+z
Now you have an if statement to see if the sum is greater than or equal to the number given (lets say the value is stored in the variable "given")
if(sum >= given){
total+=1
}else{
<repeat the random function to restart the process and generate a new sum>
}
Finally, you need to repeat this multiple times as incase there are multiple solutions, the code will only find one and give you a false total.
To solve this, create a for loop and put all of this code inside it :
//create a variable outside to store the total number of elements in all the arrays
var elements = A[].length + B[].length + C[].length + D[].length + E[].length
for(var i = 0; i <= elements; i++){
<The code is inside here, except for "total" as otherwise the value will keep resetting>
}
The end result should look something like this :
var total = 0
var elements = A[].length + B[].length + C[].length + D[].length + E[].length
for(var i = 0; i <= elements; i++){
v=A[Math.random(0,A[].length)]
w=B[Math.random(0,B[].length)]
x=C[Math.random(0,C[].length)]
y=D[Math.random(0,D[].length)]
z=E[Math.random(0,E[].length)]
var sum = v+w+x+y+z
if(sum >= given){
total+=1
}else{
v=A[Math.random(0,A[].length)]
w=B[Math.random(0,B[].length)]
x=C[Math.random(0,C[].length)]
y=D[Math.random(0,D[].length)]
z=E[Math.random(0,E[].length)]
}
}
At the end just print the total once the entire cycle is over or just do
console.log(total)
This is just for reference and the code might not work, it probably has a bunch of bugs in it, this was just my 1st draft attempt at it. I have to test it out on my own but i hope you see where I'm coming from. Just look at the process, make your own amendments and this should work fine.
I have not deleted the first part of my answer even though it isn't the answer to this question just so that if you're having trouble in that part as well, where you select the highest possible number, it might help you
Good luck!
I have a large file (written in Mathematica) that contains n "records" and each of these records is a list of fixed length m, where n > 10,000 and 500 < m < 600 (bytes). Note, my system does not have the capacity to hold all records in memory --- the reason for writing them to a file. I have an application (in Mathematica) that needs to process these records in reverse order; i.e. the last record written out is the first record to be processed. How can I read these records from the file in reverse order?
Meanwhile (after some trial and error with Mathematica I/O) I found one solution. Note, this is a stripped down example of a possible solution.
fname = "testfile";
strm = OpenWrite[fname];
n = 10; (* In general, n could be very large *)
For[k = 1, k <= n, k++,
(* Create list on each pass through this loop ... *)
POt = {{k, k + 1}, {k + 2, k + 3}};
Print[POt];
(* Save to a file *)
Write[strm, POt];
];
Close[strm];
(* 2nd pass to get byte offsets of each record written to file *)
strm = OpenRead[fname];
ByteIndx = {0};
For[i = 1, i <= n, i++,
PIn = Read[strm];
AppendTo[ByteIndx, StreamPosition[strm]];
];
Drop[ByteIndx, -1]
(* Read records in reverse order *)
For[i = n, i >= 1, i--,
SetStreamPosition[strm, ByteIndx[[i]]];
PIn = Read[strm];
Print[PIn];
(* Process PIn ... *)
];
Close[strm];
It would be nice if the 2nd pass (to get the byte offsets) could be eliminated but I have not found how to do this yet... Also, these byte offsets could be written to a file (similar to how the records are handled) and then read back in one at a time, should there still be a memory problem.
for sake of putting an answer, your second pass can be written concisely:
strm = OpenRead[fname];
ByteIndx=Reap[While[Sow[StreamPosition[strm]]; !TrueQ[Read[strm ] == EndOfFile]]][[2,1,;;-2]]
n=Length[ByteIndx]
I'm trying to solve the following problem using Mathematica:
What is the smallest positive integer not obtainable from the set {2,3,4,5,6,7,8} via arithmetic operations {+,-,*,/}, exponentiation, and parentheses. Each number in the set must be used exactly once. Unary operations are NOT allowed (1 cannot be converted to -1 with without using a 0, for example).
For example, the number 1073741824000000000000000 is obtainable via (((3+2)*(5+4))/6)^(8+7).
I am a beginner with Mathematica. I have written code that I believe solves the problems for the set {2,3,4,5,6,7} (I obtained 2249 as my answer), but my code is not efficient enough to work with the set {2,3,4,5,6,7,8}. (My code already takes 71 seconds to run on the set {2,3,4,5,6,7})
I would very much appreciate any tips or solutions to solving this harder problem with Mathematica, or general insights as to how I could speed my existing code.
My existing code uses a brute force, recursive approach:
(* this defines combinations for a set of 1 number as the set of that 1 number *)
combinations[list_ /; Length[list] == 1] := list
(* this tests whether it's ok to exponentiate two numbers including (somewhat) arbitrary restrictions to prevent overflow *)
oktoexponent[number1_, number2_] :=
If[number1 == 0, number2 >= 0,
If[number1 < 0,
(-number1)^number2 < 10000 \[And] IntegerQ[number2],
number1^number2 < 10000 \[And] IntegerQ[number2]]]
(* this takes a list and removes fractions with denominators greater than 100000 *)
cleanup[list_] := Select[list, Denominator[#] < 100000 &]
(* this defines combinations for a set of 2 numbers - and returns a set of all possible numbers obtained via applications of + - * / filtered by oktoexponent and cleanup rules *)
combinations[list_ /; Length[list] == 2 && Depth[list] == 2] :=
cleanup[DeleteCases[#, Null] &#DeleteDuplicates#
{list[[1]] + list[[2]],
list[[1]] - list[[2]],
list[[2]] - list[[1]],
list[[1]]*list[[2]],
If[oktoexponent[list[[1]], list[[2]]], list[[1]]^list[[2]],],
If[oktoexponent[list[[2]], list[[1]]], list[[2]]^list[[1]],],
If[list[[2]] != 0, list[[1]]/list[[2]],],
If[list[[1]] != 0, list[[2]]/list[[1]],]}]
(* this extends combinations to work with sets of sets *)
combinations[
list_ /; Length[list] == 2 && Depth[list] == 3] :=
Module[{m, n, list1, list2},
list1 = list[[1]];
list2 = list[[2]];
m = Length[list1]; n = Length[list2];
cleanup[
DeleteDuplicates#
Flatten#Table[
combinations[{list1[[i]], list2[[j]]}], {i, m}, {j, n}]]]
(* for a given set, partition returns the set of all partitions into two non-empty subsets *)
partition[list_] := Module[{subsets},
subsets = Select[Subsets[list], # != {} && # != list &];
DeleteDuplicates#
Table[Sort#{subsets[[i]], Complement[list, subsets[[i]]]}, {i,
Length[subsets]}]]
(* this finally extends combinations to work with sets of any size *)
combinations[list_ /; Length[list] > 2] :=
Module[{partitions, k},
partitions = partition[list];
k = Length[partitions];
cleanup[Sort#
DeleteDuplicates#
Flatten#(combinations /#
Table[{combinations[partitions[[i]][[1]]],
combinations[partitions[[i]][[2]]]}, {i, k}])]]
Timing[desiredset = combinations[{2, 3, 4, 5, 6, 7}];]
{71.5454, Null}
Complement[
Range[1, 3000], #] &#(Cases[#, x_Integer /; x > 0 && x <= 3000] &#
desiredset)
{2249, 2258, 2327, 2509, 2517, 2654, 2789, 2817, 2841, 2857, 2990, 2998}
This is unhelpful, but I'm under my quota for useless babbling today:
(* it turns out the symbolizing + * is not that useful after all *)
f[x_,y_] = x+y
fm[x_,y_] = x-y
g[x_,y_] = x*y
gd[x_,y_] = x/y
(* power properties *)
h[h[a_,b_],c_] = h[a,b*c]
h[a_/b_,n_] = h[a,n]/h[b,n]
h[1,n_] = 1
(* expand simple powers only! *)
(* does this make things worse? *)
h[a_,2] = a*a
h[a_,3] = a*a*a
(* all symbols for two numbers *)
allsyms[x_,y_] := allsyms[x,y] =
DeleteDuplicates[Flatten[{f[x,y], fm[x,y], fm[y,x],
g[x,y], gd[x,y], gd[y,x], h[x,y], h[y,x]}]]
allsymops[s_,t_] := allsymops[s,t] =
DeleteDuplicates[Flatten[Outer[allsyms[#1,#2]&,s,t]]]
Clear[reach];
reach[{}] = {}
reach[{n_}] := reach[n] = {n}
reach[s_] := reach[s] = DeleteDuplicates[Flatten[
Table[allsymops[reach[i],reach[Complement[s,i]]],
{i,Complement[Subsets[s],{ {},s}]}]]]
The general idea here is to avoid calculating powers (which are
expensive and non-commutative), while at the same time using the
commutativity/associativity of addition/multiplication to reduce the
cardinality of reach[].
Code above also available at:
https://github.com/barrycarter/bcapps/blob/master/playground.m#L20
along with literally gigabytes of other useless code, data, and humor.
I think the answer to your question lays in the command Groupings. This allows you to create a binary tree of a list. The binary tree is very usefull as each of the operations you allow Plus, Subtract, Times, Divide, Power take two arguments. Eg.
In> Groupings[3,2]
Out> {List[List[1,2],3],List[1,List[2,3]]}
Thus all we need to do is replace List with any combination of the allowed operations.
However, Groupings seems to be almighty as it has an option to do this. Imagine you have two functions foo and bar and both take 2 arguments, then you can make all combinations as :
In> Groupings[3,{foo->2,bar->2}]
Out> {foo[foo[1,2],3],foo[1,foo[2,3]],foo[bar[1,2],3],foo[1,bar[2,3]],
bar[foo[1,2],3],bar[1,foo[2,3]],bar[bar[1,2],3],bar[1,bar[2,3]]}
Now it is possible to count the amount of combinations we have :
In> Groupings[Permutations[#],
{Plus->2,Subtract->2,Times->2,Divide->2,Power->2}
] &# {a,b,c,d,e};
In> Length#%
In> DeleteDuplicates#%%
In> Length#%
Out> 1050000
Out> 219352
This means that for 5 distinct numbers, we have 219352 unique combinations.
Sadly, many of these combinations cannot be evaluated due to overflow, division by zero or underflow. However, it is not evident which ones to remove. The value a^(b^(c^(d^e))) could be humongous, or just small. Fractional powers could result in perfect roots and divisions by large numbers can become perfect.
In> Groupings[Permutations[#],
{Plus->2,Subtract->2,Times->2,Divide->2,Power->2}
] &# {2, 3, 4};
In> Union[Cases[%, _?(IntegerQ[#] && # >= 0 &)]];
In> Split[%, #2 - #1 <= 1 &][[1]]
Out> {1, 2, 3, 4, 5, 6}
I am using usual for-loop for computation in Mathematica:
For[i=1,i<n+1,i++, ...calculation... ]
For each i I need to define a function F_i[x_,y_]:=.... Here "i" is suuposed to be a label of the function. This is however not the corrcet Mathematica expression.
The question is, how to define multiple functions distinguished by the label i? I mean, what is the correct syntax?
Thanks a lot.
I'm not exactly sure what you are trying to do, but I have some confidence that the for loop is not the way to go in Mathematica. Mathematica already has pattern matching that likely eliminates the need for the loop.
What about something like this
f[i_][x_,y_]:= i(x+y)
or something like this
f[s_String][x_,y_]:=StringLength[s](x+y)
or even
f[s_,x_,y_]:=StringLength[s](x+y)
Here are some steps which may help. There are two versions below, the second one includes the value of i on the RHS of the function definition.
n = 2;
For[i = 1, i < n + 1, i++,
f[i][x_, y_] := (x + y)*i]
?f
Global`f
f[1][x_,y_] := (x+y) i
f[2][x_,y_] := (x+y) i
Clear[i]
f[2][2, 3]
5 i
Quit[]
n = 2;
For[i = 1, i < n + 1, i++,
With[{j = i},
f[i][x_, y_] := (x + y)*j]]
?f
Global`f
f[1][x$,y$] := (x$+y$) 1
f[2][x$,y$] := (x$+y$) 2
Clear[i]
f[2][2, 3]
10
I am writing a debug function, which prints a variable name, and its value. I call this debug function with a list of variables from anywhere in the program. So the idea is for it to work like this:
debug[var_List] := Module[{values = ReleaseHold[var], i},
For[i = 1, i <= Length[values], i++,
Print[var[[i]], " = ", values[[i]]]
]
];
Now I use the above, like this
x = 3; y = 5;
debug[{HoldForm[x], HoldForm[y]}]
and I see in the console the following
x = 3
y = 5
But I have a large program and long list of variables at different places I want to debug. And I do not want to type HoldForm to each variable to make up the list to call the debug[] function. Much easier to Map it if possible. Less typing each time. But this does not work:
debug[ Map[HoldForm,{x,y}]]
The reason is that {x,y} was evaluated before HoldForm got hold of it. So I end up with a list that has the values in it, like this:
3 = 3
5 = 5
I could not find a way to Map HoldForm without the list being evaluated.
The best I could find is this:
debug[HoldForm[Defer[{x, y}]]]
which gives the following output from the above debug[] function:
{x,y} = {3,5}
Since Defer[{x, y}] has length 1, and it is just one thing, I could not break it up to make a 2 column list like in the above example.
It will be better if I can get an output of the form
x = 3
y = 5
easier to match the variable with its value since I have many variables.
question is: Any one knows of a programming trick to convert HoldForm[{x,y}] to {HoldForm[x],HoldForm[y]}
thanks
Just use Thread:
Thread[HoldForm[{x, y}]]
alternatively,
Map[HoldForm, Unevaluated[{x, y}]]
Here is a longer alternative demonstrating use of Hold, found in Roman Maeder's Programming In Mathematica (3rd ed.), page 137:
e1 = Hold[{x, y}];
e2 = MapAt[Hold, e1, {1, 0}];
e3 = Map[HoldForm, e2, {2}];
e4 = MapAt[ReleaseHold, First[e3], {0}];
debug[e4]
x=3
y=5
I did a PrintIt function using attributes that does what you want. I posted it here https://stackoverflow.com/a/8270643/884752, I repeat the code:
SetAttributes[System`ShowIt, HoldAll];
System`ShowIt[code__] := System`ShowIt[{code}];
System`ShowIt[code_] :=
With[{y = code},
Print[Defer[code = y]];
y
];
SetAttributes[System`PrintIt, {HoldAll,Listable}];
System`PrintIt[expr__]:=System`PrintIt[{expr}];
System`PrintIt[expr_] := System`ShowIt[expr];