Function to preserve evaluation on display?

Question

I'm looking for a function that applies the following behavior to an expression:

-When the expression is given as the full input, or as part of a function that cannot be evaluated, it remains in unevaluated form. -When the expression is used for a function, it is evaluated.

Defer[] won't evaluate it in a function. Unevaluated[] leaves itself in evaluated when used directly as output.

Essentially, I need a function F[] that will output the following:

• F[1-1/2] outputs 1-1/2, NOT 1/2

• Times[F[1-1/2],5] outputs 5/2, NOT (1-1/2)5

• Times[F[1-1/2],x] outputs (1-1/2)x, NOT x/2

If the solution only works for a specific internal expression, that works, because I only need this for one function.

Answer 1

Something along these lines?

SetAttributes[f, HoldAll];
f /: h_?headPredQ[b___, f[arg_], a___] := 
  With[{res = h[b, arg, a]}, res /; Hold[res] =!= Hold[h[b, arg, a]]];
Format[f[arg_]] := Defer[arg];
headPredQ[h_] := MemberQ[Attributes@h, NumericFunction];

EDIT

New version that contemplates the third case I had forgot (thanks @MichaelE2). This compares the evaluated result of the expression with the result of only applying attribute transformations like those of Flat, Sequence or Orderless. So, reorderings of arguments in a multiplication aren't interpreted as a real evaluation now

SetAttributes[f, HoldFirst];
f /: h_?headPredQ[b___, f[arg_], a___] :=
  Block[{s}, 
   s /: h[s, args___] := Hold[h[args]]; 
   With[{res = h[b, arg, a]},
    res /; Hold[res] =!= h[s, b, arg, a]]];
Format[f[arg_]] := Defer[arg];
headPredQ[h_] := MemberQ[Attributes@h, NumericFunction];

Answer 2

I like how Rojo's answer tests for evaluation in general, but it requires an additional fix as noted by Michael E2. So here is another approach where I interpret "evaluating" in the question as meaning "to yield a numerical result". This can be tested with NumericQ. Then I just have to take care of the non-numeric case by returning the Defered result and also stopping the potential recursion that will happen if f[x] is not inside another function:

SetAttributes[f, HoldFirst];
f /: h_[a___, f[x_], b___] := 
  If[TrueQ@NumericQ[h[a, x, b]], h[a, x, b],
   Defer[h[a, x, b]] /. HoldPattern[If[False, y_, ___]] :> y];

The replacement rule with HoldPattern looks for the pattern that will arise when the first If statement is itself the Head wrapping f, as will happen when f wasn't wrapped by anything else. That's when a recursion would occur, so the argument has to be pulled out through the variable y.

Now I get for example:

f[1 - 1/2] 5

(* ==> 5/2 *)

f[1 - 1/2] x

(* ==> x (1 - 1/2) *)

f[1 - 1/9]

(* ==> 1 - 1/9 *)

This is how I understood the question - I'm not entirely sure if Defer was desired or not. Maybe you want to replace Defer by HoldForm, but the rest wouldn't change.

Answer 3

Revisiting this question after noticing the third requirement of the question and the statement that you need this only for one function I believe you may want this:

SetAttributes[f, HoldFirst]

Format[f[x_]] := Defer[x]

f /: Times[f[x_], y_?NumericQ, z___] := (x*y) z

Now:

f[1 - 1/2]

Times[f[1 - 1/2], 5]

Times[f[1 - 1/2], x]

1 - 1/2

5/2

x (1 - 1/2)

---

Original answer

It seems to me that (at least on version 7) Unevaluated behaves as you desire F to.
If you do not have a $Post or $PrePrint function defined a raw Unevaluated[2+2] should not evaluate:

In[1]:= Unevaluated[2 + 2]

Out[1]= Unevaluated[2 + 2]

All that remains is to Format the output to hide Unevaluated itself:

Unprotect[Unevaluated]

Format[Verbatim[Unevaluated][expr_]] := Defer[expr]

In[3]:= Unevaluated[2 + 2]

Out[3]= 2 + 2

Of course since you said:

If the solution only works for a specific internal expression, that works, because I only need this for one function.

Verbeia's alluded solution is sufficient:

SetAttributes[f, HoldAll]

Format[f[expr_]] := Defer[expr]

StringJoin[a___, f[inside_], b___] ^:= StringJoin[a, inside, b]

Test:

f["a" <> "b"]

"a" <> "b"

f["a" <> "b"] <> "c"

"abc"