Is it a valid chemical?

Question

Non-metals typically* have a fixed number of covalent bonds in every chemical they are part of. Given the number of bonds every element requires, output whether it's possible to construct a single molecule from the given chemicals, such that every atom has it's desired number of bonds.

In other words, output if it's possible to construct a connected undirected multigraph without self-loops so that each node has the number of edges equal to the corresponding number listed in the input.

Test Cases

Falsey:

• [1] A single element has nothing to bond with
• [4] Atoms can not bond with themselves
• [1, 1, 1, 1] Each atom is saturated after single bond, so it's impossible to connect all 4 of them together. It can form 2 pairs but not a single molecule.
• [0, 0] Two separate helium "molecules"
• [1, 3]
• [2, 3]
• [1, 1, 1, 1, 1, 3]

Truthy:

• [1, 1] (Hydrogen Gas: H-H → 1-1)
• [4, 2, 2] (Carbon Dioxide: O=C=O → 2=4=2)
• [3, 3] (Nitrogen Gas: N≡N → 3≡3)
• [2, 2, 2] (Ozone*: \$\newcommand{\tripow}[3]{ _{#1}{\stackrel{#2}{\triangle}}_{#3}} \tripow{O}{O}{O}\$ → \$\tripow{2}{2}{2}\$)
• [0] (Helium: He → 0)
• [3, 2, 1] (Nitroxyl: O=N-H → 2=3-1)
• [3, 3, 3, 3] (Tetrazete: \$\begin{array}{ccccccc}N&-&N& &3&-&3\\\ ||& &||& → &||& &||\\\ N&-&N& &3&-&3\end{array}\$)
• [4, 1, 1, 1, 1, 2, 2, 2]
• [4, 2, 2, 1, 1]
• [3, 3, 2, 1, 1]

Here are the Falsey/Truthy test cases as two lists of lists:

[[1], [4], [1, 1, 1, 1], [0, 0], [1, 3], [2, 3], [1, 1, 1, 1, 1, 3]]
[[1, 1], [4, 2, 2], [3, 3], [2, 2, 2], [0], [3, 2, 1], [3, 3, 3, 3], [4, 1, 1, 1, 1, 2, 2, 2], [4, 2, 2, 1, 1], [3, 3, 2, 1, 1]]

Clarifications

• You may assume the input is non-empty and all values are positive or zero.
• You may choose any 2 distinct values for truthy or falsy, or output truthy/falsy using your language's convention (swapping is allowed). See the tag wiki decision-problem

*I've been told real chemistry is a lot more complex than this, but you can ignore the complexities in this challenge.

Answer 1

Python 3, 61 60 59 58 51 bytes

lambda x:len(x)-2<~sum(x)%2*all(x)*sum(x)/2>=max(x)

Try it online!

-1 thanks to @Kevin Cruijssen

-7 thanks to @xnor

Uses theorem 2 from this paper.

It says a degree sequence is realizable as a connected multigraph with no self-loops if and only if it is [0], or:

0. All degrees are positive.
1. The sum of the degree sequence is even.
2. The biggest degree is less than or equal to the sum of the rest of the degrees. That is, sum(x)-max(x)>=max(x), or equivalently sum(x)/2>=max(x)
3. The number of edges, which is half the sum of degrees, is greater or equal to \$n-1\$, where \$n\$ is the number of vertices.

~sum(x)%2*all(x)*sum(x)/2 is equal to sum(x)/2 is the first two conditions are satisfied, and 0 otherwise.

If it is equal to 0, it implies len(x)-2<0>=max(x), so len(x)==1, max(x)==0 and therefore x==[0].

Otherwise, if the first two conditions are satisfied, it tests the third condition with sum(x)/2>=max(x), and the fourth with len(x)-2<sum(x)/2 (which is equivalent to len(x)-1<=sum(x)/2 since these are integers according to the second condition).

Answer 2

Wolfram Language (Mathematica), 134 bytes

Thanks to all for the motivation to immerse in graph theory! It is wonderful that there is a numerical criterion for connected multigraph. But I was wondering how it worked.
So I didn’t make a port of the same theorem, but I found an algorithm that allows you to build a multigraph, if it's possible, or give a message that you can’t. Having studied this article.
Here is the full-code version of Theorem 7 from the paper. It takes list of degrees and print out:

• Render of graph and True, if it's possible to make connected multigraph
• Graph and False, if only non-connected result is possible
• None, if list of degrees is non-graphic

multiGraphFromDegrees[degrees_List] :=
  Module[{n = Length@degrees, graph = Graph[{}]},
   data = MapThread[{#1, #2} &, {degrees, Range@n}];
   While[n > 1,
    data = ReverseSortBy[data, First];
    data[[1, 1]] -= 1; data[[n, 1]] -= 1;
    graph = 
     EdgeAdd[graph, UndirectedEdge[data[[1, 2]], data[[n, 2]]]];
    data = Select[data, #[[1]] > 0 &];
    n = Length@data;
    ];
   If[n > 0, Print["None"],
    Row[{graph, " Connected: ", ConnectedGraphQ@graph}]
    ]];

Example [1, 1, 1, 1, 1, 3]:

Example [3, 3, 3, 3]:

Example [6, 6, 4]:

Example [5, 4, 4, 4, 3, 3, 3, 3, 3, 3, 3, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1]:

Note, that algorithm makes some example of graph, if it's possible. So for [3,3,3,3] we have not Tetrazet, but other valid chemical. Also result may be non-planar, but it's OK for chemicals too.

And here is short version, directly answers the question of challenge (True or False):

(d=#;n=Length@#;Catch[While[n>1,d=ReverseSort[d];d[[1]]-=1;d[[n]]-=1;d=Select[d,#>0&];m=Length@d;If[n-m==2,Throw[False],n=m]]];d=={})&

If anyone is interested, I’ll describe the algorithm a little more.

Try it online!

Answer 3

R, 58 51 45 bytes

Edit: -6 bytes thanks to pajonk

\(x,`+`=sum)max(+x^0-1,x)<=all(x)*+x/2*!+x%%2

Attempt This Online!

Based on xnor's comment on Command master's Python answer: upvote that!

Answer 4

Jelly, 13 bytes

Uses S. L. Hakimi's result as aired by Command Master in their excellent Python answer.

ẠȧSH_L’»ṀƲeŻ$

A monadic Link that accepts a list of non-negative integers and yields 1 if a molecule may be formed or 0 if not.

Try it online!

How?

ẠȧSH_L’»ṀƲeŻ$ - Link: non-empty list of non-negative integers, D
Ạ             - all (D)? -> 0 if any of D are zero
  S           - sum (D)
 ȧ            - (all?) logical AND (sum)
   H          - halve (that) - call this X
         Ʋ    - last four links as a monad - f(D):
     L        -   length (D)
      ’       -   decrement
        Ṁ     -   maximum (D)
       »      -   (length-1) maximum (maximum(D)) - call this Y
    _         - (X) subtract (Y)
            $ - last two links as a monad - f(Q=that)
           Ż  -   zero range (Q) -> list of integers = [0..floor(Q)] (empty if Q < 0)
          e   -   (Q) exists in (that)?

Answer 5

JavaScript (ES6), 67 bytes

Based on the theorem found by @CommandMaster.

Returns 1 for falsy or 0 for truthy.

a=>a.some(v=>!(s+=v,k++,m>v?v:m=v)&a>'0',m=k=s=0)|2*k>s+3|s<m*2|s%2

Try it online!

Answer 6

Thunno D, \$ 21 \log_{256}(96) \approx \$ 17.29 bytes

XDS2%!>xS2/xMxL1-ZPpP

Attempt This Online! or verify all test cases

Based on Command Master's answer. Somehow passes all the test cases.

Outputs \$0\$ for falsy and \$1\$ for truthy.

Explanation

XDS2%!>xS2/xMxL1-ZPpP  # Implicit input
XD                     # Store input in x for later
  S2%!                 # Sum is even?
      >                # Is the input greater than this?
       xS2/            # Divide the sum by 2
           xM          # Push the maximum of x
             xL1-      # Get the length and decrement
                 ZP    # Pair together
                   pP  # Sum / 2 greater than or equal to both?
                       # Implicit output

Answer 7

05AB1E, 16 bytes

OÉ›¦IO;IàIg<‚@«P

Port of @CommandMaster's Python answer, so make sure to upvote him/her as well!

Try it online or verify all test cases.

Explanation:

O           # Get the sum of the (implicit) input-list
 É          # Pop and check whether it's odd (0 if even; 1 if odd)
  ›         # Check for each value in the (implicit) input-list whether it's larger
            # (so the sum is even and none are 0)
   ¦        # Remove the very first check (for edge-case input=[0])
IO          # Push the sum of the input-list again
  ;         # Halve it
        ‚   # Pair
   Ià       # the maximum of the input-list
     Ig<    # with the length-1 of the input-list
         @  # Check [sum/2>=max, sum/2>=length-1]
«           # Merge this pair to the earlier list of checks
 P          # Check if all are truthy by taking the product
            # (after which the result is output implicitly)

Answer 8

Arturo, 52 bytes

$[a][s:∑a(0=s%2)∧(>=s/2max a)∧(-size a 2)<s/2]

Thanks to S. L. Hakimi for solving the problem back in 1962 and @CommandMaster for finding the solution and explaining the relevant bits so clearly.

Answer 9

Nekomata + -e, 13 bytes

∑2¦$ṁ±*$:#←c≥

Attempt This Online!

A port of @Command Master's Python answer.

The flag -e set the interpreter to CheckExistence mode, which prints True if the computation has any result, and False otherwise.

∑2¦$ṁ±*$:#←c≥

∑2¦              Divide the sum of the input by 2. Fail if the remainder is not zero.
   $ṁ±*          Multiply it by the sign of the minimum element of the input.
            ≥    Check if the result is greater than or equal to all items of the following list:
       $:#←c       Prepend the length minus 1 to the input

---

Nekomata + -e, 18 bytes

ʷ{P↕1:Ð-:C0=+?}0U=

Attempt This Online!

This is extremely slow and takes up a lot of memory.

The idea is to repeatedly delete one edge at a time, until the result equals to [0].

ʷ{P↕1:Ð-:C0=+?}0U=

ʷ{            }       Repeat the following function until it fails:
  P                     Fails unless the result is all positive.
   ↕                    Non-deterministically permute the list.
    1:Ð-                Decrement the first two elements of the list.
        :C0=+?          Drop the first element of the list if it is zero.
               0U=    Check if the result is equal to [0].

Answer 10

Vyxal, 17 bytes

Based on Command Master's answer

∑₂?sṫ$∑≤?∑½?L‹≥WA

∑₂?sṫ$∑≤?∑½?L‹≥WA
∑₂                  Is the sum of the list even?
  ?sṫ$∑≤            Sort list, swap and sum tail-removed part, is lesser than or equal?
        ?∑½?L‹≥     Is length of list - 1 greater than or equal to half of the sum
               WA   Wrap stack, all truthy?

Try it Online!

Answer 11

TI-Basic, 28 bytes

max(dim(Ans)-1,max(Ans))≤min(Ans>0).5sum(Ans)not(fPart(.5sum(Ans

Takes input in Ans. Uses the same method as in Command Master's Python 3 answer.

Answer 12

Wolfram Language (Mathematica), 67 bytes

Length@x-2<BitNot[Tr@x]~Mod~2*If[AllTrue[x,#>0&],1,0]*Tr@x/2>=Max@x

Try it online!

A port of @Command Master's answer.

Explicit Mathematica Code is

f[x_List] := Module[{len, bitNotSumMod, allPositive, halfSum, maxVal},
    len = Length[x] - 2;
    bitNotSumMod = BitNot[Total[x]] ~Mod~ 2;
    allPositive = If[AllTrue[x, # > 0 &], 1, 0];
    halfSum = Total[x] / 2;
    maxVal = Max[x];

    len < bitNotSumMod * allPositive * halfSum >= maxVal
]

Answer 13

Charcoal, 20 bytes

¬∨﹪Σ貋∧⌊θΣθ⊗⌈⊞Ｏθ⊖Ｌθ

Try it online! Link is to verbose version of code. Outputs a Charcoal boolean, i.e. - for a valid chemical, nothing if not. Explanation: Based on @CommandMaster's Python answer.

    θ                    Input list
   Σ                     Sum
  ﹪                      Modulo
     ²                   Literal integer `2`
 ∨                      Logical Or
         θ              Input list
        ⌊               Minimum
       ∧                Logical And
           θ            Input list
          Σ             Sum
      ‹                 Is less than
                   θ    Input list
                  Ｌ     Length
                 ⊖      Decremented
              ⊞Ｏ        Appended to
                θ       Input list
             ⌈          Maximum
            ⊗           Doubled
¬                       Logical Not
                        Implicitly print

• len(x) - 2 < ~sum(x) % 2 * all(x) * sum(x) / 2 >= max(x) becomes
• ~sum(x) % 2 * all(x) * sum(x) / 2 >= max(*x, len(x) - 1) becomes
• ~sum(x) % 2 * all(x) * sum(x) >= 2 * max(*x, len(x) - 1) becomes
• not(~sum(x) % 2 * all(x) * sum(x) < 2 * max(*x, len(x) - 1)) becomes
• not(sum(x) % 2 or all(x) * sum(x) < 2 * max(*x, len(x) - 1)) becomes
• not(sum(x) % 2 or (min(x) and sum(x)) < 2 * max(*x, len(x) - 1)).