3
$\begingroup$

I want to make $S[\{,\cdots, \}]$ as follows

First input of $S$ is given list $\{1,2,3,\cdots, n\}$ and it produces $s_{123\cdots n}$

Further, if the ordering of the list is given differently, still gives increasing order. i.e.,

$S[{1,3,2}] = s_{123}$

$S[{1,2,4,3}] = s_{1234}$

and so on.

$\endgroup$

4 Answers 4

5
$\begingroup$

Using Format, Interpretation, and Orderless:

Attributes[S] = {Orderless};

Format[e : S[args___]] := Interpretation[Subscript[s, Row@{args}], e]

S[1, 2, 4, 3]

(* S[1, 2, 3, 4] *)

S[1, 2, 4, 3] // InputForm
(* S[1, 2, 4, 3] *)

The use of Interpretation ensures that you can still use the expression when copy-pasting it (see the last example). The Orderless attribute does the sorting automatically, and also makes it so that different orderings are considered equivalent:

S[1, 2, 4, 3] == S[4, 3, 2, 1]
(* True *)

If you want some spacing between the different subscripts, you can use Indexed:

Format[e : S[args___]] := Interpretation[Indexed[s, {args}], e]

S[1, 2, 4, 3]

enter image description here

If you really need S[{...}] instead of simply S[...], you can't use Orderless. You'll have to manually sort the arguments, e.g. like this:

S[args_] /; ! OrderedQ@args := S[Sort@args]

Format[e : S[args_]] := Interpretation[Subscript[s, Row@args], e]

S[1, 2, 4, 3]

(* S[1, 2, 3, 4] *)

The first line automatically sorts the arguments of S if they are not already sorted (using Condition (/;) and OrderedQ)

$\endgroup$
2
$\begingroup$

This can be done with a pure function, like this:

ClearAll[S]
S = Subscript[s, Row[{##} // Flatten // Sort, " "]] &;

S[{1, 2, 3, 4}]

S[1, 3, 2]

enter image description here

Notice the use of ## in the above to refer to the function arguments.
If you don't like so much space between the subscripts, use

ClearAll[S]
S = Subscript[s, Row[{##} // Flatten // Sort]] &;
$\endgroup$
0
$\begingroup$

If you want an input to be a List then e.g.:

S[list_] := Subscript[S, StringDelete[ToString[Sort[list]], {",", " ","{", "}"}]]

If a Sequence then e.g.:

R[seq__] := Subscript[R, StringDelete[ToString[{seq}], {",", " ", "{", "}"}]]

I'm sure there are other (better) ways, but these might need to be tailored to what you need.

$\endgroup$
0
$\begingroup$

First, look at https://mathematica.stackexchange.com/questions/187654/how-to-build-a-templatebox-with-dynamic-length-gridbox[templatebox-with-dynamic-length-gridbox][1] since similar questions already have answers

My solution (adopted from more general context) is below. With little more adaptation the output even can be copied, edited and reused, assuming that you do not change number of indices (this seems is limitation of current Mathematica two dimensional input template possibilities).

MakeBoxes[mvDownUp[{indown___Integer}, {inup___Integer}], 
   sf : StandardForm] := With[{
    argsa = Riffle[Flatten[Rest /@ Sort[
         Transpose[{{indown, inup}, 
           Join[Table[
             AdjustmentBox[Slot[i], BoxBaselineShift -> 1], {i, 
              Length[{indown}]}], 
            Table[AdjustmentBox[Slot[i], BoxBaselineShift -> -1], {i, 
              Length[{indown}] + 1, Length[{indown, inup}]}]]}]
         ]], ","]
    },
   With[{
     pfd =
      Function[
       StyleBox[RowBox[argsa], FontSize -> Small, 
        FontTracking -> "Condensed", AutoSpacing -> False]],
     pfi = 
      ReleaseHold[
        RowBox[{"mvDownUp", "@@", 
          MakeExpression[{Take[{##}, Length[{indown}]], 
            Take[{##}, {Length[{indown}] + 1, 
              Length[{indown, inup}]}]}, sf]}]] &
     },
    TemplateBox[
     Flatten[{MakeBoxes[#, sf] & /@ {indown}, 
       MakeBoxes[#, sf] & /@ {inup}}], "mvDownUp", 
     DisplayFunction :> pfd, InterpretationFunction :> pfi, 
     SyntaxForm -> "fish", 
     Tooltip -> ToString[mvDownUp[{indown}, {inup}]]]
    ]
   ];

With[{baseSymbolN = "S", bs = Symbol["S"]},
 MakeBoxes[bs[in_mvDownUp], sf : StandardForm] := 
  With[{sty = (FontColor -> Black), inEx = MakeBoxes[in, sf]},
   With[{
     pfd = 
      Function[
       StyleBox[RowBox[{StyleBox[baseSymbolN, sty], #1}], 
        AutoSpacing -> False, FontTracking -> "Condensed"]], 
     pfi = Function[RowBox[{baseSymbolN, "[", #1, ",", #2, "]"}]]}, 
    TemplateBox[{inEx}, baseSymbolN, DisplayFunction :> pfd, 
     InterpretationFunction :> pfi, SyntaxForm -> "fish"]]]]

S[x_List] := S[mvDownUp[Sort[x], {}]] /; ! OrderedQ[x]

S[x_List] := S[mvDownUp[x], {}]

S[{3, 1, 2, 7}]
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.