Mathematica, 373 bytes

If[l=Length;a=Accumulate[l/@#]&;u=Unequal;e=Select;{}==(m=(g=#;Tr[#2Flatten[ConstantArray[#,LCM@@l/@g/l@#]&/@g]~Count~#&@@@Tally@c])&/@e[p=e[c~Internal`PartitionRagged~#&/@Join@@Permutations/@IntegerPartitions[l[c=Characters[s=StringReplace[#,c:"A"~CharacterRange~"Z":>(d=ToLowerCase@c)<>d]]]],u@@l/@#&&And@@u@@@#&],FreeQ[p,l_List/;#!=l&&SubsetQ[a@l,a@#]]&]),"evil",Min@m]&

This is quite long... and also rather naive. It defines an unnamed function that takes the string and returns score. It takes about 1 second to handle "Establishments", so it's well within the time limit. I've got a slightly shorter version that uses Combinatorica`SetPartitions, but it already takes a minute for "Establishme".

Here is a version with whitespace:

If[
  l = Length;
  a = Accumulate[l /@ #] &;
  u = Unequal;
  e = Select;
  {} == (
    m = (
      g = #;
      Tr[
        #2 Flatten[
          ConstantArray[
            #, 
            LCM @@ l /@ g/l@#
          ] & /@ g
        ]~Count~# & @@@ Tally@c
      ]
    ) & /@ e[
      p = e[
        c~Internal`PartitionRagged~# & /@ Join @@ Permutations /@ IntegerPartitions[
          l[
            c = Characters[
              s = StringReplace[
                #, 
                c : "A"~CharacterRange~"Z" :> (d = ToLowerCase@c) <> d
              ]
            ]
          ]
        ], 
        u @@ l /@ # && And @@ u @@@ # &
      ], 
      FreeQ[p, l_List /; # != l && SubsetQ[a@l, a@#]] &
    ]
  ),
  "evil",
  Min@m
] &

I might add a more detailed explanation later. This code uses the second solution from this answer to get all the partitions and this solution to make sure they are all maximally segmented.