25
\$\begingroup\$

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.

\$\endgroup\$
8
  • \$\begingroup\$ Is the empty string a valid input, and if so, what should the output be? \$\endgroup\$
    – Zgarb
    Commented Apr 24, 2017 at 13:09
  • 8
    \$\begingroup\$ ababacab and its reverse, bacababa, seem to be good test cases. \$\endgroup\$
    – Neil
    Commented Apr 24, 2017 at 13:37
  • \$\begingroup\$ @Neil as well as good arguments as to whether a linear-time algorithm is possible. \$\endgroup\$
    – Leaky Nun
    Commented Apr 24, 2017 at 13:46
  • \$\begingroup\$ @Zgarb Empty string is not valid input. \$\endgroup\$
    – Okx
    Commented Apr 24, 2017 at 14:54
  • \$\begingroup\$ ababacabBACABABA is also a good test case (some answers fail on it). \$\endgroup\$
    – Zgarb
    Commented Apr 25, 2017 at 7:43

11 Answers 11

14
\$\begingroup\$

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)
\$\endgroup\$
2
  • \$\begingroup\$ You beat me... on my first post lol \$\endgroup\$
    – Leaky Nun
    Commented Apr 24, 2017 at 13:00
  • 7
    \$\begingroup\$ @LeakyNun I knew you would try it. Last months I could slack off and wait a few hours, now with you back I have to answer immediatly! \$\endgroup\$
    – Fatalize
    Commented Apr 24, 2017 at 13:02
9
\$\begingroup\$

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
\$\endgroup\$
8
  • 3
    \$\begingroup\$ @Okx well you would have to escape those. \$\endgroup\$
    – Leaky Nun
    Commented Apr 24, 2017 at 12:57
  • 2
    \$\begingroup\$ Well, I don't think it's valid if it can't accept backslashes. \$\endgroup\$
    – Okx
    Commented Apr 24, 2017 at 12:57
  • 14
    \$\begingroup\$ @Okx It's like writing a string. You can't expect, say, a C program to work with a string input "\", because that's invalid syntax. \$\endgroup\$ Commented Apr 24, 2017 at 12:59
  • 2
    \$\begingroup\$ Welcome back, by the way. :-) \$\endgroup\$
    – Arnauld
    Commented Apr 24, 2017 at 13:19
  • 2
    \$\begingroup\$ Sadly this gives different answers for ababacab and its reverse, bacababa. \$\endgroup\$
    – Neil
    Commented Apr 24, 2017 at 13:36
6
\$\begingroup\$

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#.

\$\endgroup\$
1
  • \$\begingroup\$ I have got a lot to learn... \$\endgroup\$
    – Leaky Nun
    Commented Apr 25, 2017 at 11:40
6
\$\begingroup\$

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.
]
\$\endgroup\$
1
  • 1
    \$\begingroup\$ Wow! This blew my mind! I definitely got a lot to learn. \$\endgroup\$ Commented Apr 24, 2017 at 23:29
5
\$\begingroup\$

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)))
\$\endgroup\$
4
  • \$\begingroup\$ Would this tip help? I don't know Clojure at all. \$\endgroup\$
    – Leaky Nun
    Commented Apr 24, 2017 at 15:31
  • \$\begingroup\$ Usually yes, but in this case the function f has to call itself within the for: (f b). On a tail-call position you can use recur. \$\endgroup\$
    – NikoNyrh
    Commented Apr 24, 2017 at 15:38
  • \$\begingroup\$ You can still replace defn with fn and just have a function. \$\endgroup\$
    – cliffroot
    Commented Apr 24, 2017 at 15:42
  • \$\begingroup\$ (fn f[s]( ... ))? Oh true. You save 2 characters with that. \$\endgroup\$
    – NikoNyrh
    Commented Apr 24, 2017 at 15:45
5
\$\begingroup\$

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]

\$\endgroup\$
2
  • \$\begingroup\$ If I've understood your explanation correctly, you can save a couple of bytes using ,p=0, s[p++]? and ,F(s,i,p). \$\endgroup\$
    – Neil
    Commented Apr 24, 2017 at 21:31
  • \$\begingroup\$ @Neil Yes indeed. :-) \$\endgroup\$
    – Arnauld
    Commented Apr 24, 2017 at 21:46
5
\$\begingroup\$

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
\$\endgroup\$
5
\$\begingroup\$

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.
\$\endgroup\$
3
\$\begingroup\$

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.

\$\endgroup\$
1
\$\begingroup\$

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.

\$\endgroup\$
4
  • 1
    \$\begingroup\$ h []=[[]] and h (x:y)=map ([x]:) contain unnecessary white space. head.sort is minimum. \$\endgroup\$
    – Laikoni
    Commented Apr 24, 2017 at 20:24
  • \$\begingroup\$ @Laikoni Thanks! I will update when I get back to my computer! \$\endgroup\$ Commented Apr 24, 2017 at 22:43
  • 1
    \$\begingroup\$ A list comprehension is often shorter than filter& map: g x=head$sort[length y|y<-h x,and$r<$>y]. \$\endgroup\$
    – nimi
    Commented Apr 24, 2017 at 23:38
  • \$\begingroup\$ @nimi Thank you, there are so many useful golfing tips for Haskell. I learn a new trick everytime. \$\endgroup\$ Commented Apr 25, 2017 at 11:57
1
\$\begingroup\$

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

\$\endgroup\$
2
  • \$\begingroup\$ This seems to give an incorrect result for ababacabBACABABA \$\endgroup\$
    – Zgarb
    Commented Apr 25, 2017 at 7:47
  • \$\begingroup\$ @Zgarb Now it works \$\endgroup\$ Commented Apr 25, 2017 at 16:26

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.