mm-969
===
Subject: Re: Animation of a rotating object. (Mathematica 6)
Hello David.
> With animation you almost always have to specify PlotRange (as you did) 
to
> prevent 'frame jitter'.
 To zoom in on the object use PlotRegion (in a somewhat unconventional
> manner).
This is just what I was looking for! It would be nice to have a more
easy way, but I suppose it will do the trick.
===
Subject: Re: Plot, Epilog, and Text
>Re 6.0.1 under WinXP.
>Why does the first Plot fail but not the second?
>They seem equivalent:  the former simply uses a function to
>implement the Text command that is explicit in the second Plot.
>f=PDF[NormalDistribution[3,Sqrt[6]],x];
>g[X_String,w_Real,f_]:=Text[Style[X,12,Bold],{w,f/.{x->w}},{0,-2}];
Clear@x;
>Plot[f,{x,-40,40},PlotRange->All,Epilog->{g[X,3,f]}]
>Plot[f,{x,-40,40},PlotRange->All,Epilog->{Text[Style[X,12,Bold],{3
>,f/.{x->3}}]}]
There are two issues that make things different.
First, the second argument to your function g is specified to be 
a Real but when you use it you supply an Integer. That causes g 
to be unevaluated which produces an error.
Second, your function g supplies a third argument to Text, i.e., 
{0,-2} which is an offset outside the range of the bounding rectangle.
Changing the definition of g to be
g[X_String,w_,f_]:=Text[Style[X,12,Bold],{w,f/.{x->w}}]
Will cause both Plot commands to produce the same graphic
--
To reply via email subtract one hundred and four
===
Subject: Re:  PSLQ
> I am trying to use Peter Bertok's PSLQ algorithm at
 http://library.wolfram.com/infocenter/MathSource/4263/
 to check for linear relations between logarithms, but it is not
> working properly.
 If I do
 PSLQ[N[{Log[3/2], -Log[2], -Log[4/3]}, 200], 200]
 , the program correctly outputs
> {1, 1, -1}.
 However, if I try
 PSLQ[N[{Log[3/2], -Log[5], -Log[4/3]}, 200], 200]
 , instead of outputting a set of three large integers which would give
> a linear relation equalling zero correct to 10^(-200)
> (which I could interpret to mean there was no true linear
> relationship, because of the size of the integers),
> it outputs a string of error messages.
 Can anyone tell me how to tweak this program to eliminate these
> errors?
 Failing that, is there another Mathematica implementation of PSLQ
> which would do the same thing?
 I have searched the archive and there was a link to a Mathematica
> program by David Bailey, but the link no longer works.

> Jimmy Mc Laughlin
 PS Please reply also to my e-mail address
> Clashton@gmail.com
I suspect that Bertok code is doing roughly as it should. In general PSLQ
just runs out of precision, so to speak, and has to give up, when there
is no reasonable candidate relation. If you in fact want to see huge
multipliers, you can get that effect using lattice reduction methods. But
I suspect you just want a graceful failure mode.
well, not so good. I give the code below, with the caveat that it is as
is. It might or might not find your desired integer relations. Don't
expect it to find you amorous relations, or wealthy distant relations. I
simply offer it as an alternative to what you already have, on the off
chance that it might be of use. Feel free to improve on it in any way you
like (and if it starts finding wealthy distant relations, I'd like to hear
about that).
I no longer recall how this stuff works. My only comment on the actual
code is that the value 'const' can be made into a parameter for this
algorithm; it is equivalent to lambda^2 from PSLQ literature.
badNum[n_?
   NumberQ] := (n == 0 && Accuracy[n] < 3) || (n != 0 &&
    Precision[n] < 4)
vectorNumberQ[vec_?VectorQ] /; Length[vec] != 0 :=
 Apply[Or, Map[NumberQ, vec]]
vectorNumberQ[_] := False
innerProduct[v1_, v2_, False] := v1.v2
innerProduct[v1_, v2_, True] := v1.Conjugate[v2]
normSquare[vec_, cmplx_: False] := innerProduct[vec, vec, cmplx]
norm[vec_, cmplx_: False] := Sqrt[normSquare[vec, cmplx]]
reduceH[ohh_, len_, start_, mat_, inv_, iter_] :=
 Module[{j, k, r, hh = ohh, newmat = mat, newinv = inv, bad = False},
  For[j = start, j <= len, j++,
   For[k = If[iter == 0, j - 1, Min[j - 1, start]], k > 0, k--,
     r = If[hh[[k, k]] != 0, Round[hh[[j, k]]/hh[[k, k]]], 0];
     If[r != 0, For[m = 1, m <= k, m++, hh[[j, m]] -= r*hh[[k, m]];
       If[hh[[j, m]] == 0, hh[[j, m]] = 0];
       bad = bad || badNum[hh[[j, m]]];];
      newmat[[j]] -= r*newmat[[k]];
      newinv[[k]] += r*newinv[[j]];];];];
  {newmat, newinv, hh, bad}]
Corner[ohh_, j_, len_] :=
 Module[{hh = ohh, a = ohh[[j + 1, j]], b = ohh[[j, j]],
   c = ohh[[j, j + 1]], bstar, cstar, d, k, m1, m2, m3, m4, tmp},
  bstar = Conjugate[b];
  cstar = Conjugate[c];
  d = Sqrt[b*bstar + c*cstar];
  m1 = bstar/d;
  m2 = -c/d;
  m3 = cstar/d;
  m4 = b/d;
  hh[[{j, j + 1}, {j, j + 1}]] = {{d, 0}, {a*m1, a*m2}};
  For[k = j + 2, k <= len, k++, tmp = hh[[k, j]];
   hh[[k, j]] = hh[[k, j]]*m1 + hh[[k, j + 1]]*m3;
   hh[[k, j + 1]] = tmp*m2 + hh[[k, j + 1]]*m4;];
  hh]
PSLQ[ovec_?VectorQ] /; vectorNumberQ[ovec] :=
 Module[{cmplx = ! FreeQ[ovec, Complex], len = Length[ovec], mat, hh,
   savevec, inv, s, prec, j, k, eps, tau, best, bestj = 1, value,
   usevec, vecs, vec, bad, const, qq, rr, iter = 0, orighh, newmat,
   oldmat, oldinv},
  prec = Internal`EffectivePrecision[ovec];
  savevec = SetPrecision[ovec, prec];
  savevec = savevec/norm[savevec, cmplx];
  eps = 10^(-1.5*prec/len);
  mat = IdentityMatrix[len];
  inv = IdentityMatrix[len];
  {qq, rr} = QRDecomposition[Transpose[Prepend[mat, savevec]]];
  hh = SetPrecision[Drop[Transpose[Drop[rr, 1]], 1], prec];
  orighh = hh;
  const = If[cmplx, 4, 2];
  While[True,
   {mat, inv, hh, bad} = reduceH[hh, len, bestj + 1, mat, inv, iter];
   iter++;
   For[s = 1, s < len, s++, bad = bad || badNum[hh[[s, s]]]];
   If[bad, bad = False;
    newmat = mat.orighh;
    If[Internal`EffectivePrecision[newmat] <= $MachinePrecisi on,
     newmat = SetPrecision[newmat, 2*$MachinePrecisio n];];
    {qq, rr} = QRDecomposition[Transpose[newmat]];
    hh = Transpose[rr];
    bad = Apply[Or, Map[badNum, Flatten[hh]]];
    If[bad, Return[$Failed]];
    If[Dimensions[hh] =!= {len, len - 1}, Return[$Failed]];
    ];
   For[s = 1, s < len, s++, If[hh[[s, s]] == 0, Break[]]];
   If[s < len, Return[Last[inv]]];
   For[j = 1, j < len, j++, If[Abs[hh[[j, j]]] > eps, Break[]]];
   If[j == len, Return[$F ailed]];
   best = 0;
   tau = 1;
   For[j = 1, j < s, j++, value = tau*Abs[hh[[j, j]]];
    If[value > best, best = value; bestj = j];
    tau *= const;];
   mat[[{bestj, bestj + 1}]] = mat[[{bestj + 1, bestj}]];
   inv[[{bestj, bestj + 1}]] = inv[[{bestj + 1, bestj}]];
   hh[[{bestj, bestj + 1}]] = hh[[{bestj + 1, bestj}]];
   If[bestj < len - 1, hh = Corner[hh, bestj, len]];
  ];
 ]
Your examples:
In[159]:= Timing[PSLQ[N[{Log[3/2], -Log[2], -Log[4/3]}, 200]]]
Out[159]= {0.01, {1, 1, -1}}
In[161]:= Timing[PSLQ[N[{Log[3/2], -Log[5], -Log[4/3]}, 200]]]
Out[161]= {0.431, $Failed}
Daniel Lichtblau
Wolfram Research
===
Subject: Re:  rotating rings illusion
[Rho] below should be r.  Evidently a change of notation along the way!
 I have a solution that works in Mathematica 6; first of all, create a 
torus
> with Radii R and r:
 R = 1;
> r = 0.1;
 torus = ParametricPlot3D[{(R + r Cos[2 [Pi] u])
>     Cos[2 [Pi] t], (R + r Cos[2 [Pi] u]) Sin[2 [Pi] t],
>    r Sin[2 [Pi] u]}, {u, 0, 1}, {t, 0, 1}, Mesh -> None]
 then rotate the torus by an angle Theta in the horizontal plane to create
> ring1; rotate ring 1 180 degrees around the vertical axis and translate 
it
> by the adequate amount in the vertical direction; create a graphic adding
> them (rings):
 [Theta] = 10 Degree;
 ring1 = Graphics3D[Rotate[torus[[1]], [Theta], {1, 0, 0}]];
> ring2 = Graphics3D[
>    Translate[
>     Rotate[ring1[[1]], 180 Degree, {0, 0, 1}], {0, 0,
>      2 (R Sin[[Theta]] + [Rho])}]];
> rings = Show[{ring1, ring2}, Boxed -> False, SphericalRegion -> True]
 Finally, using manipulate, rotate the graphic ringsalong the vertical
> axis:
 Manipulate[
>  Graphics3D[Rotate[rings[[1]], 2 [Pi] [Theta], {0, 0, 1}],
>   Boxed -> False], {[Theta], 0, 1, 0.02}]
 
> With the above parametrization, if you change  the variables R, r and 
Theta,
> the rings will always touch.
 Ricardo Samad
 
>    i'm just starting to use mathematica...
>> i'm trying to mathematically model the two rotating rings illusion as
>> shown
>> in this video:
>> 1)  how do you create a ring in mathematica?  i found the circle 
command,
>> but that's only 2d.
>> 2)  how can I orient each ring so that they're perpendicular to each
>> other?
>> 3)  how do I vary the # of rotations per minute in an animation?
>> much obliged,
>> imran
 
> --
> ____________________________________
> Ricardo Elgul Samad
 tel: (+55 11) 3816-9314
> fax: (+55 11) 3816-9315
 Centro de Lasers e Aplica=E7=F5es
> IPEN/CNEN-SP
> AV. Prof. Lineu Prestes 2242
> Cidade Universit=E1ria
> 05508-000
> S=E3o Paulo - SP
> Brazil
> ____________________________________
 
-- 
Murray Eisenberg                     murray@math.umass.edu
Mathematics & Statistics Dept.
Lederle Graduate Research Tower      phone 413 549-1020 (H)
University of Massachusetts                413 545-2859 (W)
710 North Pleasant Street            fax   413 545-1801
Amherst, MA 01003-9305
===
Subject: Re: StringCases kills Kernel
Hi Wim,
please execute:
s= StringJoin[Table[0123456789, {10^5}]];
StringCases[s, RegularExpression[(0123456789)+] ];
or
s= StringJoin[Table[0123456789, {10^5}]];
StringCases[s, 0123456789 .. )];
I then  hear a beep, and clicking Help/Why the Beep? I am told  that 
the kernel was killed.
If this does not happen in your case, it may be  that it depends on the 
Daniel
> Hi Wim,
 you have to execute both statements. The first one gives s a value.
 Daniel
 
 
>> Hi Daniel,
> I tried the example in version 6. The 
> following warning was displayed:
> String or list of strings expected at 
> position 1 in 
> StringCases[s,RegularExpression[!((0123456789)+)]]
> The Kernel wa's not killed.
> Wim W. Wilhelm
 
 
 
>> I often read a file into a string and 
>> use StringCases to extract
 
> relevant information. However, if the 
>> extracted part is too large, the
 
> kernel is killed. This happens in 
>> version 5 and 6. here is a simple
 
> example:
 
> s= StringJoin[Table[0123456789, 
>> {10^5}]];
 
> StringCases[s, 
>> RegularExpression[(0123456789)+] ];
 
> the same also happens when we use a 
>> StringPattern:
 
> StringCases[s3, 0123456789 ..];
 
> Daniel
 
 
 
 
> 
===
Subject: Re:  Re: Rule-based programming: declare variables to be a number
> As others have commented, it is not a good idea to write code like
> NumericQ[g]=True because this changes the basic operation of
> Mathematica. For example, such code might work OK until you try to
> combine it with some more code that needs NumericQ for something else!
 David Bailey
> http://www.dbaileyconsultancy.co.uk
Who are the others?
Anyway, I completely disagree with this statement in this particular  
context.
  NumericQ has clearly been designed with this in mind. Note, for  
example, that althou NumericQ is Protected, a definition like
NumericQ[a]=True
does not require unprotecting NumericQ. Moreover, it does not add a  
DownValue to NumericQ.
NumericQ[g] = True;
DownValues[NumericQ]
{}
There are plenty of other reasons to believe that all all  
theseproperties of NumericQ are designed precisely for this type of  
use. Besides, I have another reason to think that no probems of the  
kind you are imagining would happen in this case: I have been using  
NumericQ inprecisly this way for about 10 years in numerous notebooks  
without any problems.
Note alo the post from Carl Woll which, I think, can be regarded as  
an offcial WRI authorization for this kind of usage ;-)
(However, note also that using Carl's definition:
In[19]:= g /: NumericQ[g] = True;
Dos not actually add an UpValue to g:
UpValues[g]
{}
and I don't think it has any advantage over the more straightforward
NumericQ[g] = True;
I am sure all this is deliberate design, and even though it may not  
be easy to explain, it is very convenient.
Andrzej Kozlowski
===
Subject: Re: Limits of Nested Expressions
 > Is it possible to compute the following limit in Mathematica 6?
> Limit[Nest[Sqrt[5 + #]&, 5, n], n -> Infinity]
 > It used to be possible through Calculus`Limit package, which seems to
> be gone
 Hi.
 I think the others covered your query.
> Just a side remark, I suggest you to read
> the following thread, based on a old but similar
> question of mine.
 Dimitris
Ooops!
I forgot the link...
Voila:
Dimitris
===
Subject: Re: date format
year, month, day, etc which puts the least significant value 
on the right, just like most other numbering systems. I've 
always wondered why most people don't use this simple 
convention for dates.  I believe it is the SI standard 
format. Amazingly, various branches of the USA gov are 
beginning to do this-- slowly. Today would be 2007 Sept. 02.
> Hi Arek,
 try:
 
> hope this helps, Daniel
 
 
 
 
>>Form the following date format
 
>04/Dec/2006:19:54:02
 
>could you please show me how to get the following representation {day,
 
>>month, year, hour, minutes, seconds} - so exactly the same as for
 
 
 
 
>>Arek
 
 
 
===
Subject: Re:  Plot, Epilog, and Text
I find here two problems:
1. The second argument of g is expected to have head Real, while you call 
it
with the EXACT NUMBER 3 that has a head Integer, so g is not evaluated. 
This
can be solved by either
1. Calling g with 3.0 (or 3.) and not 3
2. define g as g[X_String,w_(Real|Integer),f_]:=...
or
3. define g as g[X_String,w_?NumberQ,f_]:=...
after fixing this, the PlotRange->All in the first example is not tall
enough to show the required X string so you need to move from All to 
more
sepecific value for the vertical axis
yehuda
 Re 6.0.1 under WinXP.
 Why does the first Plot fail but not the second?
 They seem equivalent:  the former simply uses a function to implement the
> Text command that is explicit in the second Plot.

> Bruce
 f=PDF[NormalDistribution[3,Sqrt[6]],x];
> g[X_String,w_Real,f_]:=Text[Style[X,12,Bold],{w,f/.{x->w}},{0,-2}];
 Clear@x;
> Plot[f,{x,-40,40},PlotRange->All,Epilog->{g[X,3,f]}]

> 
Plot[f,{x,-40,40},PlotRange->All,Epilog->{Text[Style[X,12,Bold],{3,f/.{x-
>3}}]}]

>
===
Subject: Re: Plot, Epilog, and Text
> g[X_String,w_Real,f_]:=Text[Style[X,12,Bold],{w,f/.{x->w}},{0,-2}];
Among other things, you'll need to replace _Real with _?NumberQ.  3
does not have a head of Real.
Also, because Plot has Attributes[Plot] = {HoldAll,...}, you'll need
to wrap Epilog->{g...} in Evaluate to make sure g gets replaced by the
correct value.
At this point, if you put //Trace after each version of the Plot
command, you can see that both end up evaluating the same thing. And
both do produce the correct plot.
Hope this helps.
-Richard
===
Subject: Re: Plot, Epilog, and Text
You specified that the second argument must be a Real.  But there is another 

surprise. PlotRange -> All does not appear to take into account anything in 

Epilog.
f = PDF[NormalDistribution[3, Sqrt[6]], x];
g[X_String, w_Real, f_] :=
  Text[Style[X, 12, Bold], {w, f /. {x -> w}}, {0, -2}];
Plot[f,{x,-40,40},
PlotRange->All,
Epilog->{g[X,3.,f]}]
Plot[f, {x, -40, 40},
 PlotRange -> {0, 0.2},
 Epilog -> {g[X, 3., f]}]
In your second example you did not specify an offset for the Text material 
so the X did appear in the plot.
Plot[f, {x, -40, 40}, PlotRange -> All,
 Epilog -> {Text[Style[X, 12, Bold], {3, f /. {x -> 3}}]}]
Here is a second example of Epilog not affecting the plot range.
Plot[Sin[x], {x, 0, 2 Pi},
 AspectRatio -> Automatic,
 Epilog -> Circle[{3, 3}],
 PlotRange -> All]
Plot[Sin[x], {x, 0, 2 Pi},
 AspectRatio -> Automatic,
 Epilog -> Circle[{3, 3}],
 PlotRange -> {-1.1, 4.1}]
-- 
David Park
djmpark@comcast.net
http://home.comcast.net/~djmpark/
> Re 6.0.1 under WinXP.
 Why does the first Plot fail but not the second?
 They seem equivalent:  the former simply uses a function to implement the 

> Text command that is explicit in the second Plot.

> Bruce
 f=PDF[NormalDistribution[3,Sqrt[6]],x];
> g[X_String,w_Real,f_]:=Text[Style[X,12,Bold],{w,f/.{x->w}},{0,-2}];
 Clear@x;
> Plot[f,{x,-40,40},PlotRange->All,Epilog->{g[X,3,f]}]
 
Plot[f,{x,-40,40},PlotRange->All,Epilog->{Text[Style[X,12,Bold],{3,f/.{x-
>3}}]}]
 
===
Subject: Re: Plot, Epilog, and Text
3 is not a Real number, so you either have to
(1) call g as follows g[X,3.,f]
or
(2) define g as follows g[X_String, w_?NumericQ, f_]
Derek
===
Subject: Re:  Plot, Epilog, and Text
Bruce,
Your pattern for g includes w_Real, but in the plot you passed an Integer  
(3) in that position. You could pass 3.0 instead, or you can change the  
definition to
g[X_String, w_?NumericQ, f_] :=
  Text[Style[X, 12, Bold], {w, f /. {x -> w}}, {0, -2}]
or even
g[X_String, w_, f_] :=
  Text[Style[X, 12, Bold], {w, f /. {x -> w}}, {0, -2}]
Bobby
> Re 6.0.1 under WinXP.
> Why does the first Plot fail but not the second?
 They seem equivalent:  the former simply uses a function to implement  
> the Text command that is explicit in the second Plot.

> Bruce
 f=PDF[NormalDistribution[3,Sqrt[6]],x];
> g[X_String,w_Real,f_]:=Text[Style[X,12,Bold],{w,f/.{x->w}},{0,-2}];
 Clear@x;
> Plot[f,{x,-40,40},PlotRange->All,Epilog->{g[X,3,f]}]
 
Plot[f,{x,-40,40},PlotRange->All,Epilog->{Text[Style[X,12,Bold],{3,f/.{x-
>3}}]}]

>
-- 
DrMajorBob@bigfoot.com
===
Subject: Re: Plot, Epilog, and Text
> Re 6.0.1 under WinXP.
>  
> Why does the first Plot fail but not the second?  
 They seem equivalent:  the former simply uses a function to implement the 
Text command that is explicit in the second Plot.
 
> Bruce
 f=PDF[NormalDistribution[3,Sqrt[6]],x];
> g[X_String,w_Real,f_]:=Text[Style[X,12,Bold],{w,f/.{x->w}},{0,-2}];
 Clear@x;
> Plot[f,{x,-40,40},PlotRange->All,Epilog->{g[X,3,f]}]
 
Plot[f,{x,-40,40},PlotRange->All,Epilog->{Text[Style[X,12,Bold],{3,f/.{x-
>3}}]}]
3 is not a Real, but an Integer, so g[X,3,f] does not match 
g[X_String, w_Real, f_].  Just use g[x_String, w_?NumericQ, f_] in the 
function definition.
Szabolcs
===
Subject: Re: Plot, Epilog, and Text
> Re 6.0.1 under WinXP.
 Why does the first Plot fail but not the second?
 They seem equivalent:  the former simply uses a function to implement the 
Text command that is explicit in the second Plot.

> Bruce
 f=PDF[NormalDistribution[3,Sqrt[6]],x];
> g[X_String,w_Real,f_]:=Text[Style[X,12,Bold],{w,f/.{x->w}},{0,-2}];
 Clear@x;
> Plot[f,{x,-40,40},PlotRange->All,Epilog->{g[X,3,f]}]
 
Plot[f,{x,-40,40},PlotRange->All,Epilog->{Text[Style[X,12,Bold],{3,f/.{x-
>3}}]}]
3 is not Real. The easiest fix is to use plain w_ instead of w_Real
in the definition of g.
===
Subject: Re:  check inside a loop?
For the specific example you posted, first using f[x_]=  rather then 
f[x_]:=
forces Mathematica to evaluate the right hand side of the definition at the
time of definition of f, and it is replaced by Csc[x] which does not return
an error message. It returns ComplexInfinity without the message. In
addition, use Pi with capital P
Next, For and Do loops DO NOT return values. you need to use some sort of
breaking mechanism or collect the values of i when the error is generated,
for example, Catch and Throw (breaks at the first error) or Reap and Sow
(collect all errors)
Reap[Do[If[Check[f[i], zzz] == zzz, Sow[i]], {i, 0, 2,
    1/4}]] // Rest
or
Catch[Do[If[Check[f[i], zzz] == zzz, Throw[i]], {i, 0, 2, 1/4}]]
yehuda
 I have a large loop that is ndsolving/nintegrating a bunch of things, and
> a
> lot of the results give me various errors due to the equations not being
> very nice.  I'd like to have a way to check what values of my paramaters
> are
> causing the errors, but I can't find a way to do that inside a loop.
 For example, if I have something like,
> f[x_] = 1/Sin[2 pi x]
 For[ i=1, i < 1000, i++,
> f[i]
> ]
 I'm going to get a lot of Power::infy: Infinite expression 1/0
> encountered. errors.  I'd like to see what values of i these occur at.
 I've tried something like
 For[ i=1, i<1000, i++,
> Check[ f[i] , i]
> ]
 But this just returns Power::infy: Infinite expression 1/0 
encountered.
> errors without the i vaule, which is different than I get by evaluating
> something like
> Check[ f[0],0]
> Which returns:
> Power::infy: Infinite expression 1/0 encountered.
> 0
 Is there any way I can get it to return the index that the error occured
> at
> for every error that occurs inside of the loop?

>
===
Subject: Re:  is there a better way to do constraint logic
 simplified constraint programming example in Mathematica:
 find a set of numbers that add to a particular value - numbers cannot be
> the same
 note  huge timing problem as we go up in variables
 Above 5, it hung...

> I was really hoping Mathematica had a decent constraint solver, but not
> sure
> now!!
 ----

> sumgroup[num_] := (vars =
> Flatten @ Table[ ToExpression[x <> ToString[i]], {i, 1, num}] ;
> r1 = And @@ Map[( 0 < # < 10) & , vars]; Print [r1];
> r2 = ( Plus @@ vars) == Round[ 9 num /2]; Print [r2];
> r3 = And @@ Rest @Union @
> Flatten @ Table[vars[[i]] != vars[[j]], {i, 1, num}, {j, i, num}] ;
> Print[r3];
> tim = Timing[FindInstance[r1 && r2 && r3, vars, Integers]];
> Print[tim] ; Print[]);

 For[ nn = 2, nn < 6, nn++, sumgroup[nn]]

 0 < x1 < 10 && 0 < x2 < 10
> x1 + x2 == 9
> x1 != x2
> {5.42101*10^-19, {{x1 -> 1, x2 -> 8}}}
 0 < x1 < 10 && 0 < x2 < 10 && 0 < x3 < 10
> x1 + x2 + x3 == 14
> x1 != x2 && x1 != x3 && x2 != x3
> {5.42101*10^-19, {{x1 -> 1, x2 -> 4, x3 -> 9}}}
 0 < x1 < 10 && 0 < x2 < 10 && 0 < x3 < 10 && 0 < x4 < 10
> x1 + x2 + x3 + x4 == 18
> x1 != x2 && x1 != x3 && x1 != x4 && x2 != x3 && x2 != x4 && x3 =
> != x4
> {0.094, {{x1 -> 2, x2 -> 3, x3 -> 4, x4 -> 9}}}
 0 < x1 < 10 && 0 < x2 < 10 && 0 < x3 < 10 && 0 < x4 < 10 && 0 < x5 < 10
> x1 + x2 + x3 + x4 + x5 == 22
> x1 != x2 && x1 != x3 && x1 != x4 && x1 != x5 && x2 != x3 && x2 =
> != x4 &&
> x2 != x5 && x3 != x4 && x3 != x5 && x4 != x5
> {33.062, {{x1 -> 1, x2 -> 2, x3 -> 3, x4 -> 7, x5 -> 9}}}
> 

I'd use FindInstance but set it up differently, to take advantage of some
integer linear programming (ILP) capabilities. Use a variable for each
digit value (1-9, in your examples). Restrict variable to take on only
values 0 and 1 (more on this below). Multiply variable by corresponding
digit, enforce that sum is what you want it to be. Also insist sum of
variables gives the cardinality of the allowable subsets.
To constrain variables in an ILP setting, use an inequality making each be
between 0 and 1 inclusive. Then specify that we work over integers.
In[21]:= len = 6;
dlen = 9;
vals = Range[dlen];
vars = Array[a, dlen];
b = Round[len*dlen/2];
constraints = Map[0 <= # <= 1 &, vars];
eqns = {Total[vars] == len, vars.vals == b}
Out[27]= {a[1] + a[2] + a[3] + a[4] + a[5] + a[6] + a[7] + a[8] +
   a[9] == 6,
 a[1] + 2 a[2] + 3 a[3] + 4 a[4] + 5 a[5] + 6 a[6] + 7 a[7] +
   8 a[8] + 9 a[9] == 27}
Now a FindInstance invocation, and minor postprocessing, gives a solution.
In[35]:= (vars*vals) /.
  First[FindInstance[Flatten[{eqns, constraints}], vars, Integers]] /.
 0 -> Sequence[]
Out[35]= {2, 3, 4, 5, 6, 7}
Note that one can get more solutions (all of them, for example) by using
Reduce instead of FindInstance. The postprocessing will be a bit
different.
So that is one approach. One can also tackle this as a subset sum problem.
This is a bit dicey insofar as there is no guarantee of finding a solution
even if one exists. With some monkeying around I was able to get various
examples to yield solutions but I am not sure I could make that always
happen.
The code below, which requires a bit more explanation than I am willing to
conjure, does the job for the example I show.
len = 6;
dlen = 9;
mult = 1;
v1 = 4*Range[dlen];
v2 = Table[1, {dlen}];
v3 = Table[0, {dlen}];
m1 = 2*IdentityMatrix[dlen];
m2 = Transpose[Join[{v1, v2}, m1, {v3}]];
v3 = Table[-1, {dlen + 3}];
v3[[{1, 2, -1}]] = -{Round[2*9*len], len, -1/mult}; lat =
 mult*Append[m2, v3]
In[97]:= redlat = LatticeReduce[lat]
Out[97]= {{0, -1, -2, -2, 2, 0, 0, 0, 0, 0, 0, 0}, {0, -1, -2, 0, -2,
  2, 0, 0, 0, 0, 0, 0}, {4, 1, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0,
  0, -2, 2, 2, -2, 0, 0, 0, 0, 0, 0}, {0, -1, -2, 0, 0, -2, 2, 0, 0,
  0, 0, 0}, {0, -1, -2, 0, 0, 0, -2, 2, 0, 0, 0, 0}, {0, 0, 1, 1,
  1, -1, 1, -1, 1, -1, 1, 1}, {0, -1, -2, 0, 0, 0, 0, -2, 2, 0, 0,
  0}, {0, -1, -1, 1, 1, -1, 1, -1, -1, 1, 1, 1}, {0, 0, -1, -1, -1, 1,
   1, -1, -1, -1, 1, -1}}
Notice there are rows with zeros in columns 1 and 2, and +-1 in the last
column. These are rows that correspond to solving the two required
equations (sum of values is correct and we use the allowable number of
digits, though allowing multiplicity). We use some postprocessing to cull
out these contenders, check that they use exactly one of each digit, and
form the solutions thus provided.
In[103]:=
keep1 = Map[#*Last[#] &, keep];
keep2 = keep1 /. -1 -> 0;
keep3 = Select[keep2, Apply[Times, # /. 0 -> 1] == 1 &];
keep4 = Map[Take[#, {3, -2}] &, keep3]
Out[107]= {{1, 1, 1, 0, 1, 0, 1, 0, 1}, {1, 1, 1, 0, 0, 1, 1, 1, 0}}
In[109]:= solns = Map[#*Range[dlen] &, keep4] /. 0 -> Sequence[]
Out[109]= {{1, 2, 3, 5, 7, 9}, {1, 2, 3, 6, 7, 8}}
Daniel Lichtblau
Wolfram Research