Perfect Palindromes

Question

Your task is to determine how much of a perfect palindrome a string is. Your typical palindrome (eg 12321) is a perfect palindrome; its perfectness is 1.

To determine the perfectness of a string, you see how many sections you can split it into where each section is a palindrome. If there are ambiguities, such as with aaaa, as you can split it into [aa, aa] or [aaaa] or [a, aaa] or [aaa, a], the shortest set will override, giving aaaa a score of 1, which is the length of the shortest set.

Therefore, you must write a program or function that will take one non-empty input and output how perfect it is (which is the length of the shortest set you can split it into where each element in the set is a palindrome).

Examples:

1111 -> 1 [1111]
abcb -> 2 [a, bcb]
abcbd -> 3 [a, bcb, d]
abcde -> 5 [a, b, c, d, e]
66a -> 2 [66, a]
abcba-> 1 [abcba]
x -> 1 [x]
ababacab -> 2 [aba, bacab]
bacababa -> 2 [bacab, aba]
26600 -> 3 [2, 66, 00] [my user id] [who has a more perfect user id?]
ababacabBACABABA -> 4 [aba, bacab, BACAB, ABA]

Note that in the examples anything in square brackets shouldn't be part of the output.

Answer 1

Brachylog, 7 bytes

~cL↔ᵐLl

Try it online!

Explanation

~cL          Deconcatenate the input into L
  L↔ᵐL       Reversing all elements of L results in L
     Ll      Output = length(L)

Answer 2

Jelly, 13 12 11 bytes

ŒṖLÞŒḂ€P$ÐfḢL
ŒṖLÞṚ€⁼$ÐfḢL
ŒṖṚ€⁼$ÐfL€Ṃ
ŒṖ            obtain partitions
      Ðf      filter for partitions which
  Ṛ€              after reversing each subpartition
    ⁼             is equal to the partition
        L€    length of each successful partition
          Ṃ   minimum

Try it online!

Specs

• Input: "ababacab" (as argument)
• Output: 2

Answer 3

Pyth, 9 bytes

lh_I#I#./

Test suite

This forms all partitions of the input, from shortest to longest. Then, it filters those partitions on invariance under filtering the elements on invariance under reversal. Finally, we take the first element of the filtered list of partitions, and return its length.

To explain that complicated step, let's start with invariance under reversal: _I. That checks whether its input is a palindrome, because it checks whether reversing changes the value.

Next, filtering for palindromicity: _I#. This will keep only the palindromic elements of the list.

Next, we check for invariance under filtering for palindromicity: _I#I. This is truthy if and only if all of the elements of the list are palindromes.

Finally, we filter for lists where all of the elements of the list are palindromes: _I#I#.

Answer 4

Haskell, 83 bytes

f s=minimum[length x|x<-words.concat<$>mapM(\c->[[c],c:" "])s,all((==)=<<reverse)x]

Try it online!

This uses Zgarb's great tip for generating string partitions.

f s = minimum[                               -- take the minimum of the list
    length x |                               -- of the number of partitions in x
    x<-words.concat<$>mapM(\c->[[c],c:" "])s -- where x are all partitions of the input string s
    , all((==)=<<reverse)x                   -- where each partition is a palindrome.
]

Answer 5

JavaScript (ES6), 143 126 124 bytes

Saved 2 bytes thanks to Neil

Inspired by NikoNyrh method.

s=>(r=1/0,F=(s,i=1,p=0)=>s[p++]?([...o=s.slice(0,p)].reverse().join``==o&&(s[p]?F(s.slice(p),i+1):r=r<i?r:i),F(s,i,p)):r)(s)

Formatted and commented

s => (                          // given a string 's':
  r = 1 / 0,                    // 'r' = best score, initialized to +Infinity
  F = (                         // 'F' is a recursive function that takes:
    s,                          //   - the current string 's'
    i = 1,                      //   - a substring counter 'i'
    p = 0                       //   - a character pointer 'p'
  ) =>                          //
    s[p++] ? (                  // if we haven't reached the end of the string:
      [...o = s.slice(0, p)]    //   compute 'o' = substring of length 'p'
      .reverse().join`` == o    //   if 'o' is a palindrome,
      && (                      //   then:
        s[p] ?                  //     if there are still characters to process:
          F(s.slice(p), i + 1)  //       do a recursive call on the remaining part
        :                       //     else:
          r = r < i ? r : i     //       update the score with r = min(r, i)
      ),                        //   in all cases:
      F(s, i, p)                //     do a recursive call with a longer substring
    ) :                         // else:
      r                         //   return the final score
  )(s)                          // initial call to F()

Test cases

let f =

s=>(r=1/0,F=(s,i=1,p=0)=>s[p++]?([...o=s.slice(0,p)].reverse().join``==o&&(s[p]?F(s.slice(p),i+1):r=r<i?r:i),F(s,i,p)):r)(s)

console.log(f('1111'))      // -> 1 [1111]
console.log(f('abcb'))      // -> 2 [a, bcb]
console.log(f('abcbd'))     // -> 3 [a, bcb, d]
console.log(f('abcde'))     // -> 5 [a, b, c, d, e]
console.log(f('66a'))       // -> 2 [66, a]
console.log(f('abcba'))     // -> 1 [abcba]
console.log(f('x'))         // -> 1 [x]
console.log(f('ababacab'))  // -> 2 [aba, bacab]
console.log(f('bacababa'))  // -> 2 [bacab, aba]

---

Initial approach, 173 168 bytes

A pretty long recursive function that computes all possible partitions of the input string.

f=(s,b=1/(k=0))=>++k>>(L=s.length)?b:f(s,(k|1<<30).toString(2).slice(-L).match(/(.)\1*/g).some(m=>[...o=s.slice(i,i+=m.length)].reverse(n++).join``!=o,n=i=0)?b:b<n?b:n)

Formatted and commented

f = (                           // given:
  s,                            //   - a string 's'
  b = 1 / (k = 0)               //   - a best score 'b' (initialized to +Infinity)
) =>                            //   - a counter 'k' (initialized to 0)
  ++k >> (L = s.length) ?       // if 'k' is greater or equal to 2^(s.length):
    b                           //   stop recursion and return 'b'
  :                             // else:
    f(                          //   do a recursive call:
      s,                        //     using the same string 's'
      (k | 1 << 30)             //     compute an array containing the groups of identical
      .toString(2).slice(-L)    //     digits in the binary representation of 'k', padded
      .match(/(.)\1*/g)         //     with leading zeros and cut to the length of 's'
      .some(g =>                //     for each group 'g' in this array:
        [... o = s.slice(       //       compute 'o' = corresponding substring of 's',
          i, i += g.length      //       starting at position 'i' with the same length
        )]                      //       (e.g. s = 'abcd' / k = 0b1101 => 'ab','c','d')
        .reverse(n++)           //       increment the number of groups 'n'
        .join`` != o,           //       return true if this substring is NOT a palindrome
        n = i = 0               //       initialize 'n' and 'i'
      ) ?                       //     if some() returns true:
        b                       //       invalid partition -> keep the previous score 'b'
      :                         //     else:
        b < n ? b : n           //       valid partition -> use min(b, n)
    )                           //   end of recursive call

Test cases

f=(s,b=1/(k=0))=>++k>>(L=s.length)?b:f(s,(k|1<<30).toString(2).slice(-L).match(/(.)\1*/g).some(m=>[...o=s.slice(i,i+=m.length)].reverse(n++).join``!=o,n=i=0)?b:b<n?b:n)

console.log(f('1111'))      // -> 1 [1111]
console.log(f('abcb'))      // -> 2 [a, bcb]
console.log(f('abcbd'))     // -> 3 [a, bcb, d]
console.log(f('abcde'))     // -> 5 [a, b, c, d, e]
console.log(f('66a'))       // -> 2 [66, a]
console.log(f('abcba'))     // -> 1 [abcba]
console.log(f('x'))         // -> 1 [x]
console.log(f('ababacab'))  // -> 2 [aba, bacab]
console.log(f('bacababa'))  // -> 2 [bacab, aba]

Answer 6

Clojure, 111 bytes

(defn f[s](if(=()s)0(+(apply min(for[i(range(count s))[a b][(split-at(inc i)s)]:when(=(reverse a)a)](f b)))1)))

Splits at all possible positions, and when the first part is a palindrome proceeds to find a partitioning for the remaining of the string.

Try it online.

Ungolfed, uses thread-last macro ->>.

(defn f [s]
  (if (empty? s)
    0
    (let [results (for[i (range(count s))]
                      (let [[a b] (split-at (inc i) s)]
                         (when (= a (reverse a))
                           (f b))))]
      (->> results        ; Take results (a list of integers and nils),
           (filter some?) ; remove null values (they occur when "a" is not a palindrome)
           (apply min)    ; find the minium value,
           inc))))        ; and increment by one.

An obscure version, please do not write code like this :D

(defn f [s]
   (->> (f b)
        (when (= a (reverse a)))
        (let [[a b] (split-at (inc i) s)])
        (for[i (range(count s))])
        (filter some?)
        (apply min)
        inc
        (if (empty? s) 0)))

Answer 7

Jelly, 10 bytes

ŒṖŒḂ€¬$ÞḢL

Try it online!

How?

Uses the fact that
[0]<[0,0]<[0,0,0],...,<[0,...,0,1]<...
- thus if we sort the partitions by a key "is not palindromic for each part" the first entry will be all palindromic and of minimal length.

Note: any non-empty string of length n will always result in such a key with n zeros, since all length 1 strings are palindromic.

ŒṖŒḂ€¬$ÞḢL - Main link: s             e.g. 'abab'
ŒṖ         - partitions of s               [['a','b','a','b'],['a','b','ab'],['a','ba','b'],['a','bab'],['ab','a','b'],['ab','ab'],['aba','b'],['abab']]
       Þ   - sort by (create the following key and sort the partitions by it):
      $    -   last two links as a monad:  (key evaluations aligned with above:)
  ŒḂ€      -     is palindromic? for €ach   [ 1 , 1 , 1 , 1 ] [ 1 , 1 , 0  ] [ 1 , 0  , 1 ] [ 1 , 1   ] [ 0  , 1 , 1 ] [ 0  , 0  ] [ 1   , 1 ] [ 0    ] 
     ¬     -     not                        [ 0 , 0 , 0 , 0 ] [ 0 , 0 , 1  ] [ 0 , 1  , 0 ] [ 0 , 0   ] [ 1  , 0 , 0 ] [ 1  , 1  ] [ 0   , 0 ] [ 1    ]
           - ...i.e.:         
           -       making the sorted keys: [[ 0 , 0   ],[ 0   , 0 ],[ 0 , 0 , 0 , 0 ],[ 0 , 0 , 1  ],[ 0 , 1  , 0 ],[ 1    ],[ 1  , 0 , 0 ],[ 1  , 1  ]]
           -  hence the sorted partitions: [['a','bab'],['aba','b'],['a','b','a','b'],['a','b','ab'],['a','ba','b'],['abab'],['ab','a','b'],['ab','ab']]
        Ḣ  - head of the result             ['a','bab']
         L - length                         2

Answer 8

Haskell, 69 bytes

x!(a:b)|p<-a:x=p!b++[1+f b|p==reverse p]
x!y=[0|x==y]
f=minimum.(""!)

Defines a function f. Try it online!

Explanation

The infix helper function x ! y computes a list of integers, which are the lengths of some splittings of reverse x ++ y into palindromes where reverse x is left intact. It is guaranteed to contain the length of the minimal splitting if y is nonempty. How it works is this.

• If y is nonempty, a char is popped off it and pushed into x. If x becomes a palindrome, we call the main function f on the tail of y and add 1 to account for x. Also, we call ! on the new x and y to not miss any potential splitting.
• If y is empty, we return [0] (one splitting of length 0) if x is also empty, and [] (no splittings) otherwise.

The main function f just calls "" ! x and takes the minimum of the results.

x!(a:b)|          -- Function ! on inputs x and list with head a and tail b,
  p<-a:x=         -- where p is the list a:x, is
  p!b++           -- the numbers in p!b, and
  [1+f b|         -- 1 + f b,
   p==reverse p]  -- but only if p is a palindrome.
x!y=              -- Function ! on inputs x and (empty) list y is
  [0|             -- 0,
   x==y]          -- but only if x is also empty.
f=                -- Function f is:
  minimum.(""!)   -- evaluate ! on empty string and input, then take minimum.

Answer 9

JavaScript (Firefox 30-57), 97 bytes

f=(s,t=``,i=0)=>s?Math.min(...(for(c of s)if([...t+=c].reverse(++i).join``==t)1+f(s.slice(i)))):0

ES6 port:

f=(s,t=``)=>s?Math.min(...[...s].map((c,i)=>[...t+=c].reverse().join``==t?1+f(s.slice(i+1)):1/0)):0

<input oninput=o.textContent=f(this.value)><pre id=o>

It seems such a simple solution that I keep thinking I've forgotten something but it does at least pass all the test cases.

Answer 10

PHP, 319 Bytes

for(;$i<$l=strlen($s=$argn);$i++)for($j=$l-$i;$j;$j--)strrev($r=substr($s,$i,$j))!=$r?:$e[+$i][]=$r;uasort($e,function($a,$b){return strlen($b[0])<=>strlen($a[0])?:count($a)<=>count($b);});foreach($e as$p=>$v)foreach($v as$w){$s=preg_replace("#^(.{{$p}})$w#","$1".str_pad("",strlen($w),"ö"),$s,1,$c);!$c?:++$d;}echo$d;

Online Version

Expanded

for(;$i<$l=strlen($s=$argn);$i++)
for($j=$l-$i;$j;$j--)strrev($r=substr($s,$i,$j))!=$r?:$e[+$i][]=$r; #Make all substrings that are palindromes for each position
uasort($e,function($a,$b){return strlen($b[0])<=>strlen($a[0])?:count($a)<=>count($b);}); # sort palindrome list high strlen lowest count for each position
foreach($e as$p=>$v)
foreach($v as$w){
    $s=preg_replace("#^(.{{$p}})$w#","$1".str_pad("",strlen($w),"ö"),$s,1,$c);
    !$c?:++$d; # raise count
}
echo$d; # Output

Longer Version without E_NOTICE and Output the resulting array

Answer 11

Haskell, 139 116 109 bytes

h[]=[[]]
h x=words.concat<$>mapM(\c->[[c],c:" "])x
r x=reverse x==x
g x=minimum[length y|y<-h x,and$r<$>y]

Still green at Haskell golfing but here is my best attempt I can come up with quickly.

• h is a function that creates a List of all possible contiguous subsequences of a List (like a string). It takes the input String and breaks it out for g.
• r is a simple function that returns a Boolean for if a List is a palindrome
• g is the main function that takes an input List, calls h to get the list of contiguous subsequence possibilities, filters on (and.map r) to remove sub lists that do not contain a palindrome, at which point length is applied to the list, and then the result is sorted so we can grab the head which is the answer.

I was thinking a better answer might be able to leverage the non-deterministic nature of Lists in Haskell through the use of Applicatives. It might be possible to shave many bytes off of function h by using applicatives, even if we have to import Control.Applicative. Comments for improvement are welcome.

UPDATE1

Huge savings based on Laikoni's reminder about the minimum function. Removing sort actually allowed me to drop the Data.List import because minimum is defined in Prelude!

UPDATE2

Thanks to nimi's suggestion about using list comprehensions as a useful replacement for filter.map. That saved me a few bytes. Also I borrowed the neat String partition trick from Laikonis answer and saved a couple bytes there as well.