Şartlı permutasyon sorusu

honestman · 26 Ocak 2017

Merhaba,

A 1 hücresinden A100 hüvresine kadar çeşitli kelimeler mevcut. Diyelim ki A1 de "glasses" kelimesi var yanındaki B kolununa kelime 7 harfli olduğundan 1,2,3,4,5,6,7 yazmalı. Böylece her harfe bir sayı vermiş oluyorum. Esas soru mesela artık 4,5,7 sayıları "s" harfini temsil ediyor. Yandaki kolonlara "s" harfini temsil eden tüm permutasyonlar yapılmalı kelime bozulmadan. Yani 1,2,3,5,4,6,7 yada 1,2,3,7,5,6,4 yada 1,2,3,5,7,6,4 vb. Kaç tane tekrarlayan harf varsa bu şekilde bi for döngüsü yapılabilir mi? Teşekkürler.

Asri · 27 Ocak 2017

honestman' Alıntı:
Merhaba,

A 1 hücresinden A100 hüvresine kadar çeşitli kelimeler mevcut. Diyelim ki A1 de "glasses" kelimesi var yanındaki B kolununa kelime 7 harfli olduğundan 1,2,3,4,5,6,7 yazmalı. Böylece her harfe bir sayı vermiş oluyorum. Esas soru mesela artık 4,5,7 sayıları "s" harfini temsil ediyor. Yandaki kolonlara "s" harfini temsil eden tüm permutasyonlar yapılmalı kelime bozulmadan. Yani 1,2,3,5,4,6,7 yada 1,2,3,7,5,6,4 yada 1,2,3,5,7,6,4 vb. Kaç tane tekrarlayan harf varsa bu şekilde bi for döngüsü yapılabilir mi? Teşekkürler.

457 yi siz mi beliryeceksiniz. harf olarak s lerimi kaydır diyeceksiniz.
Bir de farklı bir yöntem olurmu diye soruyorum, bu işlem ne için yapılıyor.

Asri · 27 Ocak 2017

Kontrol ediniz.

İşlem öncesi, tüm boşluklar tek boşluk yapılır.
Tüm harfler küçük harf yapılır. İ i I ı dikkate alınarak.

Hem cümlede tekrarlı kelimeleri, hem de tek kelimelerdeki tekrarlı harfleri işleme alır.

Aynı kolanda cümleler ve tek başına kelimeler bulunabilir.
Cümlede kelimeler boşluk ile ayrılmak zorundadır.

glasses ve 4,5,7 için sonuç
1 2 3 4 5 6 7
1 2 3 5 4 6 7
1 2 3 5 7 6 4
1 2 3 7 5 6 4
1 2 3 7 4 6 5
1 2 3 4 7 6 5

Kod:

'www.asriakdeniz.com   asriakdeniz@gmail.com
Dim sayilar(50)
Dim tekrar(50)
Dim satir, sonsatir As Long
Dim kelime As String
Dim tekrarsay As Integer

Sub menu()
  satir = 0
  Call yontem
  Call Duzenle
End Sub

Sub sifirla()
  For j = 1 To 50
      tekrar(j) = ""
  Next
End Sub

Sub yontem()
  sonsatir = Cells(Rows.Count, "A").End(3).Row
  Range("J:ZZ").ClearContents
  For islem = 1 To sonsatir
      kelime = Cells(islem, 1).Value
      kelime = tum_bosluklar_tek_bosluk(kelime)
      kelime = tum_harfler_kucuk(kelime)
      
      Call sifirla
      tekrarsay = 0
      If InStr(kelime, " ") > 1 Then Call permi_cumle Else Call permi_harf
      
  Next islem
  
  Columns("J:K").Select
  ActiveSheet.Range("J:K").RemoveDuplicates Columns:=Array(1, 2), Header:=xlNo
  Range("K1").Select
  
End Sub



Sub permi_harf()
    For j = 1 To Len(kelime)
       harf = Mid(kelime, j, 1)
       If harf = eskiharf Then GoTo harfatla
       tekrarliharf = j & ","
       For j1 = 1 To Len(kelime)
         harf2 = Mid(kelime, j1, 1)
         If LCase(harf) = LCase(harf2) And j1 <> j And j1 > j Then
            tekrarliharf = tekrarliharf & j1 & ","
         End If
       Next
       If UBound(Split(tekrarliharf, ",")) > 1 Then
          tekrarsay = tekrarsay + 1
          tekrar(tekrarsay) = tekrarliharf
       End If
harfatla:
       tekrarliharf = ""
       eskiharf = harf
    Next
    
    If tekrarsay = 0 Then
      gec = ""
      For j = 1 To Len(kelime)
        If gec = "" Then
           gec = "1"
        Else
           gec = gec & "," & j
        End If
        sayilar(j) = j
      Next
      satir = satir + 1
      Cells(satir, 10) = kelime
      Cells(satir, 11).Value = gec
      sonsayi = j - 1
    End If
    
  For t1 = 1 To tekrarsay
    ilksira = tekrar(t1)
    sira = ilksira

    For j = 1 To 50
       sayilar(j) = ""
    Next
    satir = satir + 1
    gec = ""
    For j = 1 To Len(kelime)
      If gec = "" Then
         gec = "1"
      Else
         gec = gec & "," & j
      End If
      sayilar(j) = j
    Next
    Cells(satir, 10) = kelime
    Cells(satir, 11).Value = gec
    sonsayi = j - 1
    
    liste1 = Split(sira, ",")
    refliste = Split(sira, ",")
    For k = 1 To UBound(liste1)
     For j = 0 To UBound(liste1)
      sira = ""
      sayi1 = liste1(j)
      sayi2 = liste1(j + 1)
      If sayi2 = "" Then Exit For
      liste1(j) = sayi2
      liste1(j + 1) = sayi1
      satir = satir + 1
      For j1 = 0 To UBound(liste1)
        sira = sira & "," & liste1(j1)
        If sira = "," & ilksira Then
         sira = ""
        End If
      Next

      For j1 = 0 To UBound(liste1) - 1
           sayilar(0 + refliste(j1)) = liste1(j1)
      Next
      
      gec = ""
      For j1 = 1 To sonsayi
          If j1 = 1 Then
             gec = sayilar(j1)
          Else
             gec = gec & "," & sayilar(j1)
          End If
      Next
      Cells(satir, 10) = kelime
      Cells(satir, 11) = gec
     Next
son:
 
    Next
 Next

End Sub

Sub permi_cumle()
    If Right(kelime, 1) <> " " Then kelime = kelime & " "
    kelimeler = Split(kelime, " ")
     
    For j = 0 To UBound(kelimeler)
       harf = kelimeler(j)
       If harf = eskiharf Then GoTo harfatla
       tekrarliharf = j + 1 & ","
       For j1 = 0 To UBound(kelimeler)
         harf2 = kelimeler(j1)
         If LCase(harf) = LCase(harf2) And j1 <> j And j1 > j Then
            tekrarliharf = tekrarliharf & j1 + 1 & ","
         End If
       Next
       If UBound(Split(tekrarliharf, ",")) > 1 Then
          tekrarsay = tekrarsay + 1
          tekrar(tekrarsay) = tekrarliharf
       End If
harfatla:
       tekrarliharf = ""
       eskiharf = harf
    Next
    
    If tekrarsay = 0 Then
      gec = ""
      For j = 1 To UBound(kelimeler)
        If gec = "" Then
           gec = "1"
        Else
           gec = gec & "," & j
        End If
        sayilar(j) = j
      Next
      satir = satir + 1
      Cells(satir, 10) = kelime
      Cells(satir, 11).Value = gec
      sonsayi = j - 1
    End If
    
  For t1 = 1 To tekrarsay
    ilksira = tekrar(t1)
    sira = ilksira

    For j = 1 To 50
       sayilar(j) = ""
    Next
    satir = satir + 1
    gec = ""
    For j = 1 To UBound(kelimeler)
      If gec = "" Then
         gec = "1"
      Else
         gec = gec & "," & j
      End If
      sayilar(j) = j
    Next
    Cells(satir, 10) = kelime
    Cells(satir, 11).Value = gec
    sonsayi = j - 1
    
    liste1 = Split(sira, ",")
    refliste = Split(sira, ",")
    For k = 1 To UBound(liste1)
     For j = 0 To UBound(liste1)
      sira = ""
      sayi1 = liste1(j)
      sayi2 = liste1(j + 1)
      If sayi2 = "" Then Exit For
      liste1(j) = sayi2
      liste1(j + 1) = sayi1
      satir = satir + 1
      For j1 = 0 To UBound(liste1)
        sira = sira & "," & liste1(j1)
        If sira = "," & ilksira Then
         sira = ""
        End If
      Next

      For j1 = 0 To UBound(liste1) - 1
           sayilar(0 + refliste(j1)) = liste1(j1)
      Next
      
      gec = ""
      For j1 = 1 To sonsayi
          If j1 = 1 Then
             gec = sayilar(j1)
          Else
             gec = gec & "," & sayilar(j1)
          End If
      Next
      Cells(satir, 10) = kelime
      Cells(satir, 11) = gec
     Next
son:
 
    Next
 Next
End Sub


Sub Duzenle()
    Columns("J:J").Select
    With Selection
        .HorizontalAlignment = xlRight
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlLeft
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("K:K").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlRight
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlLeft
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("K4").Select
End Sub

Public Function tum_bosluklar_tek_bosluk(cumle)
  gecici = ""
  eski = "99"
  If InStr(1, cumle, " ") > 0 Then
    For i = 1 To Len(cumle)
      h = Mid(cumle, i, 1)
      If eski <> " " Then
        gecici = gecici + h
      ElseIf eski = " " And h <> " " Then
        gecici = gecici + h
      End If
      eski = h
    Next i
    tum_bosluklar_tek_bosluk = gecici
  Else
    tum_bosluklar_tek_bosluk = cumle
  End If
End Function

Public Function tum_harfler_kucuk(cumle)
gecici = ""
For i = 1 To Len(cumle)
          h = Mid(cumle, i, 1)
          Select Case h
            Case "Ğ": gecici = gecici + "ğ"
            Case "Ü": gecici = gecici + "ü"
            Case "Ş": gecici = gecici + "ş"
            Case "Ç": gecici = gecici + "ç"
            Case "Ö": gecici = gecici + "ö"
            Case "I": gecici = gecici + "ı"
            Case "İ": gecici = gecici + "i"
            Case Else: gecici = gecici + LCase(h)
            End Select
Next i
tum_harfler_kucuk = gecici
End Function

honestman · 27 Ocak 2017

Merhaba,

Hayır ilk sütunda kelimeyi sayacak mesela sicil kelimesi 5 harfli olfuğundan ilk b sütununa 1,2,3,4,5 diğer sütunlarda benzer olan 2, ve 4 ü pemutasyonla değiştirecek. Her kelime farklı sayıda karakter içerebilir ve benzer harfler içermeyebilir. Benzer harf yoksa sadecr karakter sayısı kadar 1,2,3,... yapması yeterli. Teşekkür ederim.

Asri · 27 Ocak 2017

honestman' Alıntı:
Merhaba,

Hayır ilk sütunda kelimeyi sayacak mesela sicil kelimesi 5 harfli olfuğundan ilk b sütununa 1,2,3,4,5 diğer sütunlarda benzer olan 2, ve 4 ü pemutasyonla değiştirecek. Her kelime farklı sayıda karakter içerebilir ve benzer harfler içermeyebilir. Benzer harf yoksa sadecr karakter sayısı kadar 1,2,3,... yapması yeterli. Teşekkür ederim.

İlk mesajınızda aynı harfler ile ilgili bilgi yok. S seçilmiş ve üzerinden örnek verilmiş gibi duruyor. Yada ben öyle anladım.

* Karakalemciler de 3 adet a, 2 adet k, 2 adet r, 2 adet e ve 2 adet l tekrar eden var. Bu durumda nasıl bir yol izlenecek

honestman · 27 Ocak 2017

Karakalemciler 14 harfli bu sebeple b sütununa 1 den 14 e kadarsayıları virgülle ayırarak yazacak. 1,2,3,4... diye bu durumda a harfine tekabül eden 2,4,6 kendi aralarında e harfine tekabül eden 8,ve 13 kendi aralarında, L harfine tekanül eden 7 ve 12 kendi aralarında K harfine drnk gelen 1 ve 5 de kendi aralarında yer değiştirerek kelimenin anlamını değiştirmeyecek şekilde sayısal permutasyona girmeli. Yani değişken sayısı benzer harf sayısına bağlı olmalı.

Asri · 27 Ocak 2017

honestman' Alıntı:
kelimenin anlamını değiştirmeyecek şekilde

"kelimenin anlamını değiştirmeyecek şekilde" ne demek?
Bir de bu işlem ne için kullanılacak? Yada ne yapmak istiyorsunuz?
Belki kendi aralarında permutasyon yerine farklı bir çözüm sağlanbilir.

honestman · 27 Ocak 2017

Yani kelime değişmemiş olacak bu permutasyon sonuçları harflerle eşleştirildiğinde kelime yine karakalemciler çıkacak.

Asri · 27 Ocak 2017

honestman' Alıntı:
Yani kelime değişmemiş olacak bu permutasyon sonuçları harflerle eşleştirildiğinde kelime yine karakalemciler çıkacak.

Bunu biraz daha açıklar mısınız?
Harflerin yeri değişince aynı kelime nasıl oluşur ki? Örnek verebilir misiniz?

honestman · 27 Ocak 2017

Hep aynı haefler kendi aralarında yer değişecek çünkü mesela sicil kelimesi 5 harfli yani 1,2,3,4,5, orjinal kodlaması. Kod 1,4,3,2,5 olunca sadece aynı olan i harfleti yer değiştirdiğinden kelime değişmemiş oluyor.

Asri · 27 Ocak 2017

honestman' Alıntı:
Hep aynı haefler kendi aralarında yer değişecek çünkü mesela sicil kelimesi 5 harfli yani 1,2,3,4,5, orjinal kodlaması. Kod 1,4,3,2,5 olunca sadece aynı olan i harfleti yer değiştirdiğinden kelime değişmemiş oluyor.

Enteresan bir çalışma.
Kelime değişmeyecek ise biz niye karıştırıyoruz ki : )

Özel bir çalışma ise özel deyin sorun değil. Değil ise böyle bir çalışma nerede kullanılır .

honestman · 27 Ocak 2017

Hocam soru ve cevap modülümüz var öğrenci tek kelimelik cevapları kelimenin harflerini buraya sürükleyip bırakarak veriyor. Modül bu sayısal permutasyon mantıkla çalışıyor. 2 tane e harfi varsa hangi harfi sürüklerse sürüklesin cevabı doğtu olacak böylece.

Asri · 27 Ocak 2017

honestman' Alıntı:
Hocam soru ve cevap modülümüz var öğrenci tek kelimelik cevapları kelimenin harflerini buraya sürükleyip bırakarak veriyor. Modül bu sayısal permutasyon mantıkla çalışıyor. 2 tane e harfi varsa hangi harfi sürüklerse sürüklesin cevabı doğtu olacak böylece.

Öğrencinin SİCİL kelimesini bulmasını istiyoruz.

Bir harf setimiz var ve bunlardan rastgele 5 harf seçiyor. Seçtiği harfler SİCİL kelimesini oluşturuyor mu. Bunu mu bulmaya çalıyoruz.

honestman · 27 Ocak 2017

Hayır hocam. Eğitimci kendi kafasına göre bir kelime soruyor. Bu kelimeyi sistem harf sayısına göre mumaralandırıyor her harfe ayrı numara veriyor. Öğrenci bu numaralı kutucukları yerleştiriyor. Biz doğru kombinasyonları sisteme giriyoruz ki öğrenci mesela sicil kelimesindeki 2 i harfinden hangisini hangi sırayla yerleştirirse yerleştirsin sistem bu sonucu doğru kabul etsin. Be sebeple sisteme bu kombinasyonları her kelime için gömmek zorundayız. Eğitimci kelimeleri excel olarak atıyor biz de bu kombinasyonları sisteme giriyoruz.

Asri · 28 Ocak 2017

3. nolu mesajımda kod güncellendi.

Kontrol ediniz.

honestman · 28 Ocak 2017

Hocam çok teşekkür ederim çok güzel oldu. Peki bunu kelime bazlı yapabilir miyiz? Mesela bir hücrede örneğin "bir adam bana bir elma verdi" yazdığında buradaki aynı olan bir kelimeleri için aynı permütasyonlar bulunabilir mi?

Asri · 28 Ocak 2017

honestman' Alıntı:
.. buradaki aynı olan bir kelimeleri için aynı permütasyonlar bulunabilir mi?

Tam anlamadım. Her zaman örnekli lütfen.

"bir adam bana bir elma verdi" bu cümledeki kelimeleri ayrı ayrı mı işleme alacak

bir
adam
bana
bir
elma
verdi

honestman · 28 Ocak 2017

Bu arada hocam mevcut yazdığınız kod bazı kelimeleri mesela

'change' 'where' ve 'quite' kelimelerini hesaplamıyor.

Asri · 28 Ocak 2017

honestman' Alıntı:
Bu arada hocam mevcut yazdığınız kod bazı kelimeleri mesela

'change' 'where' ve 'quite' kelimelerini hesaplamıyor.

Tekrarsız olanlarda sorun varmış.
Düzeltildi. Kontrol ediniz.

honestman · 28 Ocak 2017

asri' Alıntı:
Tam anlamadım. Her zaman örnekli lütfen.

"bir adam bana bir elma verdi" bu cümledeki kelimeleri ayrı ayrı mı işleme alacak

bir
adam
bana
bir
elma
verdi

Hocam mesela bir adam bana bir elma verdi cümlesinde her kelimeye bir say versin. Tıpkı mevcut kodda harfleri kodladığı gibi. Sora da o kodu permute etsin.

Şartlı permutasyon sorusu

Ekli dosyalar