How to obtain a fixed number of solutions to $x+y=1$?

Question

How to obtain a fixed number of solutions to $x+y=1$?

For example, I want 4 solutions:

$(1,0),(2,-1),(3,-2),(-2,3)$

I want to do this also on bigger equations such as $x+y+...=1$ and then I want to plot these values on a graph. I need help only on obtaining these solutions, I've tried to do it with Solve but I've been unable to do so.

Notice that I can do it using Loops, I'm just checking if there's a viable way through the use of Solve or another built-in function.

Answer 1

{x, y} /. FindInstance[x + y == 1, {x, y}, Integers, 4]

{{-168, 169}, {66, -65}, {134, -133}, {199, -198}}

Generally define:

sol[n_] := {x, y} /. FindInstance[x + y == 1, {x, y}, Integers, n]

ListLinePlot[sol[17], Mesh -> All, MeshStyle -> Directive[Red, PointSize[.02]]]

If you would like to control the range of your random solutions and get exact number of solutions you can define a function like:

solr[n_, a_, b_] := {#, First[x /. Solve[x + # == 1]]} & /@ RandomSample[Range[a, b], n]

or if your equation will be always that simple, then

solr[n_, a_, b_] := {#, 1 - #} & /@ RandomSample[Range[a, b], n]

where n < b - a so the usage gives

Partition[Table[

   ListLinePlot[solr[7, -3, 17], Mesh -> All, 
         MeshStyle -> Directive[Red, PointSize[.02]], Frame -> True, Axes -> False]

   , {9}], 3] // Grid

And the simplest case of 3D is

sol3D[n_] := {x, y, z} /. FindInstance[x + y + z == 1, {x, y, z}, Integers, n]

RR = 300; Show[ContourPlot3D[
  x + y + z == 1, {x, -RR, RR}, {y, -RR, RR}, {z, -RR, RR}, MeshStyle -> Opacity[.1], 
  ContourStyle -> Directive[Orange, Opacity[0.8], Specularity[White, 30]]],
 Graphics3D[{Red, PointSize[.02], Point[sol3D[5]]}, PlotRange -> All] ]

Answer 2

FindInstance[x + y == 1, {x, y}, Integers, 4]

{{x -> -168, y -> 169}, {x -> 66, y -> -65}, {x -> 134, y -> -133}, {x -> 199, y -> -198}}

or

Table[ Reduce[x + y == 1, {x, y}, Integers] /. {C[1] -> n}, {n, 4}]

{x == 1 && y == 0, x == 2 && y == -1, x == 3 && y == -2, x == 4 && y == -3}

or

Table[ Solve[x + y == 1, {x, y}, Integers] /. C[1] -> n, {n, 4}]

 {{{x -> 1, y -> 0}}, {{x -> 2, y -> -1}}, {{x -> 3, y -> -2}}, {{x -> 4, y -> -3}}}

We choose Solve to find all solutions in appropriate ranges : in 2D-case we find all integer solutions in the range {-5, 5} :

pt = Flatten[ Table[ Solve[ x + y == 1, {x, y}, Integers] /. C[1] -> n, {n, -5, 5}], 1];

and in 3D-case all solutions in the range {{-4, 4}, {-4, 4}}:

points = Flatten[ Table[ Solve[ x + y + z == 1, {x, y, z}, Integers] /. { C[1]->m, C[2]->k},
                         {m, -4, 4}, {k, -4, 4}], 2]

and a part of the results :

 {{x -> -4, y -> -4, z -> 9}, {x -> -4, y -> -3, z -> 8}, {x -> -4, y -> -2, z -> 7},
  {x -> -4, y -> -1, z -> 6}, {x -> -4, y -> 0, z -> 5}, {x -> -4, y -> 1, z -> 4},...,
  {x -> 4, y -> 2, z -> -5}, {x -> 4, y -> 3, z -> -6}, {x -> 4, y -> 4,   z -> -7}}

Edit

First we consider 2D-case :

Plot[ 1 - x, {x, -6, 6}, PlotStyle -> Thick, AspectRatio -> Automatic, 
                         Epilog -> {Red, PointSize[0.02], Point[pt[[All, All, 2]]]}]

And now the 3D case. We can use Show, Plot3D etc. with appropriate options, e.g. :

Show[
      Plot3D[ 1 - x - y, {x, -5, 5}, {y, -5, 5}, PlotStyle -> Opacity[0.55],
              RegionFunction -> Function[{x, y, z}, -5 < 1 - x - y < 5],
              ColorFunction -> ColorData["SunsetColors"]], 
      Graphics3D[{ Red, PointSize[0.015], Point[points[[All, All, 2]]]}], 
      BoxRatios -> Automatic ]

Answer 3

For $\sum _{k=1}^M x_k=1$, notice that:

$$\sum _{i=1}^n i-\sum _{j=1}^{M-n} j=1 \Leftrightarrow \sum _{i=1}^n i=1+\sum _{j=1}^{M-n} j=A\text{, (}1\leq n < M\text{)}$$

so IntegerPartitions on A and A-1 can be used to generate the solution set. For large $M$ it should be well efficient.

Take $M=10$ for example:

Module[{M = 10},
 Module[{A = 10, n = #, m = M - #},
     Outer[Join,
      IntegerPartitions[A, {n}],
      -IntegerPartitions[A - 1, {m}],
      1]
     ] & /@ Range[M - 1] //
  Flatten[#, 2] &
 ]

{{10, -1, -1, -1, -1, -1, -1, -1, -1, -1}, {9, 1, -2, -1, -1, -1, -1, -1, -1, -1}, {8, 2, -2, -1, -1, -1, -1, -1, -1, -1}, {7, 3, -2, -1, -1, -1, -1, -1, -1, -1}, {6, 4, -2, -1, -1, -1, -1, -1, -1, -1}, {5, 5, -2, -1, -1, -1, -1, -1, -1, -1}, {8, 1, 1, -3, -1, -1, -1, -1, -1, -1}, {8, 1, 1, -2, -2, -1, -1, -1, -1, -1}, {7, 2, 1, -3, -1, -1, -1, -1, -1, -1}, {7, 2, 1, -2, -2, -1, -1, -1, -1, -1}, <<134>>}

With an arbitrary A large enough, any size of solution set can be obtained.

Edit:

As the previous answers showed, for $M=3$ the solution set can be visualized as points on plane $x+y+z=1$. The following is the correspond graphics for different $A$:

solSet = Table[Module[{M = 3},
    Module[{n = #, m = M - #},
        Outer[Join,
         IntegerPartitions[A, {n}],
         -IntegerPartitions[A - 1, {m}],
         1]
        ] & /@ Range[M - 1] //
     Flatten[#, 2] &
    ], {A, 2, 20}];
Shallow[solSet, {5, 3}]

{{{1, 1, -1}}, {{3, -1, -1}, {2, 1, -2}}, {{4, -2, -1}, {3, 1, -3}, {2, 2, -3}}, <<16>>}

Module[{solSet = solSet, min, max},
 {min, max} = Through[{Min, Max}[Flatten@solSet]];
 Show[
  ContourPlot3D[x + y + z == 1,
   {x, min, max}, {y, min, max}, {z, min, max},
   MeshStyle -> GrayLevel[.9], BoundaryStyle -> GrayLevel[.6],
   ContourStyle -> None, PlotRange -> All, 
   AxesLabel -> (Style[#, 20, Red, Bold] & /@ {x, y, z})],
  Graphics3D[{PointSize[.015],
    MapIndexed[{
       ColorData["Rainbow"][(#2[[1]] - 1)/(Length[solSet] - 1)],
       Point[#1]} &, solSet]
    }, PlotRange -> All] ]
 ]

Same color corresponds to same $A$.

By taking permutations, more solution can be obtained:

Module[{solSet = solSet, min, max},
 {min, max} = Through[{Min, Max}[Flatten@solSet]];
 Show[
  ContourPlot3D[x + y + z == 1,
   {x, min, max}, {y, min, max}, {z, min, max},
   Mesh -> None, BoundaryStyle -> GrayLevel[.6],
   ContourStyle -> None, PlotRange -> All, 
   AxesLabel -> (Style[#, 20, Red, Bold] & /@ {x, y, z})],
  Graphics3D[{PointSize[.011],
    MapIndexed[{
       ColorData["Rainbow"][(#2[[1]] - 1)/(Length[solSet] - 1)],
       Point[Flatten[Permutations /@ #1, 1]]} &, solSet]
    }, PlotRange -> All]
  ]
 ]

Note the blank bands correspond to solutions containing $0$, which won't be considered by IntegerPartitions. (But it should be easy to construct them from solution set for $M=2$.)