Generar anagrama con strings

Question

Hola.

Tengo el siguiente código que me permite obtener una lista de strings, basada en la posición de los caracteres de otro string.

Private Sub Button1_Click() Handles Button1.Click
        Call Main()
    End Sub

    Shared Sub Main()
        Dim result = GenerateAnagramAlt("ABC").Distinct.ToArray

        Using writer As New StreamWriter("out.txt")
            Console.SetOut(writer)
            For Each s In result
                Console.WriteLine(s)
            Next s
        End Using

    End Sub

    Private Shared Iterator Function GenerateAnagramAlt(ByVal src As String) As IEnumerable(Of String)
        If src.Length = 0 Then
            Return
        End If
        If src.Length = 1 Then
            Yield src
        End If

        For Each rest As String In GenerateAnagramAlt(src.Substring(1))
            For i As Integer = 0 To src.Length - 1
                Dim temp As String = rest.Substring(0, i) & src.Chars(0) & rest.Substring(i)
                Yield temp
            Next i
        Next rest
    End Function
'Resultado:
'ABC
'BAC
'BCA
'ACB
'CAB
'CBA

Lo que necesito es que el resultado sea el siguiente

'Resultado
'A
'B
'C
'AB
'AC
'BA
'BC
'CA
'CB
'ABC
'ACB
'BAC
'BCA
'CAB
'CBA

Gracias por la ayuda.

Answer 1

Hola  

Gracias por levantar tu consulta en los foros de MSDN. Con respecto a la misma, te hago la recomendación de ingresar a los siguientes enlaces en donde puedes encontrar una posible solución para tu problema.

http://edupython.blogspot.com/2016/06/combinaciones-permutaciones-y-otras.html

http://www.forosdelweb.com/f18/generar-todas-las-combinaciones-posibles-544154/

Gracias por usar los foros de MSDN.

Pedro Alfaro
 ____

Por favor recuerde "Marcar como respuesta" las respuestas que hayan resuelto su problema, es una forma común de reconocer a aquellos que han ayudado, y hace que sea más fácil para los otros visitantes encontrar la solución más tarde. 

Microsoft ofrece este servicio de forma gratuita, con la finalidad de ayudar a los usuarios y la ampliación de la base de datos de conocimientos relacionados con los productos y tecnologías de Microsoft.  

Este contenido es proporcionado "tal cual" y no implica ninguna responsabilidad de parte de Microsoft.

Answer 2

Gracias por la respuesta. Pero no es exactamente lo que necesito.

La lista resultante del código Phyton del primer link, (No se pasar Phyton a Vb.Net) teniendo como ejemplo las palabras (fresa, pera, limón), es:

fresa
limón
pera
fresa, limón
fresa, pera
limón, pera
fresa, limón, pera

Faltarían limón, fresa; pera, limón ... 

Y lo que quiero es:

fresa
limón
pera
fresa, limón
fresa, pera
limón, fresa
limón, pera
pera, fresa
pera, limón
fresa, limón, pera
fresa, pera, limón
limón, fresa, pera
limón, pera, fresa
pera, fresa, limón
pera, limón, fresa

Así no faltaría ninguna combinación.

El segundo link es para PHP y no me interesa. Además tampoco se traducir de uno a otro.

Tengo un código que si resulta lo que intento, pero a partir de 8 letras se bloquea. He intentado casi de todo y sigo sin poder arreglarlo...

Answer 3

Hola Rafael F.M 

creo que este codigo puede servirte

Option Explicit
 
Private Sub Combinaciones(Palabra As String, Optional strFixed As String)
    Dim i As Integer
    If Len(Palabra) <> 1 Then
        For i = 1 To Len(Palabra)
            Combinaciones Left$(Palabra, i - 1) & Mid$(Palabra, i + 1), strFixed & Mid$(Palabra, i, 1)
        Next i
    Else
        List1.AddItem strFixed & Palabra
    End If
End Sub
 
Private Sub Form_Load()
    Me.AutoRedraw = True
    Call Combinaciones("123")
End Sub

de no ser asi intenta con este:

/// <summary>
/// Funcion recursiva que genera combinaciones de números de N en r
/// </summary>
/// <param name=t">Inicialmente se debe de pasar 1 y este automaticamente se va incrementando</param>"
/// <param name=N">Es el numero de elementos del Universo</param>"
/// <param name=r">Es el numero de elementos del grupo</param>"
/// <param name=x">Se utiliza para ir calculando en que numero de elemento vamos</param>"
/// <param name=Elem">Arreglo que contiene la colección de elementos de la combinación</param>"
/// <param name=strTex">Variable de texto donde se van mostrando las posibles combinaciones</param>"
void Ciclo(int t, int N, int r, int x, ref int[] Elem, ref string strTex)
{

    // Se repite hasta que t sea mayor que el número de formas posibles
    while (t <= (N - (r - x)))
    {
        // Se generaran r ciclos recursivos 
        if (r > x)
        {
            Elem[x-1] = t; 
            Ciclo((t + 1), N, r, (x + 1), ref Elem, ref strTex);
        }
        else
        {
            Elem[x-1] = t;

			// Concatenamos la combinación            
            for (int i = 0; i < x; i++)
            {
                strTex += Elem[i].ToString("[#,##0]");
            }
            strTex += "\r\n";
        }
        t++;
    }   
}

Así se manda a llamar la funcion

// Declaramos variables
int N = 9;                  // Nueve envases
int r = 6;                  // Seis espacios
int[] Elem = new int[r];    // Vector de la Combinación
string strTex = "";         

// Iniciamos llamada recursiva a la función.
Ciclo(1, N, r, 1, ref Elem, ref strTex);

// Mostrar resultado en una caja de texto
txtCombina.Text = strTex;  

Answer 4

Hola Rafael F.M 

creo que este codigo puede servirte

Gracias por la respuesta. Pero estamos en las mismas...

 Class Form1
        Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
            Call Main()
        End Sub
    End Class

    Module Alfaro
    Sub Main()
        Call Cmbncns("123")
    End Sub
    Private Sub Cmbncns(Palabra As String, Optional strFixed As String = "")
        Dim i As Integer
        If Len(Palabra) <> 1 Then
            For i = 1 To Len(Palabra)
                Cmbncns(Left$(Palabra, i - 1) & Mid$(Palabra, i + 1), strFixed & Mid$(Palabra, i, 1))
            Next i
        Else
            Form1.Rtb1.AppendText(strFixed & Palabra & vbNewLine)
        End If
    End Sub
    'Resultado Primer código
    '123
    '132
    '213
    '231
    '312
    '321
End Module

'Resultado segundo código
'[1][2][3][4][5][6]
'[1][2][3][4][5][7]
'[1][2][3][4][5][8]
'[1][2][3][4][5][9]
'[1][2][3][4][6][7]
'[1][2][3][4][6][8]
'[1][2][3][4][6][9]
'Etc

No es:

'Objetivo
'A
'B
'C
'AB
'AC
'BA
'BC
'CA
'CB
'ABC
'ACB
'BAC
'BCA
'CAB
'CBA

Answer 5

Hola Rafael Intenta con estoesta en c#

 pero lo puedes tradicir

class Program
    {
        

        static void Main(string[] args)
        {
            string Cadena= "ABCD";
            for (int i = 0; i < Cadena.Length; i++)
            {
                mn(Cadena,"", i);
            }
            //
            Console.ReadKey();
        }

        private static int mn(string cadena, string Cadena1, int v1)
        {
            int Cont = 0;
            for (int i = 0; i < cadena.Length; i++)
            {
                if(Cont==v1)
                {
                    Console.WriteLine($"{Cadena1}{cadena[i]}");
                    Cont = 0;
                }
                else
                {
                    Cont++;
                    string Cx = cadena.Remove(i, 1);
                    Cont= mn(Cx,$"{Cadena1}{cadena[i]}", v1 - 1);
                    
                }
               
            }
            return Cont;
        }
    }

  creo que seria asi

Imports System

Module Program
    Sub Main(args As String())
        Dim Cadena As String = "ABC"
        For i = 0 To Cadena.Length - 1
            mn(Cadena, "", i)
        Next
        Console.ReadKey()

    End Sub
    Function mn(cadena As String, cadena1 As String, v1 As Int16) As Int16
        Dim cont As Int16 = 0
        For i = 0 To cadena.Length - 1
            If cont = v1 Then
                Console.WriteLine($"{cadena1}{cadena(i)}")
                cont = 0
            Else
                cont += 1
                Dim cx As String = cadena.Remove(i, 1)
                cont = mn(cx, $"{cadena1}{cadena(i)}", v1 - 1)
            End If
        Next
        Return cont
    End Function

End Module

Answer 6

Gracias Marti Llam

El problema del código que propones es que hace demasiadas llamadas a la Function.

Es demasiado lento...

Lo siguiente es lo que tengo:

    Sub Mains() Handles Button1.Click
        sb2.Clear()
        Dim chrs As String = TextBox1.Text
        For i = 0 To chrs.Length - 1
            Mn(chrs, String.Empty, i)
        Next i
    End Sub
    Dim sb2 As New StringBuilder()
    Dim result As String
    Function Mn(cdn As String, str As String, vle As Short) As Short
        Dim cont As Short
        For i = 0 To cdn.Length - 1
            If cont = vle Then

                result = String.Join(String.Empty, {$"{str}{cdn(i)}" & vbLf})
                sb2.Append(result)

                cont = 0
            Else
                cont += 1
                Dim cx As String = cdn.Remove(i, 1)
                cont = Mn(cx, $"{str}{cdn(i)}", vle - 1)
            End If
        Next
        Return cont
    End Function

Edito

Error de programación, mío, al ejecutar el código en Windows Form escribiendo la salida a un RichtextBox.

Answer 7

Hola

toda rutina repetitiva es lenta, ademas cuantos caracteres desas interactuar

Answer 8

Perdona por desmarcar. Pero estaba confundido.

Ahora he encontrado los fallos, míos por supuesto, y funciona muy bien.

El único problema con que me encuentro es, que necesito un segundo Button para que funcione.

Seguiré intentándolo.

Public Class Form1

Sub Permutat() Handles Button1.Click
    Dim Cadena As String = "123456789"
    For i = 0 To Cadena.Length - 1
        Mn(Cadena, "", i)
    Next
End Sub
Dim hsht As HashSet(Of String) = New HashSet(Of String)
Function Mn(cadena As String, cadena1 As String, v1 As Int16) As Int16
    Dim cont As Int16 = 0
    For i = 0 To cadena.Length - 1
        If cont = v1 Then
            'Console.WriteLine($"{cadena1}{cadena(i)}")
            hsht.Add(String.Join("", {$"{cadena1}{cadena(i)}"}) & vbLf)
            cont = 0
        Else
            cont += 1
            Dim cx As String = cadena.Remove(i, 1)
            cont = Mn(cx, $"{cadena1}{cadena(i)}", v1 - 1)
        End If
    Next
    Return cont
End Function

Sub ToRichText() Handles Button2.Click
    Rtb1.Clear()
    Rtb1.AppendText(String.Join("", hsht.ToArray))
End Sub

End Class

Gracias de nuevo y, marco otra vez la respuesta.