Mdthbs

Cobb-Douglas production function with expenditures rather than units

Is there a difference between 「目を覚ます」　and　「目覚める」

Is there such thing as a "3-dimensional surface?"

"How do you solve a problem like Maria?"

Is a switch from R to Python worth it?

Are children a reason to be rejected for a job?

Unexpected route on a flight from USA to Europe

Can external light meter replace the need for push/pull?

Did Apollo leave poop on the moon?

Is this cheap "air conditioner" able to cool a room?

Why don't the open notes matter in guitar chords?

How can glass marbles naturally occur in a desert?

Can I enter a rental property without giving notice if I'm afraid a tenant may be hurt?

Does bottle color affect mold growth?

How to realistically deal with a shield user?

What city skyline is this picture of?

How would a family travel from Indiana to Texas in 1911?

Repeated! Factorials!

What does VB stand for?

Probably terminated or laid off soon; confront or not?

Does the United States guarantee any unique freedoms?

What can make Linux unresponsive for minutes when browsing certain websites?

Did silent film actors actually say their lines or did they simply improvise “dialogue” while being filmed?

Does the length of a password for Wi-Fi affect speed?

Game schedule where each player meets only once

Where does Documentation Center introduce the basics?Return only one numeric solution to equationintegrating with multiple indicator functions depending on each otherPiecewise function Syntax error only in debug modeWhere to look up information about some symbols, such as “,”, “[” and “]” (not string)?Where to find order of arguments for default functions

.everyoneloves__top-leaderboard:empty,.everyoneloves__mid-leaderboard:empty,.everyoneloves__bot-mid-leaderboard:empty{ margin-bottom:0;
}

2

2

$begingroup$

I am trying to generate a game schedule where $k$ players at the time, out of $n$ participants, meet in each game, but any player meets another player only once. In each game, with $k$ simultaneous players, the $k$ players compete against each other, there are no multi-player teams.

A 'raw and basic' method for a $(7,3)$-game is shown below, but there must be a more elegant way in Mathematica. It is not very customisable for a general $(n,k)$-game. TIA.

n = 7;

mat = Table[1, {x, n}, {y, n}];

For[i = 1, i <= n, i++,

 For[j = i + 1, j <= n, j++,

  For[k = j + 1, k <= n, k++,

   If[mat[[i,j]]*mat[[j,i]]*mat[[i,k]]*mat[[k,i]]*mat[[j,k]]*mat[[k,j]] == 1,

    p = {i, j, k};

    Print [p];

    mat[[i,j]] = 0;

    mat[[j,i]] = 0;

    mat[[i,k]] = 0;

    mat[[k,i]] = 0;

    mat[[j,k]] = 0;

    mat[[k,j]] = 0;

   ]

  ]

 ]

]

Result: {1,2,3}, {1,4,5}, {1,6,7}, {2,4,6}, {2,5,7}, {3,4,7}, {3,5,6}.

syntax

share|improve this question

asked 8 hours ago

mf67mf67

17566 bronze badges

$endgroup$

add a comment | 

2

2

$begingroup$

I am trying to generate a game schedule where $k$ players at the time, out of $n$ participants, meet in each game, but any player meets another player only once. In each game, with $k$ simultaneous players, the $k$ players compete against each other, there are no multi-player teams.

A 'raw and basic' method for a $(7,3)$-game is shown below, but there must be a more elegant way in Mathematica. It is not very customisable for a general $(n,k)$-game. TIA.

n = 7;

mat = Table[1, {x, n}, {y, n}];

For[i = 1, i <= n, i++,

 For[j = i + 1, j <= n, j++,

  For[k = j + 1, k <= n, k++,

   If[mat[[i,j]]*mat[[j,i]]*mat[[i,k]]*mat[[k,i]]*mat[[j,k]]*mat[[k,j]] == 1,

    p = {i, j, k};

    Print [p];

    mat[[i,j]] = 0;

    mat[[j,i]] = 0;

    mat[[i,k]] = 0;

    mat[[k,i]] = 0;

    mat[[j,k]] = 0;

    mat[[k,j]] = 0;

   ]

  ]

 ]

]

Result: {1,2,3}, {1,4,5}, {1,6,7}, {2,4,6}, {2,5,7}, {3,4,7}, {3,5,6}.

syntax

share|improve this question

asked 8 hours ago

mf67mf67

17566 bronze badges

$endgroup$

add a comment | 

$begingroup$

I am trying to generate a game schedule where $k$ players at the time, out of $n$ participants, meet in each game, but any player meets another player only once. In each game, with $k$ simultaneous players, the $k$ players compete against each other, there are no multi-player teams.

A 'raw and basic' method for a $(7,3)$-game is shown below, but there must be a more elegant way in Mathematica. It is not very customisable for a general $(n,k)$-game. TIA.

n = 7;

mat = Table[1, {x, n}, {y, n}];

For[i = 1, i <= n, i++,

 For[j = i + 1, j <= n, j++,

  For[k = j + 1, k <= n, k++,

   If[mat[[i,j]]*mat[[j,i]]*mat[[i,k]]*mat[[k,i]]*mat[[j,k]]*mat[[k,j]] == 1,

    p = {i, j, k};

    Print [p];

    mat[[i,j]] = 0;

    mat[[j,i]] = 0;

    mat[[i,k]] = 0;

    mat[[k,i]] = 0;

    mat[[j,k]] = 0;

    mat[[k,j]] = 0;

   ]

  ]

 ]

]

Result: {1,2,3}, {1,4,5}, {1,6,7}, {2,4,6}, {2,5,7}, {3,4,7}, {3,5,6}.

syntax

share|improve this question

asked 8 hours ago

mf67mf67

17566 bronze badges

$endgroup$

n = 7;

mat = Table[1, {x, n}, {y, n}];

For[i = 1, i <= n, i++,

 For[j = i + 1, j <= n, j++,

  For[k = j + 1, k <= n, k++,

   If[mat[[i,j]]*mat[[j,i]]*mat[[i,k]]*mat[[k,i]]*mat[[j,k]]*mat[[k,j]] == 1,

    p = {i, j, k};

    Print [p];

    mat[[i,j]] = 0;

    mat[[j,i]] = 0;

    mat[[i,k]] = 0;

    mat[[k,i]] = 0;

    mat[[j,k]] = 0;

    mat[[k,j]] = 0;

   ]

  ]

 ]

]

share|improve this question

asked 8 hours ago

mf67mf67

17566 bronze badges

share|improve this question

asked 8 hours ago

mf67mf67

17566 bronze badges

asked 8 hours ago

mf67mf67

17566 bronze badges

asked 8 hours ago

mf67mf67

17566 bronze badges

2 Answers
2

active

oldest

votes

6

$begingroup$

n = 7;

k = 3;



DeleteDuplicates[Subsets[Range @ n, {k}], Length[Intersection[##]] >= 2 &]

{{1, 2, 3}, {1, 4, 5}, {1, 6, 7}, {2, 4, 6}, {2, 5, 7}, {3, 4, 7}, {3, 5, 6}}

share|improve this answer

answered 7 hours ago

kglrkglr

209k1010 gold badges241241 silver badges478478 bronze badges

$endgroup$

• 
  
  
  

  
  

  
  
  
  
  
  

  
  $begingroup$
  Very compact and 'neat'. Could you please explain what it does? I tried to 'decompile' it but had no luck understanding some of the 'components'.
  $endgroup$
  – mf67
  6 hours ago
  

  
  
  
  


• 
  
  
  

  
  1
  

  
  
  
  
  
  

  
  $begingroup$
  @mf67, Subsets[Range @ n, {k}] gives all k-player games, a list of k-tuples , {g1,g2,...}. Scanning this list from left to right DeleteDuplicates step eliminates all games $g_k$ that contains two or more players from $g_j$ (for $j<k$).
  $endgroup$
  – kglr
  6 hours ago
  

  
  
  
  


• 
  
  
  

  
  

  
  
  
  
  
  

  
  $begingroup$
  I see. Much clearer now. The examples on the Mathematica help pages are often (too) short and do not display the more 'intricate' commands given on this site.
  $endgroup$
  – mf67
  5 hours ago
  

  
  
  
  

add a comment | 

1

$begingroup$

n = 7;

k = 3;

list all possible games:

g = Subsets[Range[n], {k}];

Find a maximal-size clique of games that don't overlap:

First@FindClique[AdjacencyGraph[Outer[Boole[Length[Intersection[##]] <= 1] &, g, g, 1]]]

(*    {1, 10, 15, 21, 24, 28, 29}    *)

Which games are these?

g[[%]]

(*    {{1, 2, 3}, {1, 4, 5}, {1, 6, 7}, {2, 4, 6}, {2, 5, 7}, {3, 4, 7}, {3, 5, 6}}    *)

This method gives the same result as @kglr's but is much slower, so I don't recommend using it. You can view it as a proof of the other method.

share|improve this answer

edited 6 hours ago

answered 7 hours ago

RomanRoman

15.2k11 gold badge2121 silver badges5252 bronze badges

$endgroup$

add a comment | 

Your Answer

StackExchange.ready(function() {
var channelOptions = {
tags: "".split(" "),
id: "387"
};
initTagRenderer("".split(" "), "".split(" "), channelOptions);

StackExchange.using("externalEditor", function() {
// Have to fire editor after snippets, if snippets enabled
if (StackExchange.settings.snippets.snippetsEnabled) {
StackExchange.using("snippets", function() {
createEditor();
});
}
else {
createEditor();
}
});

function createEditor() {
StackExchange.prepareEditor({
heartbeatType: 'answer',
autoActivateHeartbeat: false,
convertImagesToLinks: false,
noModals: true,
showLowRepImageUploadWarning: true,
reputationToPostImages: null,
bindNavPrevention: true,
postfix: "",
imageUploader: {
brandingHtml: "Powered by u003ca class="icon-imgur-white" href="https://imgur.com/"u003eu003c/au003e",
contentPolicyHtml: "User contributions licensed under u003ca href="https://creativecommons.org/licenses/by-sa/3.0/"u003ecc by-sa 3.0 with attribution requiredu003c/au003e u003ca href="https://stackoverflow.com/legal/content-policy"u003e(content policy)u003c/au003e",
allowUrls: true
},
onDemand: true,
discardSelector: ".discard-answer"
,immediatelyShowMarkdownHelp:true
});


}
});

draft saved

draft discarded

Sign up or log in

StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});

Sign up using Google

Sign up using Facebook

Sign up using Email and Password

Post as a guest

Name

Email

Required, but never shown

StackExchange.ready(
function () {
StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fmathematica.stackexchange.com%2fquestions%2f203440%2fgame-schedule-where-each-player-meets-only-once%23new-answer', 'question_page');
}
);

Post as a guest

Name

Email

Required, but never shown

6

$begingroup$

n = 7;

k = 3;



DeleteDuplicates[Subsets[Range @ n, {k}], Length[Intersection[##]] >= 2 &]

{{1, 2, 3}, {1, 4, 5}, {1, 6, 7}, {2, 4, 6}, {2, 5, 7}, {3, 4, 7}, {3, 5, 6}}

share|improve this answer

answered 7 hours ago

kglrkglr

209k1010 gold badges241241 silver badges478478 bronze badges

$endgroup$

• 
  
  
  

  
  

  
  
  
  
  
  

  
  $begingroup$
  Very compact and 'neat'. Could you please explain what it does? I tried to 'decompile' it but had no luck understanding some of the 'components'.
  $endgroup$
  – mf67
  6 hours ago
  

  
  
  
  


• 
  
  
  

  
  1
  

  
  
  
  
  
  

  
  $begingroup$
  @mf67, Subsets[Range @ n, {k}] gives all k-player games, a list of k-tuples , {g1,g2,...}. Scanning this list from left to right DeleteDuplicates step eliminates all games $g_k$ that contains two or more players from $g_j$ (for $j<k$).
  $endgroup$
  – kglr
  6 hours ago
  

  
  
  
  


• 
  
  
  

  
  

  
  
  
  
  
  

  
  $begingroup$
  I see. Much clearer now. The examples on the Mathematica help pages are often (too) short and do not display the more 'intricate' commands given on this site.
  $endgroup$
  – mf67
  5 hours ago
  

  
  
  
  

add a comment | 

6

$begingroup$

n = 7;

k = 3;



DeleteDuplicates[Subsets[Range @ n, {k}], Length[Intersection[##]] >= 2 &]

{{1, 2, 3}, {1, 4, 5}, {1, 6, 7}, {2, 4, 6}, {2, 5, 7}, {3, 4, 7}, {3, 5, 6}}

share|improve this answer

answered 7 hours ago

kglrkglr

209k1010 gold badges241241 silver badges478478 bronze badges

$endgroup$

• 
  
  
  

  
  

  
  
  
  
  
  

  
  $begingroup$
  Very compact and 'neat'. Could you please explain what it does? I tried to 'decompile' it but had no luck understanding some of the 'components'.
  $endgroup$
  – mf67
  6 hours ago
  

  
  
  
  


• 
  
  
  

  
  1
  

  
  
  
  
  
  

  
  $begingroup$
  @mf67, Subsets[Range @ n, {k}] gives all k-player games, a list of k-tuples , {g1,g2,...}. Scanning this list from left to right DeleteDuplicates step eliminates all games $g_k$ that contains two or more players from $g_j$ (for $j<k$).
  $endgroup$
  – kglr
  6 hours ago
  

  
  
  
  


• 
  
  
  

  
  

  
  
  
  
  
  

  
  $begingroup$
  I see. Much clearer now. The examples on the Mathematica help pages are often (too) short and do not display the more 'intricate' commands given on this site.
  $endgroup$
  – mf67
  5 hours ago
  

  
  
  
  

add a comment | 

$begingroup$

n = 7;

k = 3;



DeleteDuplicates[Subsets[Range @ n, {k}], Length[Intersection[##]] >= 2 &]

{{1, 2, 3}, {1, 4, 5}, {1, 6, 7}, {2, 4, 6}, {2, 5, 7}, {3, 4, 7}, {3, 5, 6}}

share|improve this answer

answered 7 hours ago

kglrkglr

209k1010 gold badges241241 silver badges478478 bronze badges

$endgroup$

n = 7;

k = 3;



DeleteDuplicates[Subsets[Range @ n, {k}], Length[Intersection[##]] >= 2 &]

share|improve this answer

answered 7 hours ago

kglrkglr

209k1010 gold badges241241 silver badges478478 bronze badges

answered 7 hours ago

kglrkglr

209k1010 gold badges241241 silver badges478478 bronze badges

answered 7 hours ago

kglrkglr

209k1010 gold badges241241 silver badges478478 bronze badges

1

$begingroup$

n = 7;

k = 3;

list all possible games:

g = Subsets[Range[n], {k}];

Find a maximal-size clique of games that don't overlap:

First@FindClique[AdjacencyGraph[Outer[Boole[Length[Intersection[##]] <= 1] &, g, g, 1]]]

(*    {1, 10, 15, 21, 24, 28, 29}    *)

Which games are these?

g[[%]]

(*    {{1, 2, 3}, {1, 4, 5}, {1, 6, 7}, {2, 4, 6}, {2, 5, 7}, {3, 4, 7}, {3, 5, 6}}    *)

This method gives the same result as @kglr's but is much slower, so I don't recommend using it. You can view it as a proof of the other method.

share|improve this answer

edited 6 hours ago

answered 7 hours ago

RomanRoman

15.2k11 gold badge2121 silver badges5252 bronze badges

$endgroup$

add a comment | 

1

$begingroup$

n = 7;

k = 3;

list all possible games:

g = Subsets[Range[n], {k}];

Find a maximal-size clique of games that don't overlap:

First@FindClique[AdjacencyGraph[Outer[Boole[Length[Intersection[##]] <= 1] &, g, g, 1]]]

(*    {1, 10, 15, 21, 24, 28, 29}    *)

Which games are these?

g[[%]]

(*    {{1, 2, 3}, {1, 4, 5}, {1, 6, 7}, {2, 4, 6}, {2, 5, 7}, {3, 4, 7}, {3, 5, 6}}    *)

This method gives the same result as @kglr's but is much slower, so I don't recommend using it. You can view it as a proof of the other method.

share|improve this answer

edited 6 hours ago

answered 7 hours ago

RomanRoman

15.2k11 gold badge2121 silver badges5252 bronze badges

$endgroup$

add a comment | 

$begingroup$

n = 7;

k = 3;

list all possible games:

g = Subsets[Range[n], {k}];

Find a maximal-size clique of games that don't overlap:

First@FindClique[AdjacencyGraph[Outer[Boole[Length[Intersection[##]] <= 1] &, g, g, 1]]]

(*    {1, 10, 15, 21, 24, 28, 29}    *)

Which games are these?

g[[%]]

(*    {{1, 2, 3}, {1, 4, 5}, {1, 6, 7}, {2, 4, 6}, {2, 5, 7}, {3, 4, 7}, {3, 5, 6}}    *)

This method gives the same result as @kglr's but is much slower, so I don't recommend using it. You can view it as a proof of the other method.

share|improve this answer

edited 6 hours ago

answered 7 hours ago

RomanRoman

15.2k11 gold badge2121 silver badges5252 bronze badges

$endgroup$

n = 7;

k = 3;

g = Subsets[Range[n], {k}];

First@FindClique[AdjacencyGraph[Outer[Boole[Length[Intersection[##]] <= 1] &, g, g, 1]]]

(*    {1, 10, 15, 21, 24, 28, 29}    *)

g[[%]]

(*    {{1, 2, 3}, {1, 4, 5}, {1, 6, 7}, {2, 4, 6}, {2, 5, 7}, {3, 4, 7}, {3, 5, 6}}    *)

share|improve this answer

edited 6 hours ago

answered 7 hours ago

RomanRoman

15.2k11 gold badge2121 silver badges5252 bronze badges

answered 7 hours ago

RomanRoman

15.2k11 gold badge2121 silver badges5252 bronze badges

answered 7 hours ago

RomanRoman

15.2k11 gold badge2121 silver badges5252 bronze badges